{-# 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.SetUserPoolMfaConfig
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets the user pool multi-factor authentication (MFA) configuration.
--
-- 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/.
module Amazonka.CognitoIdentityProvider.SetUserPoolMfaConfig
  ( -- * Creating a Request
    SetUserPoolMfaConfig (..),
    newSetUserPoolMfaConfig,

    -- * Request Lenses
    setUserPoolMfaConfig_mfaConfiguration,
    setUserPoolMfaConfig_smsMfaConfiguration,
    setUserPoolMfaConfig_softwareTokenMfaConfiguration,
    setUserPoolMfaConfig_userPoolId,

    -- * Destructuring the Response
    SetUserPoolMfaConfigResponse (..),
    newSetUserPoolMfaConfigResponse,

    -- * Response Lenses
    setUserPoolMfaConfigResponse_mfaConfiguration,
    setUserPoolMfaConfigResponse_smsMfaConfiguration,
    setUserPoolMfaConfigResponse_softwareTokenMfaConfiguration,
    setUserPoolMfaConfigResponse_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

-- | /See:/ 'newSetUserPoolMfaConfig' smart constructor.
data SetUserPoolMfaConfig = SetUserPoolMfaConfig'
  { -- | The MFA configuration. If you set the MfaConfiguration value to ‘ON’,
    -- only users who have set up an MFA factor can sign in. To learn more, see
    -- <https://docs.aws.amazon.com/cognito/latest/developerguide/user-pool-settings-mfa.html Adding Multi-Factor Authentication (MFA) to a user pool>.
    -- Valid values include:
    --
    -- -   @OFF@ MFA won\'t be used for any users.
    --
    -- -   @ON@ MFA is required for all users to sign in.
    --
    -- -   @OPTIONAL@ MFA will be required only for individual users who have
    --     an MFA factor activated.
    SetUserPoolMfaConfig -> Maybe UserPoolMfaType
mfaConfiguration :: Prelude.Maybe UserPoolMfaType,
    -- | The SMS text message MFA configuration.
    SetUserPoolMfaConfig -> Maybe SmsMfaConfigType
smsMfaConfiguration :: Prelude.Maybe SmsMfaConfigType,
    -- | The software token MFA configuration.
    SetUserPoolMfaConfig -> Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration :: Prelude.Maybe SoftwareTokenMfaConfigType,
    -- | The user pool ID.
    SetUserPoolMfaConfig -> Text
userPoolId :: Prelude.Text
  }
  deriving (SetUserPoolMfaConfig -> SetUserPoolMfaConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetUserPoolMfaConfig -> SetUserPoolMfaConfig -> Bool
$c/= :: SetUserPoolMfaConfig -> SetUserPoolMfaConfig -> Bool
== :: SetUserPoolMfaConfig -> SetUserPoolMfaConfig -> Bool
$c== :: SetUserPoolMfaConfig -> SetUserPoolMfaConfig -> Bool
Prelude.Eq, ReadPrec [SetUserPoolMfaConfig]
ReadPrec SetUserPoolMfaConfig
Int -> ReadS SetUserPoolMfaConfig
ReadS [SetUserPoolMfaConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetUserPoolMfaConfig]
$creadListPrec :: ReadPrec [SetUserPoolMfaConfig]
readPrec :: ReadPrec SetUserPoolMfaConfig
$creadPrec :: ReadPrec SetUserPoolMfaConfig
readList :: ReadS [SetUserPoolMfaConfig]
$creadList :: ReadS [SetUserPoolMfaConfig]
readsPrec :: Int -> ReadS SetUserPoolMfaConfig
$creadsPrec :: Int -> ReadS SetUserPoolMfaConfig
Prelude.Read, Int -> SetUserPoolMfaConfig -> ShowS
[SetUserPoolMfaConfig] -> ShowS
SetUserPoolMfaConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetUserPoolMfaConfig] -> ShowS
$cshowList :: [SetUserPoolMfaConfig] -> ShowS
show :: SetUserPoolMfaConfig -> String
$cshow :: SetUserPoolMfaConfig -> String
showsPrec :: Int -> SetUserPoolMfaConfig -> ShowS
$cshowsPrec :: Int -> SetUserPoolMfaConfig -> ShowS
Prelude.Show, forall x. Rep SetUserPoolMfaConfig x -> SetUserPoolMfaConfig
forall x. SetUserPoolMfaConfig -> Rep SetUserPoolMfaConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetUserPoolMfaConfig x -> SetUserPoolMfaConfig
$cfrom :: forall x. SetUserPoolMfaConfig -> Rep SetUserPoolMfaConfig x
Prelude.Generic)

-- |
-- Create a value of 'SetUserPoolMfaConfig' 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:
--
-- 'mfaConfiguration', 'setUserPoolMfaConfig_mfaConfiguration' - The MFA configuration. If you set the MfaConfiguration value to ‘ON’,
-- only users who have set up an MFA factor can sign in. To learn more, see
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/user-pool-settings-mfa.html Adding Multi-Factor Authentication (MFA) to a user pool>.
-- Valid values include:
--
-- -   @OFF@ MFA won\'t be used for any users.
--
-- -   @ON@ MFA is required for all users to sign in.
--
-- -   @OPTIONAL@ MFA will be required only for individual users who have
--     an MFA factor activated.
--
-- 'smsMfaConfiguration', 'setUserPoolMfaConfig_smsMfaConfiguration' - The SMS text message MFA configuration.
--
-- 'softwareTokenMfaConfiguration', 'setUserPoolMfaConfig_softwareTokenMfaConfiguration' - The software token MFA configuration.
--
-- 'userPoolId', 'setUserPoolMfaConfig_userPoolId' - The user pool ID.
newSetUserPoolMfaConfig ::
  -- | 'userPoolId'
  Prelude.Text ->
  SetUserPoolMfaConfig
newSetUserPoolMfaConfig :: Text -> SetUserPoolMfaConfig
newSetUserPoolMfaConfig Text
pUserPoolId_ =
  SetUserPoolMfaConfig'
    { $sel:mfaConfiguration:SetUserPoolMfaConfig' :: Maybe UserPoolMfaType
mfaConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:smsMfaConfiguration:SetUserPoolMfaConfig' :: Maybe SmsMfaConfigType
smsMfaConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:softwareTokenMfaConfiguration:SetUserPoolMfaConfig' :: Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:userPoolId:SetUserPoolMfaConfig' :: Text
userPoolId = Text
pUserPoolId_
    }

-- | The MFA configuration. If you set the MfaConfiguration value to ‘ON’,
-- only users who have set up an MFA factor can sign in. To learn more, see
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/user-pool-settings-mfa.html Adding Multi-Factor Authentication (MFA) to a user pool>.
-- Valid values include:
--
-- -   @OFF@ MFA won\'t be used for any users.
--
-- -   @ON@ MFA is required for all users to sign in.
--
-- -   @OPTIONAL@ MFA will be required only for individual users who have
--     an MFA factor activated.
setUserPoolMfaConfig_mfaConfiguration :: Lens.Lens' SetUserPoolMfaConfig (Prelude.Maybe UserPoolMfaType)
setUserPoolMfaConfig_mfaConfiguration :: Lens' SetUserPoolMfaConfig (Maybe UserPoolMfaType)
setUserPoolMfaConfig_mfaConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetUserPoolMfaConfig' {Maybe UserPoolMfaType
mfaConfiguration :: Maybe UserPoolMfaType
$sel:mfaConfiguration:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Maybe UserPoolMfaType
mfaConfiguration} -> Maybe UserPoolMfaType
mfaConfiguration) (\s :: SetUserPoolMfaConfig
s@SetUserPoolMfaConfig' {} Maybe UserPoolMfaType
a -> SetUserPoolMfaConfig
s {$sel:mfaConfiguration:SetUserPoolMfaConfig' :: Maybe UserPoolMfaType
mfaConfiguration = Maybe UserPoolMfaType
a} :: SetUserPoolMfaConfig)

-- | The SMS text message MFA configuration.
setUserPoolMfaConfig_smsMfaConfiguration :: Lens.Lens' SetUserPoolMfaConfig (Prelude.Maybe SmsMfaConfigType)
setUserPoolMfaConfig_smsMfaConfiguration :: Lens' SetUserPoolMfaConfig (Maybe SmsMfaConfigType)
setUserPoolMfaConfig_smsMfaConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetUserPoolMfaConfig' {Maybe SmsMfaConfigType
smsMfaConfiguration :: Maybe SmsMfaConfigType
$sel:smsMfaConfiguration:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Maybe SmsMfaConfigType
smsMfaConfiguration} -> Maybe SmsMfaConfigType
smsMfaConfiguration) (\s :: SetUserPoolMfaConfig
s@SetUserPoolMfaConfig' {} Maybe SmsMfaConfigType
a -> SetUserPoolMfaConfig
s {$sel:smsMfaConfiguration:SetUserPoolMfaConfig' :: Maybe SmsMfaConfigType
smsMfaConfiguration = Maybe SmsMfaConfigType
a} :: SetUserPoolMfaConfig)

-- | The software token MFA configuration.
setUserPoolMfaConfig_softwareTokenMfaConfiguration :: Lens.Lens' SetUserPoolMfaConfig (Prelude.Maybe SoftwareTokenMfaConfigType)
setUserPoolMfaConfig_softwareTokenMfaConfiguration :: Lens' SetUserPoolMfaConfig (Maybe SoftwareTokenMfaConfigType)
setUserPoolMfaConfig_softwareTokenMfaConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetUserPoolMfaConfig' {Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration :: Maybe SoftwareTokenMfaConfigType
$sel:softwareTokenMfaConfiguration:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration} -> Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration) (\s :: SetUserPoolMfaConfig
s@SetUserPoolMfaConfig' {} Maybe SoftwareTokenMfaConfigType
a -> SetUserPoolMfaConfig
s {$sel:softwareTokenMfaConfiguration:SetUserPoolMfaConfig' :: Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration = Maybe SoftwareTokenMfaConfigType
a} :: SetUserPoolMfaConfig)

