{-# 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.CognitoIdentity.ListIdentities
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists the identities in an identity pool.
--
-- You must use AWS Developer credentials to call this API.
module Amazonka.CognitoIdentity.ListIdentities
  ( -- * Creating a Request
    ListIdentities (..),
    newListIdentities,

    -- * Request Lenses
    listIdentities_hideDisabled,
    listIdentities_nextToken,
    listIdentities_identityPoolId,
    listIdentities_maxResults,

    -- * Destructuring the Response
    ListIdentitiesResponse (..),
    newListIdentitiesResponse,

    -- * Response Lenses
    listIdentitiesResponse_identities,
    listIdentitiesResponse_identityPoolId,
    listIdentitiesResponse_nextToken,
    listIdentitiesResponse_httpStatus,
  )
where

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

-- | Input to the ListIdentities action.
--
-- /See:/ 'newListIdentities' smart constructor.
data ListIdentities = ListIdentities'
  { -- | An optional boolean parameter that allows you to hide disabled
    -- identities. If omitted, the ListIdentities API will include disabled
    -- identities in the response.
    ListIdentities -> Maybe Bool
hideDisabled :: Prelude.Maybe Prelude.Bool,
    -- | A pagination token.
    ListIdentities -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | An identity pool ID in the format REGION:GUID.
    ListIdentities -> Text
identityPoolId :: Prelude.Text,
    -- | The maximum number of identities to return.
    ListIdentities -> Natural
maxResults :: Prelude.Natural
  }
  deriving (ListIdentities -> ListIdentities -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListIdentities -> ListIdentities -> Bool
$c/= :: ListIdentities -> ListIdentities -> Bool
== :: ListIdentities -> ListIdentities -> Bool
$c== :: ListIdentities -> ListIdentities -> Bool
Prelude.Eq, ReadPrec [ListIdentities]
ReadPrec ListIdentities
Int -> ReadS ListIdentities
ReadS [ListIdentities]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListIdentities]
$creadListPrec :: ReadPrec [ListIdentities]
readPrec :: ReadPrec ListIdentities
$creadPrec :: ReadPrec ListIdentities
readList :: ReadS [ListIdentities]
$creadList :: ReadS [ListIdentities]
readsPrec :: Int -> ReadS ListIdentities
$creadsPrec :: Int -> ReadS ListIdentities
Prelude.Read, Int -> ListIdentities -> ShowS
[ListIdentities] -> ShowS
ListIdentities -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListIdentities] -> ShowS
$cshowList :: [ListIdentities] -> ShowS
show :: ListIdentities -> String
$cshow :: ListIdentities -> String
showsPrec :: Int -> ListIdentities -> ShowS
$cshowsPrec :: Int -> ListIdentities -> ShowS
Prelude.Show, forall x. Rep ListIdentities x -> ListIdentities
forall x. ListIdentities -> Rep ListIdentities x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListIdentities x -> ListIdentities
$cfrom :: forall x. ListIdentities -> Rep ListIdentities x
Prelude.Generic)

-- |
-- Create a value of 'ListIdentities' 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:
--
-- 'hideDisabled', 'listIdentities_hideDisabled' - An optional boolean parameter that allows you to hide disabled
-- identities. If omitted, the ListIdentities API will include disabled
-- identities in the response.
--
-- 'nextToken', 'listIdentities_nextToken' - A pagination token.
--
-- 'identityPoolId', 'listIdentities_identityPoolId' - An identity pool ID in the format REGION:GUID.
--
-- 'maxResults', 'listIdentities_maxResults' - The maximum number of identities to return.
newListIdentities ::
  -- | 'identityPoolId'
  Prelude.Text ->
  -- | 'maxResults'
  Prelude.Natural ->
  ListIdentities
newListIdentities :: Text -> Natural -> ListIdentities
newListIdentities Text
pIdentityPoolId_ Natural
pMaxResults_ =
  ListIdentities'
    { $sel:hideDisabled:ListIdentities' :: Maybe Bool
hideDisabled = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListIdentities' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:identityPoolId:ListIdentities' :: Text
identityPoolId = Text
pIdentityPoolId_,
      $sel:maxResults:ListIdentities' :: Natural
maxResults = Natural
pMaxResults_
    }

-- | An optional boolean parameter that allows you to hide disabled
-- identities. If omitted, the ListIdentities API will include disabled
-- identities in the response.
listIdentities_hideDisabled :: Lens.Lens' ListIdentities (Prelude.Maybe Prelude.Bool)
listIdentities_hideDisabled :: Lens' ListIdentities (Maybe Bool)
listIdentities_hideDisabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIdentities' {Maybe Bool
hideDisabled :: Maybe Bool
$sel:hideDisabled:ListIdentities' :: ListIdentities -> Maybe Bool
hideDisabled} -> Maybe Bool
hideDisabled) (\s :: ListIdentities
s@ListIdentities' {} Maybe Bool
a -> ListIdentities
s {$sel:hideDisabled:ListIdentities' :: Maybe Bool
hideDisabled = Maybe Bool
a} :: ListIdentities)

-- | A pagination token.
listIdentities_nextToken :: Lens.Lens' ListIdentities (Prelude.Maybe Prelude.Text)
listIdentities_nextToken :: Lens' ListIdentities (Maybe Text)
listIdentities_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIdentities' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListIdentities' :: ListIdentities -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListIdentities
s@ListIdentities' {} Maybe Text
a -> ListIdentities
s {$sel:nextToken:ListIdentities' :: Maybe Text
nextToken = Maybe Text
a} :: ListIdentities)

-- | An identity pool ID in the format REGION:GUID.
listIdentities_identityPoolId :: Lens.Lens' ListIdentities Prelude.Text
listIdentities_identityPoolId :: Lens' ListIdentities Text
listIdentities_identityPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIdentities' {Text
identityPoolId :: Text
$sel:identityPoolId:ListIdentities' :: ListIdentities -> Text
identityPoolId} -> Text
identityPoolId) (\s :: ListIdentities
s@ListIdentities' {} Text
a -> ListIdentities
s {$sel:identityPoolId:ListIdentities' :: Text
identityPoolId = Text
a} :: ListIdentities)

-- | The maximum number of identities to return.
listIdentities_maxResults :: Lens.Lens' ListIdentities Prelude.Natural
listIdentities_maxResults :: Lens' ListIdentities Natural
listIdentities_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIdentities' {Natural
maxResults :: Natural
$sel:maxResults:ListIdentities' :: ListIdentities -> Natural
maxResults} -> Natural
maxResults) (\s :: ListIdentities
s@ListIdentities' {} Natural
a -> ListIdentities
s {$sel:maxResults:ListIdentities' :: Natural
maxResults = Natural
a} :: ListIdentities)

instance Core.AWSRequest ListIdentities where
  type
    AWSResponse ListIdentities =
      ListIdentitiesResponse
  request :: (Service -> Service) -> ListIdentities -> Request ListIdentities
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 ListIdentities
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListIdentities)))
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 [IdentityDescription]
-> Maybe Text -> Maybe Text -> Int -> ListIdentitiesResponse
ListIdentitiesResponse'
            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
"Identities" 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
"IdentityPoolId")
            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 ListIdentities where
  hashWithSalt :: Int -> ListIdentities -> Int
hashWithSalt Int
_salt ListIdentities' {Natural
Maybe Bool
Maybe Text
Text
maxResults :: Natural
identityPoolId :: Text
nextToken :: Maybe Text
hideDisabled :: Maybe Bool
$sel:maxResults:ListIdentities' :: ListIdentities -> Natural
$sel:identityPoolId:ListIdentities' :: ListIdentities -> Text
$sel:nextToken:ListIdentities' :: ListIdentities -> Maybe Text
$sel:hideDisabled:ListIdentities' :: ListIdentities -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
hideDisabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
maxResults

instance Prelude.NFData ListIdentities where
  rnf :: ListIdentities -> ()
