{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.DeviceFarm.ListInstanceProfiles
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns information about all the instance profiles in an AWS account.
--
-- This operation returns paginated results.
module Amazonka.DeviceFarm.ListInstanceProfiles
  ( -- * Creating a Request
    ListInstanceProfiles (..),
    newListInstanceProfiles,

    -- * Request Lenses
    listInstanceProfiles_maxResults,
    listInstanceProfiles_nextToken,

    -- * Destructuring the Response
    ListInstanceProfilesResponse (..),
    newListInstanceProfilesResponse,

    -- * Response Lenses
    listInstanceProfilesResponse_instanceProfiles,
    listInstanceProfilesResponse_nextToken,
    listInstanceProfilesResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DeviceFarm.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newListInstanceProfiles' smart constructor.
data ListInstanceProfiles = ListInstanceProfiles'
  { -- | An integer that specifies the maximum number of items you want to return
    -- in the API response.
    ListInstanceProfiles -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | An identifier that was returned from the previous call to this
    -- operation, which can be used to return the next set of items in the
    -- list.
    ListInstanceProfiles -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListInstanceProfiles -> ListInstanceProfiles -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListInstanceProfiles -> ListInstanceProfiles -> Bool
$c/= :: ListInstanceProfiles -> ListInstanceProfiles -> Bool
== :: ListInstanceProfiles -> ListInstanceProfiles -> Bool
$c== :: ListInstanceProfiles -> ListInstanceProfiles -> Bool
Prelude.Eq, ReadPrec [ListInstanceProfiles]
ReadPrec ListInstanceProfiles
Int -> ReadS ListInstanceProfiles
ReadS [ListInstanceProfiles]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListInstanceProfiles]
$creadListPrec :: ReadPrec [ListInstanceProfiles]
readPrec :: ReadPrec ListInstanceProfiles
$creadPrec :: ReadPrec ListInstanceProfiles
readList :: ReadS [ListInstanceProfiles]
$creadList :: ReadS [ListInstanceProfiles]
readsPrec :: Int -> ReadS ListInstanceProfiles
$creadsPrec :: Int -> ReadS ListInstanceProfiles
Prelude.Read, Int -> ListInstanceProfiles -> ShowS
[ListInstanceProfiles] -> ShowS
ListInstanceProfiles -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListInstanceProfiles] -> ShowS
$cshowList :: [ListInstanceProfiles] -> ShowS
show :: ListInstanceProfiles -> String
$cshow :: ListInstanceProfiles -> String
showsPrec :: Int -> ListInstanceProfiles -> ShowS
$cshowsPrec :: Int -> ListInstanceProfiles -> ShowS
Prelude.Show, forall x. Rep ListInstanceProfiles x -> ListInstanceProfiles
forall x. ListInstanceProfiles -> Rep ListInstanceProfiles x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListInstanceProfiles x -> ListInstanceProfiles
$cfrom :: forall x. ListInstanceProfiles -> Rep ListInstanceProfiles x
Prelude.Generic)

-- |
-- Create a value of 'ListInstanceProfiles' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'maxResults', 'listInstanceProfiles_maxResults' - An integer that specifies the maximum number of items you want to return
-- in the API response.
--
-- 'nextToken', 'listInstanceProfiles_nextToken' - An identifier that was returned from the previous call to this
-- operation, which can be used to return the next set of items in the
-- list.
newListInstanceProfiles ::
  ListInstanceProfiles
newListInstanceProfiles :: ListInstanceProfiles
newListInstanceProfiles =
  ListInstanceProfiles'
    { $sel:maxResults:ListInstanceProfiles' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListInstanceProfiles' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | An integer that specifies the maximum number of items you want to return
-- in the API response.
listInstanceProfiles_maxResults :: Lens.Lens' ListInstanceProfiles (Prelude.Maybe Prelude.Int)
listInstanceProfiles_maxResults :: Lens' ListInstanceProfiles (Maybe Int)
listInstanceProfiles_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstanceProfiles' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:ListInstanceProfiles' :: ListInstanceProfiles -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: ListInstanceProfiles
s@ListInstanceProfiles' {} Maybe Int
a -> ListInstanceProfiles
s {$sel:maxResults:ListInstanceProfiles' :: Maybe Int
maxResults = Maybe Int
a} :: ListInstanceProfiles)

-- | An identifier that was returned from the previous call to this
-- operation, which can be used to return the next set of items in the
-- list.
listInstanceProfiles_nextToken :: Lens.Lens' ListInstanceProfiles (Prelude.Maybe Prelude.Text)
listInstanceProfiles_nextToken :: Lens' ListInstanceProfiles (Maybe Text)
listInstanceProfiles_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstanceProfiles' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListInstanceProfiles' :: ListInstanceProfiles -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListInstanceProfiles
s@ListInstanceProfiles' {} Maybe Text
a -> ListInstanceProfiles
s {$sel:nextToken:ListInstanceProfiles' :: Maybe Text
nextToken = Maybe Text
a} :: ListInstanceProfiles)