-- | The user pool ID.
setUserPoolMfaConfig_userPoolId :: Lens.Lens' SetUserPoolMfaConfig Prelude.Text
setUserPoolMfaConfig_userPoolId :: Lens' SetUserPoolMfaConfig Text
setUserPoolMfaConfig_userPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetUserPoolMfaConfig' {Text
userPoolId :: Text
$sel:userPoolId:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Text
userPoolId} -> Text
userPoolId) (\s :: SetUserPoolMfaConfig
s@SetUserPoolMfaConfig' {} Text
a -> SetUserPoolMfaConfig
s {$sel:userPoolId:SetUserPoolMfaConfig' :: Text
userPoolId = Text
a} :: SetUserPoolMfaConfig)

instance Core.AWSRequest SetUserPoolMfaConfig where
  type
    AWSResponse SetUserPoolMfaConfig =
      SetUserPoolMfaConfigResponse
  request :: (Service -> Service)
-> SetUserPoolMfaConfig -> Request SetUserPoolMfaConfig
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 SetUserPoolMfaConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SetUserPoolMfaConfig)))
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 UserPoolMfaType
-> Maybe SmsMfaConfigType
-> Maybe SoftwareTokenMfaConfigType
-> Int
-> SetUserPoolMfaConfigResponse
SetUserPoolMfaConfigResponse'
            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
"MfaConfiguration")
            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
"SmsMfaConfiguration")
            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
"SoftwareTokenMfaConfiguration")
            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 SetUserPoolMfaConfig where
  hashWithSalt :: Int -> SetUserPoolMfaConfig -> Int
hashWithSalt Int
_salt SetUserPoolMfaConfig' {Maybe SmsMfaConfigType
Maybe SoftwareTokenMfaConfigType
Maybe UserPoolMfaType
Text
userPoolId :: Text
softwareTokenMfaConfiguration :: Maybe SoftwareTokenMfaConfigType
smsMfaConfiguration :: Maybe SmsMfaConfigType
mfaConfiguration :: Maybe UserPoolMfaType
$sel:userPoolId:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Text
$sel:softwareTokenMfaConfiguration:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Maybe SoftwareTokenMfaConfigType
$sel:smsMfaConfiguration:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Maybe SmsMfaConfigType
$sel:mfaConfiguration:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Maybe UserPoolMfaType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UserPoolMfaType
mfaConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SmsMfaConfigType
smsMfaConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userPoolId

instance Prelude.NFData SetUserPoolMfaConfig where
  rnf :: SetUserPoolMfaConfig -> ()
rnf SetUserPoolMfaConfig' {Maybe SmsMfaConfigType
Maybe SoftwareTokenMfaConfigType
Maybe UserPoolMfaType
Text
userPoolId :: Text
softwareTokenMfaConfiguration :: Maybe SoftwareTokenMfaConfigType
smsMfaConfiguration :: Maybe SmsMfaConfigType
mfaConfiguration :: Maybe UserPoolMfaType
$sel:userPoolId:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Text
$sel:softwareTokenMfaConfiguration:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Maybe SoftwareTokenMfaConfigType
$sel:smsMfaConfiguration:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Maybe SmsMfaConfigType
$sel:mfaConfiguration:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Maybe UserPoolMfaType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe UserPoolMfaType
mfaConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SmsMfaConfigType
smsMfaConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userPoolId

instance Data.ToHeaders SetUserPoolMfaConfig where
  toHeaders :: SetUserPoolMfaConfig -> 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.SetUserPoolMfaConfig" ::
                          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 SetUserPoolMfaConfig where
  toJSON :: SetUserPoolMfaConfig -> Value
toJSON SetUserPoolMfaConfig' {Maybe SmsMfaConfigType
Maybe SoftwareTokenMfaConfigType
Maybe UserPoolMfaType
Text
userPoolId :: Text
softwareTokenMfaConfiguration :: Maybe SoftwareTokenMfaConfigType
smsMfaConfiguration :: Maybe SmsMfaConfigType
mfaConfiguration :: Maybe UserPoolMfaType
$sel:userPoolId:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Text
$sel:softwareTokenMfaConfiguration:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Maybe SoftwareTokenMfaConfigType
$sel:smsMfaConfiguration:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Maybe SmsMfaConfigType
$sel:mfaConfiguration:SetUserPoolMfaConfig' :: SetUserPoolMfaConfig -> Maybe UserPoolMfaType
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MfaConfiguration" 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 UserPoolMfaType
mfaConfiguration,
            (Key
"SmsMfaConfiguration" 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 SmsMfaConfigType
smsMfaConfiguration,
            (Key
"SoftwareTokenMfaConfiguration" 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 SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration,
            forall a. a -> Maybe a
Prelude.Just (Key
"UserPoolId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
userPoolId)
          ]
      )

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

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

-- | /See:/ 'newSetUserPoolMfaConfigResponse' smart constructor.
data SetUserPoolMfaConfigResponse = SetUserPoolMfaConfigResponse'
  { -- | The MFA configuration. Valid values include:
    --
    -- -   @OFF@ MFA won\'t be used for any users.
    --
    -- -   @ON@ MFA is required for all users to sign in.
    --
    -- -   @OPTIONAL@ MFA will be required only for individual users who have
    --     an MFA factor enabled.
    SetUserPoolMfaConfigResponse -> Maybe UserPoolMfaType
mfaConfiguration :: Prelude.Maybe UserPoolMfaType,
    -- | The SMS text message MFA configuration.
    SetUserPoolMfaConfigResponse -> Maybe SmsMfaConfigType
smsMfaConfiguration :: Prelude.Maybe SmsMfaConfigType,
    -- | The software token MFA configuration.
    SetUserPoolMfaConfigResponse -> Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration :: Prelude.Maybe SoftwareTokenMfaConfigType,
    -- | The response's http status code.
    SetUserPoolMfaConfigResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SetUserPoolMfaConfigResponse
-> SetUserPoolMfaConfigResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetUserPoolMfaConfigResponse
-> SetUserPoolMfaConfigResponse -> Bool
$c/= :: SetUserPoolMfaConfigResponse
-> SetUserPoolMfaConfigResponse -> Bool
== :: SetUserPoolMfaConfigResponse
-> SetUserPoolMfaConfigResponse -> Bool
$c== :: SetUserPoolMfaConfigResponse
-> SetUserPoolMfaConfigResponse -> Bool
Prelude.Eq, ReadPrec [SetUserPoolMfaConfigResponse]
ReadPrec SetUserPoolMfaConfigResponse
Int -> ReadS SetUserPoolMfaConfigResponse
ReadS [SetUserPoolMfaConfigResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetUserPoolMfaConfigResponse]
$creadListPrec :: ReadPrec [SetUserPoolMfaConfigResponse]
readPrec :: ReadPrec SetUserPoolMfaConfigResponse
$creadPrec :: ReadPrec SetUserPoolMfaConfigResponse
readList :: ReadS [SetUserPoolMfaConfigResponse]
$creadList :: ReadS [SetUserPoolMfaConfigResponse]
readsPrec :: Int -> ReadS SetUserPoolMfaConfigResponse
$creadsPrec :: Int -> ReadS SetUserPoolMfaConfigResponse
Prelude.Read, Int -> SetUserPoolMfaConfigResponse -> ShowS
[SetUserPoolMfaConfigResponse] -> ShowS
SetUserPoolMfaConfigResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetUserPoolMfaConfigResponse] -> ShowS
$cshowList :: [SetUserPoolMfaConfigResponse] -> ShowS
show :: SetUserPoolMfaConfigResponse -> String
$cshow :: SetUserPoolMfaConfigResponse -> String
showsPrec :: Int -> SetUserPoolMfaConfigResponse -> ShowS
$cshowsPrec :: Int -> SetUserPoolMfaConfigResponse -> ShowS
Prelude.Show, forall x.
Rep SetUserPoolMfaConfigResponse x -> SetUserPoolMfaConfigResponse
forall x.
SetUserPoolMfaConfigResponse -> Rep SetUserPoolMfaConfigResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SetUserPoolMfaConfigResponse x -> SetUserPoolMfaConfigResponse
$cfrom :: forall x.
SetUserPoolMfaConfigResponse -> Rep SetUserPoolMfaConfigResponse x
Prelude.Generic)

-- |
-- Create a value of 'SetUserPoolMfaConfigResponse' 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:
--
-- 'mfaConfiguration', 'setUserPoolMfaConfigResponse_mfaConfiguration' - The MFA configuration. Valid values include:
--
-- -   @OFF@ MFA won\'t be used for any users.
--
-- -   @ON@ MFA is required for all users to sign in.
--
-- -   @OPTIONAL@ MFA will be required only for individual users who have
--     an MFA factor enabled.
--
-- 'smsMfaConfiguration', 'setUserPoolMfaConfigResponse_smsMfaConfiguration' - The SMS text message MFA configuration.
--
-- 'softwareTokenMfaConfiguration', 'setUserPoolMfaConfigResponse_softwareTokenMfaConfiguration' - The software token MFA configuration.
--
-- 'httpStatus', 'setUserPoolMfaConfigResponse_httpStatus' - The response's http status code.
newSetUserPoolMfaConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SetUserPoolMfaConfigResponse
newSetUserPoolMfaConfigResponse :: Int -> SetUserPoolMfaConfigResponse
newSetUserPoolMfaConfigResponse Int
pHttpStatus_ =
  SetUserPoolMfaConfigResponse'
    { $sel:mfaConfiguration:SetUserPoolMfaConfigResponse' :: Maybe UserPoolMfaType
mfaConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:smsMfaConfiguration:SetUserPoolMfaConfigResponse' :: Maybe SmsMfaConfigType
smsMfaConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:softwareTokenMfaConfiguration:SetUserPoolMfaConfigResponse' :: Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SetUserPoolMfaConfigResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The MFA configuration. Valid values include:
--
-- -   @OFF@ MFA won\'t be used for any users.
--
-- -   @ON@ MFA is required for all users to sign in.
--
-- -   @OPTIONAL@ MFA will be required only for individual users who have
--     an MFA factor enabled.
setUserPoolMfaConfigResponse_mfaConfiguration :: Lens.Lens' SetUserPoolMfaConfigResponse (Prelude.Maybe UserPoolMfaType)
setUserPoolMfaConfigResponse_mfaConfiguration :: Lens' SetUserPoolMfaConfigResponse (Maybe UserPoolMfaType)
setUserPoolMfaConfigResponse_mfaConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetUserPoolMfaConfigResponse' {Maybe UserPoolMfaType
mfaConfiguration :: Maybe UserPoolMfaType
$sel:mfaConfiguration:SetUserPoolMfaConfigResponse' :: SetUserPoolMfaConfigResponse -> Maybe UserPoolMfaType
mfaConfiguration} -> Maybe UserPoolMfaType
mfaConfiguration) (\s :: SetUserPoolMfaConfigResponse
s@SetUserPoolMfaConfigResponse' {} Maybe UserPoolMfaType
a -> SetUserPoolMfaConfigResponse
s {$sel:mfaConfiguration:SetUserPoolMfaConfigResponse' :: Maybe UserPoolMfaType
mfaConfiguration = Maybe UserPoolMfaType
a} :: SetUserPoolMfaConfigResponse)

-- | The SMS text message MFA configuration.
setUserPoolMfaConfigResponse_smsMfaConfiguration :: Lens.Lens' SetUserPoolMfaConfigResponse (Prelude.Maybe SmsMfaConfigType)
setUserPoolMfaConfigResponse_smsMfaConfiguration :: Lens' SetUserPoolMfaConfigResponse (Maybe SmsMfaConfigType)
setUserPoolMfaConfigResponse_smsMfaConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetUserPoolMfaConfigResponse' {Maybe SmsMfaConfigType
smsMfaConfiguration :: Maybe SmsMfaConfigType
$sel:smsMfaConfiguration:SetUserPoolMfaConfigResponse' :: SetUserPoolMfaConfigResponse -> Maybe SmsMfaConfigType
smsMfaConfiguration} -> Maybe SmsMfaConfigType
smsMfaConfiguration) (\s :: SetUserPoolMfaConfigResponse
s@SetUserPoolMfaConfigResponse' {} Maybe SmsMfaConfigType
a -> SetUserPoolMfaConfigResponse
s {$sel:smsMfaConfiguration:SetUserPoolMfaConfigResponse' :: Maybe SmsMfaConfigType
smsMfaConfiguration = Maybe SmsMfaConfigType
a} :: SetUserPoolMfaConfigResponse)

-- | The software token MFA configuration.
setUserPoolMfaConfigResponse_softwareTokenMfaConfiguration :: Lens.Lens' SetUserPoolMfaConfigResponse (Prelude.Maybe SoftwareTokenMfaConfigType)
setUserPoolMfaConfigResponse_softwareTokenMfaConfiguration :: Lens'
  SetUserPoolMfaConfigResponse (Maybe SoftwareTokenMfaConfigType)
setUserPoolMfaConfigResponse_softwareTokenMfaConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetUserPoolMfaConfigResponse' {Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration :: Maybe SoftwareTokenMfaConfigType
$sel:softwareTokenMfaConfiguration:SetUserPoolMfaConfigResponse' :: SetUserPoolMfaConfigResponse -> Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration} -> Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration) (\s :: SetUserPoolMfaConfigResponse
s@SetUserPoolMfaConfigResponse' {} Maybe SoftwareTokenMfaConfigType
a -> SetUserPoolMfaConfigResponse
s {$sel:softwareTokenMfaConfiguration:SetUserPoolMfaConfigResponse' :: Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration = Maybe SoftwareTokenMfaConfigType
a} :: SetUserPoolMfaConfigResponse)

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

instance Prelude.NFData SetUserPoolMfaConfigResponse where
  rnf :: SetUserPoolMfaConfigResponse -> ()
rnf SetUserPoolMfaConfigResponse' {Int
Maybe SmsMfaConfigType
Maybe SoftwareTokenMfaConfigType
Maybe UserPoolMfaType
httpStatus :: Int
softwareTokenMfaConfiguration :: Maybe SoftwareTokenMfaConfigType
smsMfaConfiguration :: Maybe SmsMfaConfigType
mfaConfiguration :: Maybe UserPoolMfaType
$sel:httpStatus:SetUserPoolMfaConfigResponse' :: SetUserPoolMfaConfigResponse -> Int
$sel:softwareTokenMfaConfiguration:SetUserPoolMfaConfigResponse' :: SetUserPoolMfaConfigResponse -> Maybe SoftwareTokenMfaConfigType
$sel:smsMfaConfiguration:SetUserPoolMfaConfigResponse' :: SetUserPoolMfaConfigResponse -> Maybe SmsMfaConfigType
$sel:mfaConfiguration:SetUserPoolMfaConfigResponse' :: SetUserPoolMfaConfigResponse -> Maybe UserPoolMfaType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe UserPoolMfaType
mfaConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SmsMfaConfigType
smsMfaConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus