{-# 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.CognitoIdentityProvider.AdminRespondToAuthChallenge
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Responds to an authentication challenge, as an administrator.
--
-- This action might generate an SMS text message. Starting June 1, 2021,
-- US telecom carriers require you to register an origination phone number
-- before you can send SMS messages to US phone numbers. If you use SMS
-- text messages in Amazon Cognito, you must register a phone number with
-- <https://console.aws.amazon.com/pinpoint/home/ Amazon Pinpoint>. Amazon
-- Cognito uses the registered number automatically. Otherwise, Amazon
-- Cognito users who must receive SMS messages might not be able to sign
-- up, activate their accounts, or sign in.
--
-- If you have never used SMS text messages with Amazon Cognito or any
-- other Amazon Web Service, Amazon Simple Notification Service might place
-- your account in the SMS sandbox. In
-- /<https://docs.aws.amazon.com/sns/latest/dg/sns-sms-sandbox.html sandbox mode>/
-- , you can send messages only to verified phone numbers. After you test
-- your app while in the sandbox environment, you can move out of the
-- sandbox and into production. For more information, see
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/cognito-user-identity-pools-sms-userpool-settings.html SMS message settings for Amazon Cognito user pools>
-- in the /Amazon Cognito Developer Guide/.
--
-- Calling this action requires developer credentials.
module Amazonka.CognitoIdentityProvider.AdminRespondToAuthChallenge
  ( -- * Creating a Request
    AdminRespondToAuthChallenge (..),
    newAdminRespondToAuthChallenge,

    -- * Request Lenses
    adminRespondToAuthChallenge_analyticsMetadata,
    adminRespondToAuthChallenge_challengeResponses,
    adminRespondToAuthChallenge_clientMetadata,
    adminRespondToAuthChallenge_contextData,
    adminRespondToAuthChallenge_session,
    adminRespondToAuthChallenge_userPoolId,
    adminRespondToAuthChallenge_clientId,
    adminRespondToAuthChallenge_challengeName,

    -- * Destructuring the Response
    AdminRespondToAuthChallengeResponse (..),
    newAdminRespondToAuthChallengeResponse,

    -- * Response Lenses
    adminRespondToAuthChallengeResponse_authenticationResult,
    adminRespondToAuthChallengeResponse_challengeName,
    adminRespondToAuthChallengeResponse_challengeParameters,
    adminRespondToAuthChallengeResponse_session,
    adminRespondToAuthChallengeResponse_httpStatus,
  )
where

import Amazonka.CognitoIdentityProvider.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

-- | The request to respond to the authentication challenge, as an
-- administrator.
--
-- /See:/ 'newAdminRespondToAuthChallenge' smart constructor.
data AdminRespondToAuthChallenge = AdminRespondToAuthChallenge'
  { -- | The analytics metadata for collecting Amazon Pinpoint metrics for
    -- @AdminRespondToAuthChallenge@ calls.
    AdminRespondToAuthChallenge -> Maybe AnalyticsMetadataType
analyticsMetadata :: Prelude.Maybe AnalyticsMetadataType,
    -- | The challenge responses. These are inputs corresponding to the value of
    -- @ChallengeName@, for example:
    --
    -- -   @SMS_MFA@: @SMS_MFA_CODE@, @USERNAME@, @SECRET_HASH@ (if app client
    --     is configured with client secret).
    --
    -- -   @PASSWORD_VERIFIER@: @PASSWORD_CLAIM_SIGNATURE@,
    --     @PASSWORD_CLAIM_SECRET_BLOCK@, @TIMESTAMP@, @USERNAME@,
    --     @SECRET_HASH@ (if app client is configured with client secret).
    --
    --     @PASSWORD_VERIFIER@ requires @DEVICE_KEY@ when signing in with a
    --     remembered device.
    --
    -- -   @ADMIN_NO_SRP_AUTH@: @PASSWORD@, @USERNAME@, @SECRET_HASH@ (if app
    --     client is configured with client secret).
    --
    -- -   @NEW_PASSWORD_REQUIRED@: @NEW_PASSWORD@, @USERNAME@, @SECRET_HASH@
    --     (if app client is configured with client secret). To set any
    --     required attributes that Amazon Cognito returned as
    --     @requiredAttributes@ in the @AdminInitiateAuth@ response, add a
    --     @userAttributes.@/@attributename@/@ @ parameter. This parameter can
    --     also set values for writable attributes that aren\'t required by
    --     your user pool.
    --
    --     In a @NEW_PASSWORD_REQUIRED@ challenge response, you can\'t modify a
    --     required attribute that already has a value. In
    --     @AdminRespondToAuthChallenge@, set a value for any keys that Amazon
    --     Cognito returned in the @requiredAttributes@ parameter, then use the
    --     @AdminUpdateUserAttributes@ API operation to modify the value of any
    --     additional attributes.
    --
    -- -   @MFA_SETUP@ requires @USERNAME@, plus you must use the session value
    --     returned by @VerifySoftwareToken@ in the @Session@ parameter.
    --
    -- The value of the @USERNAME@ attribute must be the user\'s actual
    -- username, not an alias (such as an email address or phone number). To
    -- make this simpler, the @AdminInitiateAuth@ response includes the actual
    -- username value in the @USERNAMEUSER_ID_FOR_SRP@ attribute. This happens
    -- even if you specified an alias in your call to @AdminInitiateAuth@.
    AdminRespondToAuthChallenge -> Maybe (HashMap Text Text)
challengeResponses :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A map of custom key-value pairs that you can provide as input for any
    -- custom workflows that this action triggers.
    --
    -- You create custom workflows by assigning Lambda functions to user pool
    -- triggers. When you use the AdminRespondToAuthChallenge API action,
    -- Amazon Cognito invokes any functions that you have assigned to the
    -- following triggers:
    --
    -- -   pre sign-up
    --
    -- -   custom message
    --
    -- -   post authentication
    --
    -- -   user migration
    --
    -- -   pre token generation
    --
    -- -   define auth challenge
    --
    -- -   create auth challenge
    --
    -- -   verify auth challenge response
    --
    -- When Amazon Cognito invokes any of these functions, it passes a JSON
    -- payload, which the function receives as input. This payload contains a
    -- @clientMetadata@ attribute that provides the data that you assigned to
    -- the ClientMetadata parameter in your AdminRespondToAuthChallenge
    -- request. In your function code in Lambda, you can process the
    -- @clientMetadata@ value to enhance your workflow for your specific needs.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/cognito/latest/developerguide/cognito-user-identity-pools-working-with-aws-lambda-triggers.html Customizing user pool Workflows with Lambda Triggers>
    -- in the /Amazon Cognito Developer Guide/.
    --
    -- When you use the ClientMetadata parameter, remember that Amazon Cognito
    -- won\'t do the following:
    --
    -- -   Store the ClientMetadata value. This data is available only to
    --     Lambda triggers that are assigned to a user pool to support custom
    --     workflows. If your user pool configuration doesn\'t include
    --     triggers, the ClientMetadata parameter serves no purpose.
    --
    -- -   Validate the ClientMetadata value.
    --
    -- -   Encrypt the ClientMetadata value. Don\'t use Amazon Cognito to
    --     provide sensitive information.
    AdminRespondToAuthChallenge -> Maybe (HashMap Text Text)
clientMetadata :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Contextual data about your user session, such as the device fingerprint,
    -- IP address, or location. Amazon Cognito advanced security evaluates the
    -- risk of an authentication event based on the context that your app
    -- generates and passes to Amazon Cognito when it makes API requests.
    AdminRespondToAuthChallenge -> Maybe ContextDataType
contextData :: Prelude.Maybe ContextDataType,
    -- | The session that should be passed both ways in challenge-response calls
    -- to the service. If an @InitiateAuth@ or @RespondToAuthChallenge@ API
    -- call determines that the caller must pass another challenge, it returns
    -- a session with other challenge parameters. This session should be passed
    -- as it is to the next @RespondToAuthChallenge@ API call.
    AdminRespondToAuthChallenge -> Maybe Text
session :: Prelude.Maybe Prelude.Text,
    -- | The ID of the Amazon Cognito user pool.
    AdminRespondToAuthChallenge -> Text
userPoolId :: Prelude.Text,
    -- | The app client ID.
    AdminRespondToAuthChallenge -> Sensitive Text
clientId :: Data.Sensitive Prelude.Text,
    -- | The challenge name. For more information, see
    -- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_AdminInitiateAuth.html AdminInitiateAuth>.
    AdminRespondToAuthChallenge -> ChallengeNameType
challengeName :: ChallengeNameType
  }
  deriving (AdminRespondToAuthChallenge -> AdminRespondToAuthChallenge -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdminRespondToAuthChallenge -> AdminRespondToAuthChallenge -> Bool
$c/= :: AdminRespondToAuthChallenge -> AdminRespondToAuthChallenge -> Bool
== :: AdminRespondToAuthChallenge -> AdminRespondToAuthChallenge -> Bool
$c== :: AdminRespondToAuthChallenge -> AdminRespondToAuthChallenge -> Bool
Prelude.Eq, Int -> AdminRespondToAuthChallenge -> ShowS
[AdminRespondToAuthChallenge] -> ShowS
AdminRespondToAuthChallenge -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AdminRespondToAuthChallenge] -> ShowS
$cshowList :: [AdminRespondToAuthChallenge] -> ShowS
show :: AdminRespondToAuthChallenge -> String
$cshow :: AdminRespondToAuthChallenge -> String
showsPrec :: Int -> AdminRespondToAuthChallenge -> ShowS
$cshowsPrec :: Int -> AdminRespondToAuthChallenge -> ShowS
Prelude.Show, forall x.
Rep AdminRespondToAuthChallenge x -> AdminRespondToAuthChallenge
forall x.
AdminRespondToAuthChallenge -> Rep AdminRespondToAuthChallenge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AdminRespondToAuthChallenge x -> AdminRespondToAuthChallenge
$cfrom :: forall x.
AdminRespondToAuthChallenge -> Rep AdminRespondToAuthChallenge x
Prelude.Generic)

