{-# 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.LookupDeveloperIdentity
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the @IdentityID@ associated with a @DeveloperUserIdentifier@
-- or the list of @DeveloperUserIdentifier@ values associated with an
-- @IdentityId@ for an existing identity. Either @IdentityID@ or
-- @DeveloperUserIdentifier@ must not be null. If you supply only one of
-- these values, the other value will be searched in the database and
-- returned as a part of the response. If you supply both,
-- @DeveloperUserIdentifier@ will be matched against @IdentityID@. If the
-- values are verified against the database, the response returns both
-- values and is the same as the request. Otherwise a
-- @ResourceConflictException@ is thrown.
--
-- @LookupDeveloperIdentity@ is intended for low-throughput control plane
-- operations: for example, to enable customer service to locate an
-- identity ID by username. If you are using it for higher-volume
-- operations such as user authentication, your requests are likely to be
-- throttled. GetOpenIdTokenForDeveloperIdentity is a better option for
-- higher-volume operations for user authentication.
--
-- You must use AWS Developer credentials to call this API.
module Amazonka.CognitoIdentity.LookupDeveloperIdentity
  ( -- * Creating a Request
    LookupDeveloperIdentity (..),
    newLookupDeveloperIdentity,

    -- * Request Lenses
    lookupDeveloperIdentity_developerUserIdentifier,
    lookupDeveloperIdentity_identityId,
    lookupDeveloperIdentity_maxResults,
    lookupDeveloperIdentity_nextToken,
    lookupDeveloperIdentity_identityPoolId,

    -- * Destructuring the Response
    LookupDeveloperIdentityResponse (..),
    newLookupDeveloperIdentityResponse,

    -- * Response Lenses
    lookupDeveloperIdentityResponse_developerUserIdentifierList,
    lookupDeveloperIdentityResponse_identityId,
    lookupDeveloperIdentityResponse_nextToken,
    lookupDeveloperIdentityResponse_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 @LookupDeveloperIdentityInput@ action.
--
-- /See:/ 'newLookupDeveloperIdentity' smart constructor.
data LookupDeveloperIdentity = LookupDeveloperIdentity'
  { -- | A unique ID used by your backend authentication process to identify a
    -- user. Typically, a developer identity provider would issue many
    -- developer user identifiers, in keeping with the number of users.
    LookupDeveloperIdentity -> Maybe Text
developerUserIdentifier :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier in the format REGION:GUID.
    LookupDeveloperIdentity -> Maybe Text
identityId :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of identities to return.
    LookupDeveloperIdentity -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A pagination token. The first call you make will have @NextToken@ set to
    -- null. After that the service will return @NextToken@ values as needed.
    -- For example, let\'s say you make a request with @MaxResults@ set to 10,
    -- and there are 20 matches in the database. The service will return a
    -- pagination token as a part of the response. This token can be used to
    -- call the API again and get results starting from the 11th match.
    LookupDeveloperIdentity -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | An identity pool ID in the format REGION:GUID.
    LookupDeveloperIdentity -> Text
identityPoolId :: Prelude.Text
  }
  deriving (LookupDeveloperIdentity -> LookupDeveloperIdentity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LookupDeveloperIdentity -> LookupDeveloperIdentity -> Bool
$c/= :: LookupDeveloperIdentity -> LookupDeveloperIdentity -> Bool
== :: LookupDeveloperIdentity -> LookupDeveloperIdentity -> Bool
$c== :: LookupDeveloperIdentity -> LookupDeveloperIdentity -> Bool
Prelude.Eq, ReadPrec [LookupDeveloperIdentity]
ReadPrec LookupDeveloperIdentity
Int -> ReadS LookupDeveloperIdentity
ReadS [LookupDeveloperIdentity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LookupDeveloperIdentity]
$creadListPrec :: ReadPrec [LookupDeveloperIdentity]
readPrec :: ReadPrec LookupDeveloperIdentity
$creadPrec :: ReadPrec LookupDeveloperIdentity
readList :: ReadS [LookupDeveloperIdentity]
$creadList :: ReadS [LookupDeveloperIdentity]
readsPrec :: Int -> ReadS LookupDeveloperIdentity
$creadsPrec :: Int -> ReadS LookupDeveloperIdentity
Prelude.Read, Int -> LookupDeveloperIdentity -> ShowS
[LookupDeveloperIdentity] -> ShowS
LookupDeveloperIdentity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LookupDeveloperIdentity] -> ShowS
$cshowList :: [LookupDeveloperIdentity] -> ShowS
show :: LookupDeveloperIdentity -> String
$cshow :: LookupDeveloperIdentity -> String
showsPrec :: Int -> LookupDeveloperIdentity -> ShowS
$cshowsPrec :: Int -> LookupDeveloperIdentity -> ShowS
Prelude.Show, forall x. Rep LookupDeveloperIdentity x -> LookupDeveloperIdentity
forall x. LookupDeveloperIdentity -> Rep LookupDeveloperIdentity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LookupDeveloperIdentity x -> LookupDeveloperIdentity
$cfrom :: forall x. LookupDeveloperIdentity -> Rep LookupDeveloperIdentity x
Prelude.Generic)

-- |
-- Create a value of 'LookupDeveloperIdentity' 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:
--
-- 'developerUserIdentifier', 'lookupDeveloperIdentity_developerUserIdentifier' - A unique ID used by your backend authentication process to identify a
-- user. Typically, a developer identity provider would issue many
-- developer user identifiers, in keeping with the number of users.
--
-- 'identityId', 'lookupDeveloperIdentity_identityId' - A unique identifier in the format REGION:GUID.
--
-- 'maxResults', 'lookupDeveloperIdentity_maxResults' - The maximum number of identities to return.
--
-- 'nextToken', 'lookupDeveloperIdentity_nextToken' - A pagination token. The first call you make will have @NextToken@ set to
-- null. After that the service will return @NextToken@ values as needed.
-- For example, let\'s say you make a request with @MaxResults@ set to 10,
-- and there are 20 matches in the database. The service will return a
-- pagination token as a part of the response. This token can be used to
-- call the API again and get results starting from the 11th match.
--
-- 'identityPoolId', 'lookupDeveloperIdentity_identityPoolId' - An identity pool ID in the format REGION:GUID.
newLookupDeveloperIdentity ::
  -- | 'identityPoolId'
  Prelude.Text ->
  LookupDeveloperIdentity
newLookupDeveloperIdentity :: Text -> LookupDeveloperIdentity
newLookupDeveloperIdentity Text
pIdentityPoolId_ =
  LookupDeveloperIdentity'
    { $sel:developerUserIdentifier:LookupDeveloperIdentity' :: Maybe Text
developerUserIdentifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:identityId:LookupDeveloperIdentity' :: Maybe Text
identityId = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:LookupDeveloperIdentity' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:LookupDeveloperIdentity' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:identityPoolId:LookupDeveloperIdentity' :: Text
identityPoolId = Text
pIdentityPoolId_
    }

-- | A unique ID used by your backend authentication process to identify a
-- user. Typically, a developer identity provider would issue many
-- developer user identifiers, in keeping with the number of users.
lookupDeveloperIdentity_developerUserIdentifier :: Lens.Lens' LookupDeveloperIdentity (Prelude.Maybe Prelude.Text)
lookupDeveloperIdentity_developerUserIdentifier :: Lens' LookupDeveloperIdentity (Maybe Text)
lookupDeveloperIdentity_developerUserIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LookupDeveloperIdentity' {Maybe Text
developerUserIdentifier :: Maybe Text
$sel:developerUserIdentifier:LookupDeveloperIdentity' :: LookupDeveloperIdentity -> Maybe Text
developerUserIdentifier} -> Maybe Text
developerUserIdentifier) (\s :: LookupDeveloperIdentity
s@LookupDeveloperIdentity' {} Maybe Text
a -> LookupDeveloperIdentity
s {$sel:developerUserIdentifier:LookupDeveloperIdentity' :: Maybe Text
developerUserIdentifier = Maybe Text
a} :: LookupDeveloperIdentity)

-- | A unique identifier in the format REGION:GUID.
lookupDeveloperIdentity_identityId :: Lens.Lens' LookupDeveloperIdentity (Prelude.Maybe Prelude.Text)
lookupDeveloperIdentity_identityId :: Lens' LookupDeveloperIdentity (Maybe Text)
lookupDeveloperIdentity_identityId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LookupDeveloperIdentity' {Maybe Text
identityId :: Maybe Text
$sel:identityId:LookupDeveloperIdentity' :: LookupDeveloperIdentity -> Maybe Text
identityId} -> Maybe Text
identityId) (\s :: LookupDeveloperIdentity
s@LookupDeveloperIdentity' {} Maybe Text
a -> LookupDeveloperIdentity
s {$sel:identityId:LookupDeveloperIdentity' :: Maybe Text
identityId = Maybe Text
a} :: LookupDeveloperIdentity)

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

-- | A pagination token. The first call you make will have @NextToken@ set to
-- null. After that the service will return @NextToken@ values as needed.
-- For example, let\'s say you make a request with @MaxResults@ set to 10,
-- and there are 20 matches in the database. The service will return a
-- pagination token as a part of the response. This token can be used to
-- call the API again and get results starting from the 11th match.
lookupDeveloperIdentity_nextToken :: Lens.Lens' LookupDeveloperIdentity (Prelude.Maybe Prelude.Text)
lookupDeveloperIdentity_nextToken :: Lens' LookupDeveloperIdentity (Maybe Text)
lookupDeveloperIdentity_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LookupDeveloperIdentity' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:LookupDeveloperIdentity' :: LookupDeveloperIdentity -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: LookupDeveloperIdentity
s@LookupDeveloperIdentity' {} Maybe Text
a -> LookupDeveloperIdentity
s {$sel:nextToken:LookupDeveloperIdentity' :: Maybe Text
nextToken = Maybe Text
a} :: LookupDeveloperIdentity)

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

instance Core.AWSRequest LookupDeveloperIdentity where
  type
    AWSResponse LookupDeveloperIdentity =
      LookupDeveloperIdentityResponse
  request :: (Service -> Service)
-> LookupDeveloperIdentity -> Request LookupDeveloperIdentity
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 LookupDeveloperIdentity
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse LookupDeveloperIdentity)))
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 [Text]
-> Maybe Text
-> Maybe Text
-> Int
-> LookupDeveloperIdentityResponse
LookupDeveloperIdentityResponse'
            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
"DeveloperUserIdentifierList"
                            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
"IdentityId")
            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 LookupDeveloperIdentity where
  hashWithSalt :: Int -> LookupDeveloperIdentity -> Int
hashWithSalt Int
_salt LookupDeveloperIdentity' {Maybe Natural
Maybe Text
Text
identityPoolId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
identityId :: Maybe Text
developerUserIdentifier :: Maybe Text
$sel:identityPoolId:LookupDeveloperIdentity' :: LookupDeveloperIdentity -> Text
$sel:nextToken:LookupDeveloperIdentity' :: LookupDeveloperIdentity -> Maybe Text
$sel:maxResults:LookupDeveloperIdentity' :: LookupDeveloperIdentity -> Maybe Natural
$sel:identityId:LookupDeveloperIdentity' :: LookupDeveloperIdentity -> Maybe Text
$sel:developerUserIdentifier:LookupDeveloperIdentity' :: LookupDeveloperIdentity -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
developerUserIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
identityId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identityPoolId

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

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

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

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

-- | Returned in response to a successful @LookupDeveloperIdentity@ action.
--
-- /See:/ 'newLookupDeveloperIdentityResponse' smart constructor.
data LookupDeveloperIdentityResponse = LookupDeveloperIdentityResponse'
  { -- | This is the list of developer user identifiers associated with an
    -- identity ID. Cognito supports the association of multiple developer user
    -- identifiers with an identity ID.
    LookupDeveloperIdentityResponse -> Maybe [Text]
developerUserIdentifierList :: Prelude.Maybe [Prelude.Text],
    -- | A unique identifier in the format REGION:GUID.
    LookupDeveloperIdentityResponse -> Maybe Text
identityId :: Prelude.Maybe Prelude.Text,
    -- | A pagination token. The first call you make will have @NextToken@ set to
    -- null. After that the service will return @NextToken@ values as needed.
    -- For example, let\'s say you make a request with @MaxResults@ set to 10,
    -- and there are 20 matches in the database. The service will return a
    -- pagination token as a part of the response. This token can be used to
    -- call the API again and get results starting from the 11th match.
    LookupDeveloperIdentityResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    LookupDeveloperIdentityResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (LookupDeveloperIdentityResponse
-> LookupDeveloperIdentityResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LookupDeveloperIdentityResponse
-> LookupDeveloperIdentityResponse -> Bool
$c/= :: LookupDeveloperIdentityResponse
-> LookupDeveloperIdentityResponse -> Bool
== :: LookupDeveloperIdentityResponse
-> LookupDeveloperIdentityResponse -> Bool
$c== :: LookupDeveloperIdentityResponse
-> LookupDeveloperIdentityResponse -> Bool
Prelude.Eq, ReadPrec [LookupDeveloperIdentityResponse]
ReadPrec LookupDeveloperIdentityResponse
Int -> ReadS LookupDeveloperIdentityResponse
ReadS [LookupDeveloperIdentityResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LookupDeveloperIdentityResponse]
$creadListPrec :: ReadPrec [LookupDeveloperIdentityResponse]
readPrec :: ReadPrec LookupDeveloperIdentityResponse
$creadPrec :: ReadPrec LookupDeveloperIdentityResponse
readList :: ReadS [LookupDeveloperIdentityResponse]
$creadList :: ReadS [LookupDeveloperIdentityResponse]
readsPrec :: Int -> ReadS LookupDeveloperIdentityResponse
$creadsPrec :: Int -> ReadS LookupDeveloperIdentityResponse
Prelude.Read, Int -> LookupDeveloperIdentityResponse -> ShowS
[LookupDeveloperIdentityResponse] -> ShowS
LookupDeveloperIdentityResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LookupDeveloperIdentityResponse] -> ShowS
$cshowList :: [LookupDeveloperIdentityResponse] -> ShowS
show :: LookupDeveloperIdentityResponse -> String
$cshow :: LookupDeveloperIdentityResponse -> String
showsPrec :: Int -> LookupDeveloperIdentityResponse -> ShowS
$cshowsPrec :: Int -> LookupDeveloperIdentityResponse -> ShowS
Prelude.Show, forall x.
Rep LookupDeveloperIdentityResponse x
-> LookupDeveloperIdentityResponse
forall x.
LookupDeveloperIdentityResponse
-> Rep LookupDeveloperIdentityResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep LookupDeveloperIdentityResponse x
-> LookupDeveloperIdentityResponse
$cfrom :: forall x.
LookupDeveloperIdentityResponse
-> Rep LookupDeveloperIdentityResponse x
Prelude.Generic)

-- |
-- Create a value of 'LookupDeveloperIdentityResponse' 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:
--
-- 'developerUserIdentifierList', 'lookupDeveloperIdentityResponse_developerUserIdentifierList' - This is the list of developer user identifiers associated with an
-- identity ID. Cognito supports the association of multiple developer user
-- identifiers with an identity ID.
--
-- 'identityId', 'lookupDeveloperIdentityResponse_identityId' - A unique identifier in the format REGION:GUID.
--
-- 'nextToken', 'lookupDeveloperIdentityResponse_nextToken' - A pagination token. The first call you make will have @NextToken@ set to
-- null. After that the service will return @NextToken@ values as needed.
-- For example, let\'s say you make a request with @MaxResults@ set to 10,
-- and there are 20 matches in the database. The service will return a
-- pagination token as a part of the response. This token can be used to
-- call the API again and get results starting from the 11th match.
--
-- 'httpStatus', 'lookupDeveloperIdentityResponse_httpStatus' - The response's http status code.
newLookupDeveloperIdentityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  LookupDeveloperIdentityResponse
newLookupDeveloperIdentityResponse :: Int -> LookupDeveloperIdentityResponse
newLookupDeveloperIdentityResponse Int
pHttpStatus_ =
  LookupDeveloperIdentityResponse'
    { $sel:developerUserIdentifierList:LookupDeveloperIdentityResponse' :: Maybe [Text]
developerUserIdentifierList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:identityId:LookupDeveloperIdentityResponse' :: Maybe Text
identityId = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:LookupDeveloperIdentityResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:LookupDeveloperIdentityResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | This is the list of developer user identifiers associated with an
-- identity ID. Cognito supports the association of multiple developer user
-- identifiers with an identity ID.
lookupDeveloperIdentityResponse_developerUserIdentifierList :: Lens.Lens' LookupDeveloperIdentityResponse (Prelude.Maybe [Prelude.Text])
lookupDeveloperIdentityResponse_developerUserIdentifierList :: Lens' LookupDeveloperIdentityResponse (Maybe [Text])
lookupDeveloperIdentityResponse_developerUserIdentifierList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LookupDeveloperIdentityResponse' {Maybe [Text]
developerUserIdentifierList :: Maybe [Text]
$sel:developerUserIdentifierList:LookupDeveloperIdentityResponse' :: LookupDeveloperIdentityResponse -> Maybe [Text]
developerUserIdentifierList} -> Maybe [Text]
developerUserIdentifierList) (\s :: LookupDeveloperIdentityResponse
s@LookupDeveloperIdentityResponse' {} Maybe [Text]
a -> LookupDeveloperIdentityResponse
s {$sel:developerUserIdentifierList:LookupDeveloperIdentityResponse' :: Maybe [Text]
developerUserIdentifierList = Maybe [Text]
a} :: LookupDeveloperIdentityResponse) 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

-- | A unique identifier in the format REGION:GUID.
lookupDeveloperIdentityResponse_identityId :: Lens.Lens' LookupDeveloperIdentityResponse (Prelude.Maybe Prelude.Text)
lookupDeveloperIdentityResponse_identityId :: Lens' LookupDeveloperIdentityResponse (Maybe Text)
lookupDeveloperIdentityResponse_identityId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LookupDeveloperIdentityResponse' {Maybe Text
identityId :: Maybe Text
$sel:identityId:LookupDeveloperIdentityResponse' :: LookupDeveloperIdentityResponse -> Maybe Text
identityId} -> Maybe Text
identityId) (\s :: LookupDeveloperIdentityResponse
s@LookupDeveloperIdentityResponse' {} Maybe Text
a -> LookupDeveloperIdentityResponse
s {$sel:identityId:LookupDeveloperIdentityResponse' :: Maybe Text
identityId = Maybe Text
a} :: LookupDeveloperIdentityResponse)

-- | A pagination token. The first call you make will have @NextToken@ set to
-- null. After that the service will return @NextToken@ values as needed.
-- For example, let\'s say you make a request with @MaxResults@ set to 10,
-- and there are 20 matches in the database. The service will return a
-- pagination token as a part of the response. This token can be used to
-- call the API again and get results starting from the 11th match.
lookupDeveloperIdentityResponse_nextToken :: Lens.Lens' LookupDeveloperIdentityResponse (Prelude.Maybe Prelude.Text)
lookupDeveloperIdentityResponse_nextToken :: Lens' LookupDeveloperIdentityResponse (Maybe Text)
lookupDeveloperIdentityResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LookupDeveloperIdentityResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:LookupDeveloperIdentityResponse' :: LookupDeveloperIdentityResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: LookupDeveloperIdentityResponse
s@LookupDeveloperIdentityResponse' {} Maybe Text
a -> LookupDeveloperIdentityResponse
s {$sel:nextToken:LookupDeveloperIdentityResponse' :: Maybe Text
nextToken = Maybe Text
a} :: LookupDeveloperIdentityResponse)

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

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