instance Core.AWSPager ListInstanceProfiles where
  page :: ListInstanceProfiles
-> AWSResponse ListInstanceProfiles -> Maybe ListInstanceProfiles
page ListInstanceProfiles
rq AWSResponse ListInstanceProfiles
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListInstanceProfiles
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListInstanceProfilesResponse (Maybe Text)
listInstanceProfilesResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListInstanceProfiles
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListInstanceProfilesResponse (Maybe [InstanceProfile])
listInstanceProfilesResponse_instanceProfiles
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListInstanceProfiles
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListInstanceProfiles (Maybe Text)
listInstanceProfiles_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListInstanceProfiles
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListInstanceProfilesResponse (Maybe Text)
listInstanceProfilesResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListInstanceProfiles where
  type
    AWSResponse ListInstanceProfiles =
      ListInstanceProfilesResponse
  request :: (Service -> Service)
-> ListInstanceProfiles -> Request ListInstanceProfiles
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListInstanceProfiles
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListInstanceProfiles)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [InstanceProfile]
-> Maybe Text -> Int -> ListInstanceProfilesResponse
ListInstanceProfilesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"instanceProfiles"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"nextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListInstanceProfiles where
  hashWithSalt :: Int -> ListInstanceProfiles -> Int
hashWithSalt Int
_salt ListInstanceProfiles' {Maybe Int
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:nextToken:ListInstanceProfiles' :: ListInstanceProfiles -> Maybe Text
$sel:maxResults:ListInstanceProfiles' :: ListInstanceProfiles -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListInstanceProfiles where
  rnf :: ListInstanceProfiles -> ()
rnf ListInstanceProfiles' {Maybe Int
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:nextToken:ListInstanceProfiles' :: ListInstanceProfiles -> Maybe Text
$sel:maxResults:ListInstanceProfiles' :: ListInstanceProfiles -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance Data.ToHeaders ListInstanceProfiles where
  toHeaders :: ListInstanceProfiles -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"DeviceFarm_20150623.ListInstanceProfiles" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListInstanceProfiles where
  toJSON :: ListInstanceProfiles -> Value
toJSON ListInstanceProfiles' {Maybe Int
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:nextToken:ListInstanceProfiles' :: ListInstanceProfiles -> Maybe Text
$sel:maxResults:ListInstanceProfiles' :: ListInstanceProfiles -> Maybe Int
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"maxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Int
maxResults,
            (Key
"nextToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextToken
          ]
      )

instance Data.ToPath ListInstanceProfiles where
  toPath :: ListInstanceProfiles -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery ListInstanceProfiles where
  toQuery :: ListInstanceProfiles -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newListInstanceProfilesResponse' smart constructor.
data ListInstanceProfilesResponse = ListInstanceProfilesResponse'
  { -- | An object that contains information about your instance profiles.
    ListInstanceProfilesResponse -> Maybe [InstanceProfile]
instanceProfiles :: Prelude.Maybe [InstanceProfile],
    -- | An identifier that can be used in the next call to this operation to
    -- return the next set of items in the list.
    ListInstanceProfilesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListInstanceProfilesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListInstanceProfilesResponse
-> ListInstanceProfilesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListInstanceProfilesResponse
-> ListInstanceProfilesResponse -> Bool
$c/= :: ListInstanceProfilesResponse
-> ListInstanceProfilesResponse -> Bool
== :: ListInstanceProfilesResponse
-> ListInstanceProfilesResponse -> Bool
$c== :: ListInstanceProfilesResponse
-> ListInstanceProfilesResponse -> Bool
Prelude.Eq, ReadPrec [ListInstanceProfilesResponse]
ReadPrec ListInstanceProfilesResponse
Int -> ReadS ListInstanceProfilesResponse
ReadS [ListInstanceProfilesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListInstanceProfilesResponse]
$creadListPrec :: ReadPrec [ListInstanceProfilesResponse]
readPrec :: ReadPrec ListInstanceProfilesResponse
$creadPrec :: ReadPrec ListInstanceProfilesResponse
readList :: ReadS [ListInstanceProfilesResponse]
$creadList :: ReadS [ListInstanceProfilesResponse]
readsPrec :: Int -> ReadS ListInstanceProfilesResponse
$creadsPrec :: Int -> ReadS ListInstanceProfilesResponse
Prelude.Read, Int -> ListInstanceProfilesResponse -> ShowS
[ListInstanceProfilesResponse] -> ShowS
ListInstanceProfilesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListInstanceProfilesResponse] -> ShowS
$cshowList :: [ListInstanceProfilesResponse] -> ShowS
show :: ListInstanceProfilesResponse -> String
$cshow :: ListInstanceProfilesResponse -> String
showsPrec :: Int -> ListInstanceProfilesResponse -> ShowS
$cshowsPrec :: Int -> ListInstanceProfilesResponse -> ShowS
Prelude.Show, forall x.
Rep ListInstanceProfilesResponse x -> ListInstanceProfilesResponse
forall x.
ListInstanceProfilesResponse -> Rep ListInstanceProfilesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListInstanceProfilesResponse x -> ListInstanceProfilesResponse
$cfrom :: forall x.
ListInstanceProfilesResponse -> Rep ListInstanceProfilesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListInstanceProfilesResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'instanceProfiles', 'listInstanceProfilesResponse_instanceProfiles' - An object that contains information about your instance profiles.
--
-- 'nextToken', 'listInstanceProfilesResponse_nextToken' - An identifier that can be used in the next call to this operation to
-- return the next set of items in the list.
--
-- 'httpStatus', 'listInstanceProfilesResponse_httpStatus' - The response's http status code.
newListInstanceProfilesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListInstanceProfilesResponse
newListInstanceProfilesResponse :: Int -> ListInstanceProfilesResponse
newListInstanceProfilesResponse Int
pHttpStatus_ =
  ListInstanceProfilesResponse'
    { $sel:instanceProfiles:ListInstanceProfilesResponse' :: Maybe [InstanceProfile]
instanceProfiles =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListInstanceProfilesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListInstanceProfilesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object that contains information about your instance profiles.
listInstanceProfilesResponse_instanceProfiles :: Lens.Lens' ListInstanceProfilesResponse (Prelude.Maybe [InstanceProfile])
listInstanceProfilesResponse_instanceProfiles :: Lens' ListInstanceProfilesResponse (Maybe [InstanceProfile])
listInstanceProfilesResponse_instanceProfiles = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstanceProfilesResponse' {Maybe [InstanceProfile]
instanceProfiles :: Maybe [InstanceProfile]
$sel:instanceProfiles:ListInstanceProfilesResponse' :: ListInstanceProfilesResponse -> Maybe [InstanceProfile]
instanceProfiles} -> Maybe [InstanceProfile]
instanceProfiles) (\s :: ListInstanceProfilesResponse
s@ListInstanceProfilesResponse' {} Maybe [InstanceProfile]
a -> ListInstanceProfilesResponse
s {$sel:instanceProfiles:ListInstanceProfilesResponse' :: Maybe [InstanceProfile]
instanceProfiles = Maybe [InstanceProfile]
a} :: ListInstanceProfilesResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | An identifier that can be used in the next call to this operation to
-- return the next set of items in the list.
listInstanceProfilesResponse_nextToken :: Lens.Lens' ListInstanceProfilesResponse (Prelude.Maybe Prelude.Text)
listInstanceProfilesResponse_nextToken :: Lens' ListInstanceProfilesResponse (Maybe Text)
listInstanceProfilesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstanceProfilesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListInstanceProfilesResponse' :: ListInstanceProfilesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListInstanceProfilesResponse
s@ListInstanceProfilesResponse' {} Maybe Text
a -> ListInstanceProfilesResponse
s {$sel:nextToken:ListInstanceProfilesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListInstanceProfilesResponse)

-- | The response's http status code.
listInstanceProfilesResponse_httpStatus :: Lens.Lens' ListInstanceProfilesResponse Prelude.Int
listInstanceProfilesResponse_httpStatus :: Lens' ListInstanceProfilesResponse Int
listInstanceProfilesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListInstanceProfilesResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListInstanceProfilesResponse' :: ListInstanceProfilesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListInstanceProfilesResponse
s@ListInstanceProfilesResponse' {} Int
a -> ListInstanceProfilesResponse
s {$sel:httpStatus:ListInstanceProfilesResponse' :: Int
httpStatus = Int
a} :: ListInstanceProfilesResponse)

instance Prelude.NFData ListInstanceProfilesResponse where
  rnf :: ListInstanceProfilesResponse -> ()
rnf ListInstanceProfilesResponse' {Int
Maybe [InstanceProfile]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
instanceProfiles :: Maybe [InstanceProfile]
$sel:httpStatus:ListInstanceProfilesResponse' :: ListInstanceProfilesResponse -> Int
$sel:nextToken:ListInstanceProfilesResponse' :: ListInstanceProfilesResponse -> Maybe Text
$sel:instanceProfiles:ListInstanceProfilesResponse' :: ListInstanceProfilesResponse -> Maybe [InstanceProfile]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [InstanceProfile]
instanceProfiles
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus