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

    -- * Request Lenses
    getUserPoolMfaConfig_userPoolId,

    -- * Destructuring the Response
    GetUserPoolMfaConfigResponse (..),
    newGetUserPoolMfaConfigResponse,

    -- * Response Lenses
    getUserPoolMfaConfigResponse_mfaConfiguration,
    getUserPoolMfaConfigResponse_smsMfaConfiguration,
    getUserPoolMfaConfigResponse_softwareTokenMfaConfiguration,
    getUserPoolMfaConfigResponse_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:/ 'newGetUserPoolMfaConfig' smart constructor.
data GetUserPoolMfaConfig = GetUserPoolMfaConfig'
  { -- | The user pool ID.
    GetUserPoolMfaConfig -> Text
userPoolId :: Prelude.Text
  }
  deriving (GetUserPoolMfaConfig -> GetUserPoolMfaConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUserPoolMfaConfig -> GetUserPoolMfaConfig -> Bool
$c/= :: GetUserPoolMfaConfig -> GetUserPoolMfaConfig -> Bool
== :: GetUserPoolMfaConfig -> GetUserPoolMfaConfig -> Bool
$c== :: GetUserPoolMfaConfig -> GetUserPoolMfaConfig -> Bool
Prelude.Eq, ReadPrec [GetUserPoolMfaConfig]
ReadPrec GetUserPoolMfaConfig
Int -> ReadS GetUserPoolMfaConfig
ReadS [GetUserPoolMfaConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetUserPoolMfaConfig]
$creadListPrec :: ReadPrec [GetUserPoolMfaConfig]
readPrec :: ReadPrec GetUserPoolMfaConfig
$creadPrec :: ReadPrec GetUserPoolMfaConfig
readList :: ReadS [GetUserPoolMfaConfig]
$creadList :: ReadS [GetUserPoolMfaConfig]
readsPrec :: Int -> ReadS GetUserPoolMfaConfig
$creadsPrec :: Int -> ReadS GetUserPoolMfaConfig
Prelude.Read, Int -> GetUserPoolMfaConfig -> ShowS
[GetUserPoolMfaConfig] -> ShowS
GetUserPoolMfaConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUserPoolMfaConfig] -> ShowS
$cshowList :: [GetUserPoolMfaConfig] -> ShowS
show :: GetUserPoolMfaConfig -> String
$cshow :: GetUserPoolMfaConfig -> String
showsPrec :: Int -> GetUserPoolMfaConfig -> ShowS
$cshowsPrec :: Int -> GetUserPoolMfaConfig -> ShowS
Prelude.Show, forall x. Rep GetUserPoolMfaConfig x -> GetUserPoolMfaConfig
forall x. GetUserPoolMfaConfig -> Rep GetUserPoolMfaConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetUserPoolMfaConfig x -> GetUserPoolMfaConfig
$cfrom :: forall x. GetUserPoolMfaConfig -> Rep GetUserPoolMfaConfig x
Prelude.Generic)

-- |
-- Create a value of 'GetUserPoolMfaConfig' 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:
--
-- 'userPoolId', 'getUserPoolMfaConfig_userPoolId' - The user pool ID.
newGetUserPoolMfaConfig ::
  -- | 'userPoolId'
  Prelude.Text ->
  GetUserPoolMfaConfig
newGetUserPoolMfaConfig :: Text -> GetUserPoolMfaConfig
newGetUserPoolMfaConfig Text
pUserPoolId_ =
  GetUserPoolMfaConfig' {$sel:userPoolId:GetUserPoolMfaConfig' :: Text
userPoolId = Text
pUserPoolId_}

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

instance Core.AWSRequest GetUserPoolMfaConfig where
  type
    AWSResponse GetUserPoolMfaConfig =
      GetUserPoolMfaConfigResponse
  request :: (Service -> Service)
-> GetUserPoolMfaConfig -> Request GetUserPoolMfaConfig
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 GetUserPoolMfaConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetUserPoolMfaConfig)))
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
-> GetUserPoolMfaConfigResponse
GetUserPoolMfaConfigResponse'
            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 GetUserPoolMfaConfig where
  hashWithSalt :: Int -> GetUserPoolMfaConfig -> Int