-- |
-- Create a value of 'AdminRespondToAuthChallenge' 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:
--
-- 'analyticsMetadata', 'adminRespondToAuthChallenge_analyticsMetadata' - The analytics metadata for collecting Amazon Pinpoint metrics for
-- @AdminRespondToAuthChallenge@ calls.
--
-- 'challengeResponses', 'adminRespondToAuthChallenge_challengeResponses' - The challenge responses. These are inputs corresponding to the value of
-- @ChallengeName@, for example:
--
-- -   @SMS_MFA@: @SMS_MFA_CODE@, @USERNAME@, @SECRET_HASH@ (if app client
--     is configured with client secret).
--
-- -   @PASSWORD_VERIFIER@: @PASSWORD_CLAIM_SIGNATURE@,
--     @PASSWORD_CLAIM_SECRET_BLOCK@, @TIMESTAMP@, @USERNAME@,
--     @SECRET_HASH@ (if app client is configured with client secret).
--
--     @PASSWORD_VERIFIER@ requires @DEVICE_KEY@ when signing in with a
--     remembered device.
--
-- -   @ADMIN_NO_SRP_AUTH@: @PASSWORD@, @USERNAME@, @SECRET_HASH@ (if app
--     client is configured with client secret).
--
-- -   @NEW_PASSWORD_REQUIRED@: @NEW_PASSWORD@, @USERNAME@, @SECRET_HASH@
--     (if app client is configured with client secret). To set any
--     required attributes that Amazon Cognito returned as
--     @requiredAttributes@ in the @AdminInitiateAuth@ response, add a
--     @userAttributes.@/@attributename@/@ @ parameter. This parameter can
--     also set values for writable attributes that aren\'t required by
--     your user pool.
--
--     In a @NEW_PASSWORD_REQUIRED@ challenge response, you can\'t modify a
--     required attribute that already has a value. In
--     @AdminRespondToAuthChallenge@, set a value for any keys that Amazon
--     Cognito returned in the @requiredAttributes@ parameter, then use the
--     @AdminUpdateUserAttributes@ API operation to modify the value of any
--     additional attributes.
--
-- -   @MFA_SETUP@ requires @USERNAME@, plus you must use the session value
--     returned by @VerifySoftwareToken@ in the @Session@ parameter.
--
-- The value of the @USERNAME@ attribute must be the user\'s actual
-- username, not an alias (such as an email address or phone number). To
-- make this simpler, the @AdminInitiateAuth@ response includes the actual
-- username value in the @USERNAMEUSER_ID_FOR_SRP@ attribute. This happens
-- even if you specified an alias in your call to @AdminInitiateAuth@.
--
-- 'clientMetadata', 'adminRespondToAuthChallenge_clientMetadata' - A map of custom key-value pairs that you can provide as input for any
-- custom workflows that this action triggers.
--
-- You create custom workflows by assigning Lambda functions to user pool
-- triggers. When you use the AdminRespondToAuthChallenge API action,
-- Amazon Cognito invokes any functions that you have assigned to the
-- following triggers:
--
-- -   pre sign-up
--
-- -   custom message
--
-- -   post authentication
--
-- -   user migration
--
-- -   pre token generation
--
-- -   define auth challenge
--
-- -   create auth challenge
--
-- -   verify auth challenge response
--
-- When Amazon Cognito invokes any of these functions, it passes a JSON
-- payload, which the function receives as input. This payload contains a
-- @clientMetadata@ attribute that provides the data that you assigned to
-- the ClientMetadata parameter in your AdminRespondToAuthChallenge
-- request. In your function code in Lambda, you can process the
-- @clientMetadata@ value to enhance your workflow for your specific needs.
--
-- For more information, see
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/cognito-user-identity-pools-working-with-aws-lambda-triggers.html Customizing user pool Workflows with Lambda Triggers>
-- in the /Amazon Cognito Developer Guide/.
--
-- When you use the ClientMetadata parameter, remember that Amazon Cognito
-- won\'t do the following:
--
-- -   Store the ClientMetadata value. This data is available only to
--     Lambda triggers that are assigned to a user pool to support custom
--     workflows. If your user pool configuration doesn\'t include
--     triggers, the ClientMetadata parameter serves no purpose.
--
-- -   Validate the ClientMetadata value.
--
-- -   Encrypt the ClientMetadata value. Don\'t use Amazon Cognito to
--     provide sensitive information.
--
-- 'contextData', 'adminRespondToAuthChallenge_contextData' - Contextual data about your user session, such as the device fingerprint,
-- IP address, or location. Amazon Cognito advanced security evaluates the
-- risk of an authentication event based on the context that your app
-- generates and passes to Amazon Cognito when it makes API requests.
--
-- 'session', 'adminRespondToAuthChallenge_session' - The session that should be passed both ways in challenge-response calls
-- to the service. If an @InitiateAuth@ or @RespondToAuthChallenge@ API
-- call determines that the caller must pass another challenge, it returns
-- a session with other challenge parameters. This session should be passed
-- as it is to the next @RespondToAuthChallenge@ API call.
--
-- 'userPoolId', 'adminRespondToAuthChallenge_userPoolId' - The ID of the Amazon Cognito user pool.
--
-- 'clientId', 'adminRespondToAuthChallenge_clientId' - The app client ID.
--
-- 'challengeName', 'adminRespondToAuthChallenge_challengeName' - The challenge name. For more information, see
-- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_AdminInitiateAuth.html AdminInitiateAuth>.
newAdminRespondToAuthChallenge ::
  -- | 'userPoolId'
  Prelude.Text ->
  -- | 'clientId'
  Prelude.Text ->
  -- | 'challengeName'
  ChallengeNameType ->
  AdminRespondToAuthChallenge