rnf ListIdentities' {Natural
Maybe Bool
Maybe Text
Text
maxResults :: Natural
identityPoolId :: Text
nextToken :: Maybe Text
hideDisabled :: Maybe Bool
$sel:maxResults:ListIdentities' :: ListIdentities -> Natural
$sel:identityPoolId:ListIdentities' :: ListIdentities -> Text
$sel:nextToken:ListIdentities' :: ListIdentities -> Maybe Text
$sel:hideDisabled:ListIdentities' :: ListIdentities -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
hideDisabled
      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 Text
identityPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
maxResults

instance Data.ToHeaders ListIdentities where
  toHeaders :: ListIdentities -> 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
"AWSCognitoIdentityService.ListIdentities" ::
                          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 ListIdentities where
  toJSON :: ListIdentities -> Value
toJSON ListIdentities' {Natural
Maybe Bool
Maybe Text
Text
maxResults :: Natural
identityPoolId :: Text
nextToken :: Maybe Text
hideDisabled :: Maybe Bool
$sel:maxResults:ListIdentities' :: ListIdentities -> Natural
$sel:identityPoolId:ListIdentities' :: ListIdentities -> Text
$sel:nextToken:ListIdentities' :: ListIdentities -> Maybe Text
$sel:hideDisabled:ListIdentities' :: ListIdentities -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"HideDisabled" 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 Bool
hideDisabled,
            (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,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"IdentityPoolId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
identityPoolId),
            forall a. a -> Maybe a
Prelude.Just (Key
"MaxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
maxResults)
          ]
      )

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

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

-- | The response to a ListIdentities request.
--
-- /See:/ 'newListIdentitiesResponse' smart constructor.
data ListIdentitiesResponse = ListIdentitiesResponse'
  { -- | An object containing a set of identities and associated mappings.
    ListIdentitiesResponse -> Maybe [IdentityDescription]
identities :: Prelude.Maybe [IdentityDescription],
    -- | An identity pool ID in the format REGION:GUID.
    ListIdentitiesResponse -> Maybe Text
identityPoolId :: Prelude.Maybe Prelude.Text,
    -- | A pagination token.
    ListIdentitiesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListIdentitiesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListIdentitiesResponse -> ListIdentitiesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListIdentitiesResponse -> ListIdentitiesResponse -> Bool
$c/= :: ListIdentitiesResponse -> ListIdentitiesResponse -> Bool
== :: ListIdentitiesResponse -> ListIdentitiesResponse -> Bool
$c== :: ListIdentitiesResponse -> ListIdentitiesResponse -> Bool
Prelude.Eq, ReadPrec [ListIdentitiesResponse]
ReadPrec ListIdentitiesResponse
Int -> ReadS ListIdentitiesResponse
ReadS [ListIdentitiesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListIdentitiesResponse]
$creadListPrec :: ReadPrec [ListIdentitiesResponse]
readPrec :: ReadPrec ListIdentitiesResponse
$creadPrec :: ReadPrec ListIdentitiesResponse
readList :: ReadS [ListIdentitiesResponse]
$creadList :: ReadS [ListIdentitiesResponse]
readsPrec :: Int -> ReadS ListIdentitiesResponse
$creadsPrec :: Int -> ReadS ListIdentitiesResponse
Prelude.Read, Int -> ListIdentitiesResponse -> ShowS
[ListIdentitiesResponse] -> ShowS
ListIdentitiesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListIdentitiesResponse] -> ShowS
$cshowList :: [ListIdentitiesResponse] -> ShowS
show :: ListIdentitiesResponse -> String
$cshow :: ListIdentitiesResponse -> String
showsPrec :: Int -> ListIdentitiesResponse -> ShowS
$cshowsPrec :: Int -> ListIdentitiesResponse -> ShowS
Prelude.Show, forall x. Rep ListIdentitiesResponse x -> ListIdentitiesResponse
forall x. ListIdentitiesResponse -> Rep ListIdentitiesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListIdentitiesResponse x -> ListIdentitiesResponse
$cfrom :: forall x. ListIdentitiesResponse -> Rep ListIdentitiesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListIdentitiesResponse' 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:
--
-- 'identities', 'listIdentitiesResponse_identities' - An object containing a set of identities and associated mappings.
--
-- 'identityPoolId', 'listIdentitiesResponse_identityPoolId' - An identity pool ID in the format REGION:GUID.
--
-- 'nextToken', 'listIdentitiesResponse_nextToken' - A pagination token.
--
-- 'httpStatus', 'listIdentitiesResponse_httpStatus' - The response's http status code.
newListIdentitiesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListIdentitiesResponse
newListIdentitiesResponse :: Int -> ListIdentitiesResponse
newListIdentitiesResponse Int
pHttpStatus_ =
  ListIdentitiesResponse'
    { $sel:identities:ListIdentitiesResponse' :: Maybe [IdentityDescription]
identities =
        forall a. Maybe a
Prelude.Nothing,
      $sel:identityPoolId:ListIdentitiesResponse' :: Maybe Text
identityPoolId = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListIdentitiesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListIdentitiesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object containing a set of identities and associated mappings.
listIdentitiesResponse_identities :: Lens.Lens' ListIdentitiesResponse (Prelude.Maybe [IdentityDescription])
listIdentitiesResponse_identities :: Lens' ListIdentitiesResponse (Maybe [IdentityDescription])
listIdentitiesResponse_identities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIdentitiesResponse' {Maybe [IdentityDescription]
identities :: Maybe [IdentityDescription]
$sel:identities:ListIdentitiesResponse' :: ListIdentitiesResponse -> Maybe [IdentityDescription]
identities} -> Maybe [IdentityDescription]
identities) (\s :: ListIdentitiesResponse
s@ListIdentitiesResponse' {} Maybe [IdentityDescription]
a -> ListIdentitiesResponse
s {$sel:identities:ListIdentitiesResponse' :: Maybe [IdentityDescription]
identities = Maybe [IdentityDescription]
a} :: ListIdentitiesResponse) 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 identity pool ID in the format REGION:GUID.
listIdentitiesResponse_identityPoolId :: Lens.Lens' ListIdentitiesResponse (Prelude.Maybe Prelude.Text)
listIdentitiesResponse_identityPoolId :: Lens' ListIdentitiesResponse (Maybe Text)
listIdentitiesResponse_identityPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIdentitiesResponse' {Maybe Text
identityPoolId :: Maybe Text
$sel:identityPoolId:ListIdentitiesResponse' :: ListIdentitiesResponse -> Maybe Text
identityPoolId} -> Maybe Text
identityPoolId) (\s :: ListIdentitiesResponse
s@ListIdentitiesResponse' {} Maybe Text
a -> ListIdentitiesResponse
s {$sel:identityPoolId:ListIdentitiesResponse' :: Maybe Text
identityPoolId = Maybe Text
a} :: ListIdentitiesResponse)

-- | A pagination token.
listIdentitiesResponse_nextToken :: Lens.Lens' ListIdentitiesResponse (Prelude.Maybe Prelude.Text)
listIdentitiesResponse_nextToken :: Lens' ListIdentitiesResponse (Maybe Text)
listIdentitiesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIdentitiesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListIdentitiesResponse' :: ListIdentitiesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListIdentitiesResponse
s@ListIdentitiesResponse' {} Maybe Text
a -> ListIdentitiesResponse
s {$sel:nextToken:ListIdentitiesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListIdentitiesResponse)

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

instance Prelude.NFData ListIdentitiesResponse where
  rnf :: ListIdentitiesResponse -> ()
rnf ListIdentitiesResponse' {Int
Maybe [IdentityDescription]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
identityPoolId :: Maybe Text
identities :: Maybe [IdentityDescription]
$sel:httpStatus:ListIdentitiesResponse' :: ListIdentitiesResponse -> Int
$sel:nextToken:ListIdentitiesResponse' :: ListIdentitiesResponse -> Maybe Text
$sel:identityPoolId:ListIdentitiesResponse' :: ListIdentitiesResponse -> Maybe Text
$sel:identities:ListIdentitiesResponse' :: ListIdentitiesResponse -> Maybe [IdentityDescription]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [IdentityDescription]
identities
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
identityPoolId
      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