hashWithSalt Int
_salt GetUserPoolMfaConfig' {Text
userPoolId :: Text
$sel:userPoolId:GetUserPoolMfaConfig' :: GetUserPoolMfaConfig -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userPoolId

instance Prelude.NFData GetUserPoolMfaConfig where
  rnf :: GetUserPoolMfaConfig -> ()
rnf GetUserPoolMfaConfig' {Text
userPoolId :: Text
$sel:userPoolId:GetUserPoolMfaConfig' :: GetUserPoolMfaConfig -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
userPoolId

instance Data.ToHeaders GetUserPoolMfaConfig where
  toHeaders :: GetUserPoolMfaConfig -> 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.GetUserPoolMfaConfig" ::
                          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 GetUserPoolMfaConfig where
  toJSON :: GetUserPoolMfaConfig -> Value
toJSON GetUserPoolMfaConfig' {Text
userPoolId :: Text
$sel:userPoolId:GetUserPoolMfaConfig' :: GetUserPoolMfaConfig -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [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 GetUserPoolMfaConfig where
  toPath :: GetUserPoolMfaConfig -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newGetUserPoolMfaConfigResponse' smart constructor.
data GetUserPoolMfaConfigResponse = GetUserPoolMfaConfigResponse'
  { -- | The multi-factor authentication (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 activated.
    GetUserPoolMfaConfigResponse -> Maybe UserPoolMfaType
mfaConfiguration :: Prelude.Maybe UserPoolMfaType,
    -- | The SMS text message multi-factor authentication (MFA) configuration.
    GetUserPoolMfaConfigResponse -> Maybe SmsMfaConfigType
smsMfaConfiguration :: Prelude.Maybe SmsMfaConfigType,
    -- | The software token multi-factor authentication (MFA) configuration.
    GetUserPoolMfaConfigResponse -> Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration :: Prelude.Maybe SoftwareTokenMfaConfigType,
    -- | The response's http status code.
    GetUserPoolMfaConfigResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetUserPoolMfaConfigResponse
-> GetUserPoolMfaConfigResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUserPoolMfaConfigResponse
-> GetUserPoolMfaConfigResponse -> Bool
$c/= :: GetUserPoolMfaConfigResponse
-> GetUserPoolMfaConfigResponse -> Bool
== :: GetUserPoolMfaConfigResponse
-> GetUserPoolMfaConfigResponse -> Bool
$c== :: GetUserPoolMfaConfigResponse
-> GetUserPoolMfaConfigResponse -> Bool
Prelude.Eq, ReadPrec [GetUserPoolMfaConfigResponse]
ReadPrec GetUserPoolMfaConfigResponse
Int -> ReadS GetUserPoolMfaConfigResponse
ReadS [GetUserPoolMfaConfigResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetUserPoolMfaConfigResponse]
$creadListPrec :: ReadPrec [GetUserPoolMfaConfigResponse]
readPrec :: ReadPrec GetUserPoolMfaConfigResponse
$creadPrec :: ReadPrec GetUserPoolMfaConfigResponse
readList :: ReadS [GetUserPoolMfaConfigResponse]
$creadList :: ReadS [GetUserPoolMfaConfigResponse]
readsPrec :: Int -> ReadS GetUserPoolMfaConfigResponse
$creadsPrec :: Int -> ReadS GetUserPoolMfaConfigResponse
Prelude.Read, Int -> GetUserPoolMfaConfigResponse -> ShowS
[GetUserPoolMfaConfigResponse] -> ShowS
GetUserPoolMfaConfigResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUserPoolMfaConfigResponse] -> ShowS
$cshowList :: [GetUserPoolMfaConfigResponse] -> ShowS
show :: GetUserPoolMfaConfigResponse -> String
$cshow :: GetUserPoolMfaConfigResponse -> String
showsPrec :: Int -> GetUserPoolMfaConfigResponse -> ShowS
$cshowsPrec :: Int -> GetUserPoolMfaConfigResponse -> ShowS
Prelude.Show, forall x.
Rep GetUserPoolMfaConfigResponse x -> GetUserPoolMfaConfigResponse
forall x.
GetUserPoolMfaConfigResponse -> Rep GetUserPoolMfaConfigResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetUserPoolMfaConfigResponse x -> GetUserPoolMfaConfigResponse
$cfrom :: forall x.
GetUserPoolMfaConfigResponse -> Rep GetUserPoolMfaConfigResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetUserPoolMfaConfigResponse' 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', 'getUserPoolMfaConfigResponse_mfaConfiguration' - The multi-factor authentication (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 activated.
--
-- 'smsMfaConfiguration', 'getUserPoolMfaConfigResponse_smsMfaConfiguration' - The SMS text message multi-factor authentication (MFA) configuration.
--
-- 'softwareTokenMfaConfiguration', 'getUserPoolMfaConfigResponse_softwareTokenMfaConfiguration' - The software token multi-factor authentication (MFA) configuration.
--
-- 'httpStatus', 'getUserPoolMfaConfigResponse_httpStatus' - The response's http status code.
newGetUserPoolMfaConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetUserPoolMfaConfigResponse
newGetUserPoolMfaConfigResponse :: Int -> GetUserPoolMfaConfigResponse
newGetUserPoolMfaConfigResponse Int
pHttpStatus_ =
  GetUserPoolMfaConfigResponse'
    { $sel:mfaConfiguration:GetUserPoolMfaConfigResponse' :: Maybe UserPoolMfaType
mfaConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:smsMfaConfiguration:GetUserPoolMfaConfigResponse' :: Maybe SmsMfaConfigType
smsMfaConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:softwareTokenMfaConfiguration:GetUserPoolMfaConfigResponse' :: Maybe SoftwareTokenMfaConfigType
softwareTokenMfaConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetUserPoolMfaConfigResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The multi-factor authentication (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 activated.
getUserPoolMfaConfigResponse_mfaConfiguration :: Lens.Lens' GetUserPoolMfaConfigResponse (Prelude.Maybe UserPoolMfaType)
getUserPoolMfaConfigResponse_mfaConfiguration :: Lens' GetUserPoolMfaConfigResponse (Maybe UserPoolMfaType)
getUserPoolMfaConfigResponse_mfaConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserPoolMfaConfigResponse' {Maybe UserPoolMfaType
mfaConfiguration :: Maybe UserPoolMfaType
$sel:mfaConfiguration:GetUserPoolMfaConfigResponse' :: GetUserPoolMfaConfigResponse -> Maybe UserPoolMfaType
mfaConfiguration} -> Maybe UserPoolMfaType
mfaConfiguration) (\s :: GetUserPoolMfaConfigResponse
s@GetUserPoolMfaConfigResponse' {} Maybe UserPoolMfaType
a -> GetUserPoolMfaConfigResponse
s {$sel:mfaConfiguration:GetUserPoolMfaConfigResponse' :: Maybe UserPoolMfaType
mfaConfiguration = Maybe UserPoolMfaType
a} :: GetUserPoolMfaConfigResponse)

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

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

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

instance Prelude.NFData GetUserPoolMfaConfigResponse where
  rnf :: GetUserPoolMfaConfigResponse -> ()
rnf GetUserPoolMfaConfigResponse' {Int
Maybe SmsMfaConfigType
Maybe SoftwareTokenMfaConfigType
Maybe UserPoolMfaType
httpStatus :: Int
softwareTokenMfaConfiguration :: Maybe SoftwareTokenMfaConfigType
smsMfaConfiguration :: Maybe SmsMfaConfigType
mfaConfiguration :: Maybe UserPoolMfaType
$sel:httpStatus:GetUserPoolMfaConfigResponse' :: GetUserPoolMfaConfigResponse -> Int
$sel:softwareTokenMfaConfiguration:GetUserPoolMfaConfigResponse' :: GetUserPoolMfaConfigResponse -> Maybe SoftwareTokenMfaConfigType
$sel:smsMfaConfiguration:GetUserPoolMfaConfigResponse' :: GetUserPoolMfaConfigResponse -> Maybe SmsMfaConfigType
$sel:mfaConfiguration:GetUserPoolMfaConfigResponse' :: GetUserPoolMfaConfigResponse -> 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