newAdminRespondToAuthChallenge :: Text -> Text -> ChallengeNameType -> AdminRespondToAuthChallenge
newAdminRespondToAuthChallenge
  Text
pUserPoolId_
  Text
pClientId_
  ChallengeNameType
pChallengeName_ =
    AdminRespondToAuthChallenge'
      { $sel:analyticsMetadata:AdminRespondToAuthChallenge' :: Maybe AnalyticsMetadataType
analyticsMetadata =
          forall a. Maybe a
Prelude.Nothing,
        $sel:challengeResponses:AdminRespondToAuthChallenge' :: Maybe (HashMap Text Text)
challengeResponses = forall a. Maybe a
Prelude.Nothing,
        $sel:clientMetadata:AdminRespondToAuthChallenge' :: Maybe (HashMap Text Text)
clientMetadata = forall a. Maybe a
Prelude.Nothing,
        $sel:contextData:AdminRespondToAuthChallenge' :: Maybe ContextDataType
contextData = forall a. Maybe a
Prelude.Nothing,
        $sel:session:AdminRespondToAuthChallenge' :: Maybe Text
session = forall a. Maybe a
Prelude.Nothing,
        $sel:userPoolId:AdminRespondToAuthChallenge' :: Text
userPoolId = Text
pUserPoolId_,
        $sel:clientId:AdminRespondToAuthChallenge' :: Sensitive Text
clientId = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pClientId_,
        $sel:challengeName:AdminRespondToAuthChallenge' :: ChallengeNameType
challengeName = ChallengeNameType
pChallengeName_
      }

-- | The analytics metadata for collecting Amazon Pinpoint metrics for
-- @AdminRespondToAuthChallenge@ calls.
adminRespondToAuthChallenge_analyticsMetadata :: Lens.Lens' AdminRespondToAuthChallenge (Prelude.Maybe AnalyticsMetadataType)
adminRespondToAuthChallenge_analyticsMetadata :: Lens' AdminRespondToAuthChallenge (Maybe AnalyticsMetadataType)
adminRespondToAuthChallenge_analyticsMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminRespondToAuthChallenge' {Maybe AnalyticsMetadataType
analyticsMetadata :: Maybe AnalyticsMetadataType
$sel:analyticsMetadata:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe AnalyticsMetadataType
analyticsMetadata} -> Maybe AnalyticsMetadataType
analyticsMetadata) (\s :: AdminRespondToAuthChallenge
s@AdminRespondToAuthChallenge' {} Maybe AnalyticsMetadataType
a -> AdminRespondToAuthChallenge
s {$sel:analyticsMetadata:AdminRespondToAuthChallenge' :: Maybe AnalyticsMetadataType
analyticsMetadata = Maybe AnalyticsMetadataType
a} :: AdminRespondToAuthChallenge)

-- | The challenge responses. These are inputs corresponding to the value of
-- @ChallengeName@, for example:
--
-- -   @SMS_MFA@: @SMS_MFA_CODE@, @USERNAME@, @SECRET_HASH@ (if app client
--     is configured with client secret).
--
-- -   @PASSWORD_VERIFIER@: @PASSWORD_CLAIM_SIGNATURE@,
--     @PASSWORD_CLAIM_SECRET_BLOCK@, @TIMESTAMP@, @USERNAME@,
--     @SECRET_HASH@ (if app client is configured with client secret).
--
--     @PASSWORD_VERIFIER@ requires @DEVICE_KEY@ when signing in with a
--     remembered device.
--
-- -   @ADMIN_NO_SRP_AUTH@: @PASSWORD@, @USERNAME@, @SECRET_HASH@ (if app
--     client is configured with client secret).
--
-- -   @NEW_PASSWORD_REQUIRED@: @NEW_PASSWORD@, @USERNAME@, @SECRET_HASH@
--     (if app client is configured with client secret). To set any
--     required attributes that Amazon Cognito returned as
--     @requiredAttributes@ in the @AdminInitiateAuth@ response, add a
--     @userAttributes.@/@attributename@/@ @ parameter. This parameter can
--     also set values for writable attributes that aren\'t required by
--     your user pool.
--
--     In a @NEW_PASSWORD_REQUIRED@ challenge response, you can\'t modify a
--     required attribute that already has a value. In
--     @AdminRespondToAuthChallenge@, set a value for any keys that Amazon
--     Cognito returned in the @requiredAttributes@ parameter, then use the
--     @AdminUpdateUserAttributes@ API operation to modify the value of any
--     additional attributes.
--
-- -   @MFA_SETUP@ requires @USERNAME@, plus you must use the session value
--     returned by @VerifySoftwareToken@ in the @Session@ parameter.
--
-- The value of the @USERNAME@ attribute must be the user\'s actual
-- username, not an alias (such as an email address or phone number). To
-- make this simpler, the @AdminInitiateAuth@ response includes the actual
-- username value in the @USERNAMEUSER_ID_FOR_SRP@ attribute. This happens
-- even if you specified an alias in your call to @AdminInitiateAuth@.
adminRespondToAuthChallenge_challengeResponses :: Lens.Lens' AdminRespondToAuthChallenge (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
adminRespondToAuthChallenge_challengeResponses :: Lens' AdminRespondToAuthChallenge (Maybe (HashMap Text Text))
adminRespondToAuthChallenge_challengeResponses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminRespondToAuthChallenge' {Maybe (HashMap Text Text)
challengeResponses :: Maybe (HashMap Text Text)
$sel:challengeResponses:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe (HashMap Text Text)
challengeResponses} -> Maybe (HashMap Text Text)
challengeResponses) (\s :: AdminRespondToAuthChallenge
s@AdminRespondToAuthChallenge' {} Maybe (HashMap Text Text)
a -> AdminRespondToAuthChallenge
s {$sel:challengeResponses:AdminRespondToAuthChallenge' :: Maybe (HashMap Text Text)
challengeResponses = Maybe (HashMap Text Text)
a} :: AdminRespondToAuthChallenge) 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 map of custom key-value pairs that you can provide as input for any
-- custom workflows that this action triggers.
--
-- You create custom workflows by assigning Lambda functions to user pool
-- triggers. When you use the AdminRespondToAuthChallenge API action,
-- Amazon Cognito invokes any functions that you have assigned to the
-- following triggers:
--
-- -   pre sign-up
--
-- -   custom message
--
-- -   post authentication
--
-- -   user migration
--
-- -   pre token generation
--
-- -   define auth challenge
--
-- -   create auth challenge
--
-- -   verify auth challenge response
--
-- When Amazon Cognito invokes any of these functions, it passes a JSON
-- payload, which the function receives as input. This payload contains a
-- @clientMetadata@ attribute that provides the data that you assigned to
-- the ClientMetadata parameter in your AdminRespondToAuthChallenge
-- request. In your function code in Lambda, you can process the
-- @clientMetadata@ value to enhance your workflow for your specific needs.
--
-- For more information, see
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/cognito-user-identity-pools-working-with-aws-lambda-triggers.html Customizing user pool Workflows with Lambda Triggers>
-- in the /Amazon Cognito Developer Guide/.
--
-- When you use the ClientMetadata parameter, remember that Amazon Cognito
-- won\'t do the following:
--
-- -   Store the ClientMetadata value. This data is available only to
--     Lambda triggers that are assigned to a user pool to support custom
--     workflows. If your user pool configuration doesn\'t include
--     triggers, the ClientMetadata parameter serves no purpose.
--
-- -   Validate the ClientMetadata value.
--
-- -   Encrypt the ClientMetadata value. Don\'t use Amazon Cognito to
--     provide sensitive information.
adminRespondToAuthChallenge_clientMetadata :: Lens.Lens' AdminRespondToAuthChallenge (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
adminRespondToAuthChallenge_clientMetadata :: Lens' AdminRespondToAuthChallenge (Maybe (HashMap Text Text))
adminRespondToAuthChallenge_clientMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminRespondToAuthChallenge' {Maybe (HashMap Text Text)
clientMetadata :: Maybe (HashMap Text Text)
$sel:clientMetadata:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe (HashMap Text Text)
clientMetadata} -> Maybe (HashMap Text Text)
clientMetadata) (\s :: AdminRespondToAuthChallenge
s@AdminRespondToAuthChallenge' {} Maybe (HashMap Text Text)
a -> AdminRespondToAuthChallenge
s {$sel:clientMetadata:AdminRespondToAuthChallenge' :: Maybe (HashMap Text Text)
clientMetadata = Maybe (HashMap Text Text)
a} :: AdminRespondToAuthChallenge) 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

-- | Contextual data about your user session, such as the device fingerprint,
-- IP address, or location. Amazon Cognito advanced security evaluates the
-- risk of an authentication event based on the context that your app
-- generates and passes to Amazon Cognito when it makes API requests.
adminRespondToAuthChallenge_contextData :: Lens.Lens' AdminRespondToAuthChallenge (Prelude.Maybe ContextDataType)
adminRespondToAuthChallenge_contextData :: Lens' AdminRespondToAuthChallenge (Maybe ContextDataType)
adminRespondToAuthChallenge_contextData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminRespondToAuthChallenge' {Maybe ContextDataType
contextData :: Maybe ContextDataType
$sel:contextData:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe ContextDataType
contextData} -> Maybe ContextDataType
contextData) (\s :: AdminRespondToAuthChallenge
s@AdminRespondToAuthChallenge' {} Maybe ContextDataType
a -> AdminRespondToAuthChallenge
s {$sel:contextData:AdminRespondToAuthChallenge' :: Maybe ContextDataType
contextData = Maybe ContextDataType
a} :: AdminRespondToAuthChallenge)

-- | The session that should be passed both ways in challenge-response calls
-- to the service. If an @InitiateAuth@ or @RespondToAuthChallenge@ API
-- call determines that the caller must pass another challenge, it returns
-- a session with other challenge parameters. This session should be passed
-- as it is to the next @RespondToAuthChallenge@ API call.
adminRespondToAuthChallenge_session :: Lens.Lens' AdminRespondToAuthChallenge (Prelude.Maybe Prelude.Text)
adminRespondToAuthChallenge_session :: Lens' AdminRespondToAuthChallenge (Maybe Text)
adminRespondToAuthChallenge_session = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminRespondToAuthChallenge' {Maybe Text
session :: Maybe Text
$sel:session:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe Text
session} -> Maybe Text
session) (\s :: AdminRespondToAuthChallenge
s@AdminRespondToAuthChallenge' {} Maybe Text
a -> AdminRespondToAuthChallenge
s {$sel:session:AdminRespondToAuthChallenge' :: Maybe Text
session = Maybe Text
a} :: AdminRespondToAuthChallenge)

-- | The ID of the Amazon Cognito user pool.
adminRespondToAuthChallenge_userPoolId :: Lens.Lens' AdminRespondToAuthChallenge Prelude.Text
adminRespondToAuthChallenge_userPoolId :: Lens' AdminRespondToAuthChallenge Text
adminRespondToAuthChallenge_userPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminRespondToAuthChallenge' {Text
userPoolId :: Text
$sel:userPoolId:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Text
userPoolId} -> Text
userPoolId) (\s :: AdminRespondToAuthChallenge
s@AdminRespondToAuthChallenge' {} Text
a -> AdminRespondToAuthChallenge
s {$sel:userPoolId:AdminRespondToAuthChallenge' :: Text
userPoolId = Text
a} :: AdminRespondToAuthChallenge)

-- | The app client ID.
adminRespondToAuthChallenge_clientId :: Lens.Lens' AdminRespondToAuthChallenge Prelude.Text
adminRespondToAuthChallenge_clientId :: Lens' AdminRespondToAuthChallenge Text
adminRespondToAuthChallenge_clientId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminRespondToAuthChallenge' {Sensitive Text
clientId :: Sensitive Text
$sel:clientId:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Sensitive Text
clientId} -> Sensitive Text
clientId) (\s :: AdminRespondToAuthChallenge
s@AdminRespondToAuthChallenge' {} Sensitive Text
a -> AdminRespondToAuthChallenge
s {$sel:clientId:AdminRespondToAuthChallenge' :: Sensitive Text
clientId = Sensitive Text
a} :: AdminRespondToAuthChallenge) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The challenge name. For more information, see
-- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_AdminInitiateAuth.html AdminInitiateAuth>.
adminRespondToAuthChallenge_challengeName :: Lens.Lens' AdminRespondToAuthChallenge ChallengeNameType
adminRespondToAuthChallenge_challengeName :: Lens' AdminRespondToAuthChallenge ChallengeNameType
adminRespondToAuthChallenge_challengeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminRespondToAuthChallenge' {ChallengeNameType
challengeName :: ChallengeNameType
$sel:challengeName:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> ChallengeNameType
challengeName} -> ChallengeNameType
challengeName) (\s :: AdminRespondToAuthChallenge
s@AdminRespondToAuthChallenge' {} ChallengeNameType
a -> AdminRespondToAuthChallenge
s {$sel:challengeName:AdminRespondToAuthChallenge' :: ChallengeNameType
challengeName = ChallengeNameType
a} :: AdminRespondToAuthChallenge)

instance Core.AWSRequest AdminRespondToAuthChallenge where
  type
    AWSResponse AdminRespondToAuthChallenge =
      AdminRespondToAuthChallengeResponse
  request :: (Service -> Service)
-> AdminRespondToAuthChallenge
-> Request AdminRespondToAuthChallenge
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 AdminRespondToAuthChallenge
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AdminRespondToAuthChallenge)))
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 AuthenticationResultType
-> Maybe ChallengeNameType
-> Maybe (HashMap Text Text)
-> Maybe Text
-> Int
-> AdminRespondToAuthChallengeResponse
AdminRespondToAuthChallengeResponse'
            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
"AuthenticationResult")
            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
"ChallengeName")
            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
"ChallengeParameters"
                            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
"Session")
            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 AdminRespondToAuthChallenge where
  hashWithSalt :: Int -> AdminRespondToAuthChallenge -> Int
hashWithSalt Int
_salt AdminRespondToAuthChallenge' {Maybe Text
Maybe (HashMap Text Text)
Maybe AnalyticsMetadataType
Maybe ContextDataType
Text
Sensitive Text
ChallengeNameType
challengeName :: ChallengeNameType
clientId :: Sensitive Text
userPoolId :: Text
session :: Maybe Text
contextData :: Maybe ContextDataType
clientMetadata :: Maybe (HashMap Text Text)
challengeResponses :: Maybe (HashMap Text Text)
analyticsMetadata :: Maybe AnalyticsMetadataType
$sel:challengeName:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> ChallengeNameType
$sel:clientId:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Sensitive Text
$sel:userPoolId:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Text
$sel:session:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe Text
$sel:contextData:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe ContextDataType
$sel:clientMetadata:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe (HashMap Text Text)
$sel:challengeResponses:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe (HashMap Text Text)
$sel:analyticsMetadata:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe AnalyticsMetadataType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AnalyticsMetadataType
analyticsMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
challengeResponses
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
clientMetadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContextDataType
contextData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
session
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
clientId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ChallengeNameType
challengeName

instance Prelude.NFData AdminRespondToAuthChallenge where
  rnf :: AdminRespondToAuthChallenge -> ()
rnf AdminRespondToAuthChallenge' {Maybe Text
Maybe (HashMap Text Text)
Maybe AnalyticsMetadataType
Maybe ContextDataType
Text
Sensitive Text
ChallengeNameType
challengeName :: ChallengeNameType
clientId :: Sensitive Text
userPoolId :: Text
session :: Maybe Text
contextData :: Maybe ContextDataType
clientMetadata :: Maybe (HashMap Text Text)
challengeResponses :: Maybe (HashMap Text Text)
analyticsMetadata :: Maybe AnalyticsMetadataType
$sel:challengeName:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> ChallengeNameType
$sel:clientId:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Sensitive Text
$sel:userPoolId:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Text
$sel:session:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe Text
$sel:contextData:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe ContextDataType
$sel:clientMetadata:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe (HashMap Text Text)
$sel:challengeResponses:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe (HashMap Text Text)
$sel:analyticsMetadata:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe AnalyticsMetadataType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AnalyticsMetadataType
analyticsMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
challengeResponses
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
clientMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ContextDataType
contextData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
session
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userPoolId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
clientId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ChallengeNameType
challengeName

instance Data.ToHeaders AdminRespondToAuthChallenge where
  toHeaders :: AdminRespondToAuthChallenge -> 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
"AWSCognitoIdentityProviderService.AdminRespondToAuthChallenge" ::
                          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 AdminRespondToAuthChallenge where
  toJSON :: AdminRespondToAuthChallenge -> Value
toJSON AdminRespondToAuthChallenge' {Maybe Text
Maybe (HashMap Text Text)
Maybe AnalyticsMetadataType
Maybe ContextDataType
Text
Sensitive Text
ChallengeNameType
challengeName :: ChallengeNameType
clientId :: Sensitive Text
userPoolId :: Text
session :: Maybe Text
contextData :: Maybe ContextDataType
clientMetadata :: Maybe (HashMap Text Text)
challengeResponses :: Maybe (HashMap Text Text)
analyticsMetadata :: Maybe AnalyticsMetadataType
$sel:challengeName:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> ChallengeNameType
$sel:clientId:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Sensitive Text
$sel:userPoolId:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Text
$sel:session:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe Text
$sel:contextData:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe ContextDataType
$sel:clientMetadata:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe (HashMap Text Text)
$sel:challengeResponses:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe (HashMap Text Text)
$sel:analyticsMetadata:AdminRespondToAuthChallenge' :: AdminRespondToAuthChallenge -> Maybe AnalyticsMetadataType
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AnalyticsMetadata" 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 AnalyticsMetadataType
analyticsMetadata,
            (Key
"ChallengeResponses" 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 (HashMap Text Text)
challengeResponses,
            (Key
"ClientMetadata" 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 (HashMap Text Text)
clientMetadata,
            (Key
"ContextData" 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 ContextDataType
contextData,
            (Key
"Session" 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
session,
            forall a. a -> Maybe a
Prelude.Just (Key
"UserPoolId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userPoolId),
            forall a. a -> Maybe a
Prelude.Just (Key
"ClientId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
clientId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ChallengeName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ChallengeNameType
challengeName)
          ]
      )

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

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

-- | Responds to the authentication challenge, as an administrator.
--
-- /See:/ 'newAdminRespondToAuthChallengeResponse' smart constructor.
data AdminRespondToAuthChallengeResponse = AdminRespondToAuthChallengeResponse'
  { -- | The result returned by the server in response to the authentication
    -- request.
    AdminRespondToAuthChallengeResponse
-> Maybe AuthenticationResultType
authenticationResult :: Prelude.Maybe AuthenticationResultType,
    -- | The name of the challenge. For more information, see
    -- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_AdminInitiateAuth.html AdminInitiateAuth>.
    AdminRespondToAuthChallengeResponse -> Maybe ChallengeNameType
challengeName :: Prelude.Maybe ChallengeNameType,
    -- | The challenge parameters. For more information, see
    -- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_AdminInitiateAuth.html AdminInitiateAuth>.
    AdminRespondToAuthChallengeResponse -> Maybe (HashMap Text Text)
challengeParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The session that should be passed both ways in challenge-response calls
    -- to the service. If the caller must pass another challenge, they return a
    -- session with other challenge parameters. This session should be passed
    -- as it is to the next @RespondToAuthChallenge@ API call.
    AdminRespondToAuthChallengeResponse -> Maybe Text
session :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    AdminRespondToAuthChallengeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AdminRespondToAuthChallengeResponse
-> AdminRespondToAuthChallengeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdminRespondToAuthChallengeResponse
-> AdminRespondToAuthChallengeResponse -> Bool
$c/= :: AdminRespondToAuthChallengeResponse
-> AdminRespondToAuthChallengeResponse -> Bool
== :: AdminRespondToAuthChallengeResponse
-> AdminRespondToAuthChallengeResponse -> Bool
$c== :: AdminRespondToAuthChallengeResponse
-> AdminRespondToAuthChallengeResponse -> Bool
Prelude.Eq, Int -> AdminRespondToAuthChallengeResponse -> ShowS
[AdminRespondToAuthChallengeResponse] -> ShowS
AdminRespondToAuthChallengeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AdminRespondToAuthChallengeResponse] -> ShowS
$cshowList :: [AdminRespondToAuthChallengeResponse] -> ShowS
show :: AdminRespondToAuthChallengeResponse -> String
$cshow :: AdminRespondToAuthChallengeResponse -> String
showsPrec :: Int -> AdminRespondToAuthChallengeResponse -> ShowS
$cshowsPrec :: Int -> AdminRespondToAuthChallengeResponse -> ShowS
Prelude.Show, forall x.
Rep AdminRespondToAuthChallengeResponse x
-> AdminRespondToAuthChallengeResponse
forall x.
AdminRespondToAuthChallengeResponse
-> Rep AdminRespondToAuthChallengeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AdminRespondToAuthChallengeResponse x
-> AdminRespondToAuthChallengeResponse
$cfrom :: forall x.
AdminRespondToAuthChallengeResponse
-> Rep AdminRespondToAuthChallengeResponse x
Prelude.Generic)

-- |
-- Create a value of 'AdminRespondToAuthChallengeResponse' 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:
--
-- 'authenticationResult', 'adminRespondToAuthChallengeResponse_authenticationResult' - The result returned by the server in response to the authentication
-- request.
--
-- 'challengeName', 'adminRespondToAuthChallengeResponse_challengeName' - The name of the challenge. For more information, see
-- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_AdminInitiateAuth.html AdminInitiateAuth>.
--
-- 'challengeParameters', 'adminRespondToAuthChallengeResponse_challengeParameters' - The challenge parameters. For more information, see
-- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_AdminInitiateAuth.html AdminInitiateAuth>.
--
-- 'session', 'adminRespondToAuthChallengeResponse_session' - The session that should be passed both ways in challenge-response calls
-- to the service. If the caller must pass another challenge, they return a
-- session with other challenge parameters. This session should be passed
-- as it is to the next @RespondToAuthChallenge@ API call.
--
-- 'httpStatus', 'adminRespondToAuthChallengeResponse_httpStatus' - The response's http status code.
newAdminRespondToAuthChallengeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AdminRespondToAuthChallengeResponse
newAdminRespondToAuthChallengeResponse :: Int -> AdminRespondToAuthChallengeResponse
newAdminRespondToAuthChallengeResponse Int
pHttpStatus_ =
  AdminRespondToAuthChallengeResponse'
    { $sel:authenticationResult:AdminRespondToAuthChallengeResponse' :: Maybe AuthenticationResultType
authenticationResult =
        forall a. Maybe a
Prelude.Nothing,
      $sel:challengeName:AdminRespondToAuthChallengeResponse' :: Maybe ChallengeNameType
challengeName = forall a. Maybe a
Prelude.Nothing,
      $sel:challengeParameters:AdminRespondToAuthChallengeResponse' :: Maybe (HashMap Text Text)
challengeParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:session:AdminRespondToAuthChallengeResponse' :: Maybe Text
session = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AdminRespondToAuthChallengeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The result returned by the server in response to the authentication
-- request.
adminRespondToAuthChallengeResponse_authenticationResult :: Lens.Lens' AdminRespondToAuthChallengeResponse (Prelude.Maybe AuthenticationResultType)
adminRespondToAuthChallengeResponse_authenticationResult :: Lens'
  AdminRespondToAuthChallengeResponse
  (Maybe AuthenticationResultType)
adminRespondToAuthChallengeResponse_authenticationResult = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminRespondToAuthChallengeResponse' {Maybe AuthenticationResultType
authenticationResult :: Maybe AuthenticationResultType
$sel:authenticationResult:AdminRespondToAuthChallengeResponse' :: AdminRespondToAuthChallengeResponse
-> Maybe AuthenticationResultType
authenticationResult} -> Maybe AuthenticationResultType
authenticationResult) (\s :: AdminRespondToAuthChallengeResponse
s@AdminRespondToAuthChallengeResponse' {} Maybe AuthenticationResultType
a -> AdminRespondToAuthChallengeResponse
s {$sel:authenticationResult:AdminRespondToAuthChallengeResponse' :: Maybe AuthenticationResultType
authenticationResult = Maybe AuthenticationResultType
a} :: AdminRespondToAuthChallengeResponse)

-- | The name of the challenge. For more information, see
-- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_AdminInitiateAuth.html AdminInitiateAuth>.
adminRespondToAuthChallengeResponse_challengeName :: Lens.Lens' AdminRespondToAuthChallengeResponse (Prelude.Maybe ChallengeNameType)
adminRespondToAuthChallengeResponse_challengeName :: Lens' AdminRespondToAuthChallengeResponse (Maybe ChallengeNameType)
adminRespondToAuthChallengeResponse_challengeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminRespondToAuthChallengeResponse' {Maybe ChallengeNameType
challengeName :: Maybe ChallengeNameType
$sel:challengeName:AdminRespondToAuthChallengeResponse' :: AdminRespondToAuthChallengeResponse -> Maybe ChallengeNameType
challengeName} -> Maybe ChallengeNameType
challengeName) (\s :: AdminRespondToAuthChallengeResponse
s@AdminRespondToAuthChallengeResponse' {} Maybe ChallengeNameType
a -> AdminRespondToAuthChallengeResponse
s {$sel:challengeName:AdminRespondToAuthChallengeResponse' :: Maybe ChallengeNameType
challengeName = Maybe ChallengeNameType
a} :: AdminRespondToAuthChallengeResponse)

-- | The challenge parameters. For more information, see
-- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_AdminInitiateAuth.html AdminInitiateAuth>.
adminRespondToAuthChallengeResponse_challengeParameters :: Lens.Lens' AdminRespondToAuthChallengeResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
adminRespondToAuthChallengeResponse_challengeParameters :: Lens'
  AdminRespondToAuthChallengeResponse (Maybe (HashMap Text Text))
adminRespondToAuthChallengeResponse_challengeParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminRespondToAuthChallengeResponse' {Maybe (HashMap Text Text)
challengeParameters :: Maybe (HashMap Text Text)
$sel:challengeParameters:AdminRespondToAuthChallengeResponse' :: AdminRespondToAuthChallengeResponse -> Maybe (HashMap Text Text)
challengeParameters} -> Maybe (HashMap Text Text)
challengeParameters) (\s :: AdminRespondToAuthChallengeResponse
s@AdminRespondToAuthChallengeResponse' {} Maybe (HashMap Text Text)
a -> AdminRespondToAuthChallengeResponse
s {$sel:challengeParameters:AdminRespondToAuthChallengeResponse' :: Maybe (HashMap Text Text)
challengeParameters = Maybe (HashMap Text Text)
a} :: AdminRespondToAuthChallengeResponse) 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

-- | The session that should be passed both ways in challenge-response calls
-- to the service. If the caller must pass another challenge, they return a
-- session with other challenge parameters. This session should be passed
-- as it is to the next @RespondToAuthChallenge@ API call.
adminRespondToAuthChallengeResponse_session :: Lens.Lens' AdminRespondToAuthChallengeResponse (Prelude.Maybe Prelude.Text)
adminRespondToAuthChallengeResponse_session :: Lens' AdminRespondToAuthChallengeResponse (Maybe Text)
adminRespondToAuthChallengeResponse_session = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AdminRespondToAuthChallengeResponse' {Maybe Text
session :: Maybe Text
$sel:session:AdminRespondToAuthChallengeResponse' :: AdminRespondToAuthChallengeResponse -> Maybe Text
session} -> Maybe Text
session) (\s :: AdminRespondToAuthChallengeResponse
s@AdminRespondToAuthChallengeResponse' {} Maybe Text
a -> AdminRespondToAuthChallengeResponse
s {$sel:session:AdminRespondToAuthChallengeResponse' :: Maybe Text
session = Maybe Text
a} :: AdminRespondToAuthChallengeResponse)

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

instance
  Prelude.NFData
    AdminRespondToAuthChallengeResponse
  where
  rnf :: AdminRespondToAuthChallengeResponse -> ()
rnf AdminRespondToAuthChallengeResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
Maybe ChallengeNameType
Maybe AuthenticationResultType
httpStatus :: Int
session :: Maybe Text
challengeParameters :: Maybe (HashMap Text Text)
challengeName :: Maybe ChallengeNameType
authenticationResult :: Maybe AuthenticationResultType
$sel:httpStatus:AdminRespondToAuthChallengeResponse' :: AdminRespondToAuthChallengeResponse -> Int
$sel:session:AdminRespondToAuthChallengeResponse' :: AdminRespondToAuthChallengeResponse -> Maybe Text
$sel:challengeParameters:AdminRespondToAuthChallengeResponse' :: AdminRespondToAuthChallengeResponse -> Maybe (HashMap Text Text)
$sel:challengeName:AdminRespondToAuthChallengeResponse' :: AdminRespondToAuthChallengeResponse -> Maybe ChallengeNameType
$sel:authenticationResult:AdminRespondToAuthChallengeResponse' :: AdminRespondToAuthChallengeResponse
-> Maybe AuthenticationResultType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AuthenticationResultType
authenticationResult
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChallengeNameType
challengeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
challengeParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
session
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus