{-# 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.SetRiskConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Configures actions on detected risks. To delete the risk configuration
-- for @UserPoolId@ or @ClientId@, pass null values for all four
-- configuration types.
--
-- To activate Amazon Cognito advanced security features, update the user
-- pool to include the @UserPoolAddOns@ key@AdvancedSecurityMode@.
module Amazonka.CognitoIdentityProvider.SetRiskConfiguration
  ( -- * Creating a Request
    SetRiskConfiguration (..),
    newSetRiskConfiguration,

    -- * Request Lenses
    setRiskConfiguration_accountTakeoverRiskConfiguration,
    setRiskConfiguration_clientId,
    setRiskConfiguration_compromisedCredentialsRiskConfiguration,
    setRiskConfiguration_riskExceptionConfiguration,
    setRiskConfiguration_userPoolId,

    -- * Destructuring the Response
    SetRiskConfigurationResponse (..),
    newSetRiskConfigurationResponse,

    -- * Response Lenses
    setRiskConfigurationResponse_httpStatus,
    setRiskConfigurationResponse_riskConfiguration,
  )
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:/ 'newSetRiskConfiguration' smart constructor.
data SetRiskConfiguration = SetRiskConfiguration'
  { -- | The account takeover risk configuration.
    SetRiskConfiguration -> Maybe AccountTakeoverRiskConfigurationType
accountTakeoverRiskConfiguration :: Prelude.Maybe AccountTakeoverRiskConfigurationType,
    -- | The app client ID. If @ClientId@ is null, then the risk configuration is
    -- mapped to @userPoolId@. When the client ID is null, the same risk
    -- configuration is applied to all the clients in the userPool.
    --
    -- Otherwise, @ClientId@ is mapped to the client. When the client ID isn\'t
    -- null, the user pool configuration is overridden and the risk
    -- configuration for the client is used instead.
    SetRiskConfiguration -> Maybe (Sensitive Text)
clientId :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The compromised credentials risk configuration.
    SetRiskConfiguration
-> Maybe CompromisedCredentialsRiskConfigurationType
compromisedCredentialsRiskConfiguration :: Prelude.Maybe CompromisedCredentialsRiskConfigurationType,
    -- | The configuration to override the risk decision.
    SetRiskConfiguration -> Maybe RiskExceptionConfigurationType
riskExceptionConfiguration :: Prelude.Maybe RiskExceptionConfigurationType,
    -- | The user pool ID.
    SetRiskConfiguration -> Text
userPoolId :: Prelude.Text
  }
  deriving (SetRiskConfiguration -> SetRiskConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetRiskConfiguration -> SetRiskConfiguration -> Bool
$c/= :: SetRiskConfiguration -> SetRiskConfiguration -> Bool
== :: SetRiskConfiguration -> SetRiskConfiguration -> Bool
$c== :: SetRiskConfiguration -> SetRiskConfiguration -> Bool
Prelude.Eq, Int -> SetRiskConfiguration -> ShowS
[SetRiskConfiguration] -> ShowS
SetRiskConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetRiskConfiguration] -> ShowS
$cshowList :: [SetRiskConfiguration] -> ShowS
show :: SetRiskConfiguration -> String
$cshow :: SetRiskConfiguration -> String
showsPrec :: Int -> SetRiskConfiguration -> ShowS
$cshowsPrec :: Int -> SetRiskConfiguration -> ShowS
Prelude.Show, forall x. Rep SetRiskConfiguration x -> SetRiskConfiguration
forall x. SetRiskConfiguration -> Rep SetRiskConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SetRiskConfiguration x -> SetRiskConfiguration
$cfrom :: forall x. SetRiskConfiguration -> Rep SetRiskConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'SetRiskConfiguration' 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:
--
-- 'accountTakeoverRiskConfiguration', 'setRiskConfiguration_accountTakeoverRiskConfiguration' - The account takeover risk configuration.
--
-- 'clientId', 'setRiskConfiguration_clientId' - The app client ID. If @ClientId@ is null, then the risk configuration is
-- mapped to @userPoolId@. When the client ID is null, the same risk
-- configuration is applied to all the clients in the userPool.
--
-- Otherwise, @ClientId@ is mapped to the client. When the client ID isn\'t
-- null, the user pool configuration is overridden and the risk
-- configuration for the client is used instead.
--
-- 'compromisedCredentialsRiskConfiguration', 'setRiskConfiguration_compromisedCredentialsRiskConfiguration' - The compromised credentials risk configuration.
--
-- 'riskExceptionConfiguration', 'setRiskConfiguration_riskExceptionConfiguration' - The configuration to override the risk decision.
--
-- 'userPoolId', 'setRiskConfiguration_userPoolId' - The user pool ID.
newSetRiskConfiguration ::
  -- | 'userPoolId'
  Prelude.Text ->
  SetRiskConfiguration
newSetRiskConfiguration :: Text -> SetRiskConfiguration
newSetRiskConfiguration Text
pUserPoolId_ =
  SetRiskConfiguration'
    { $sel:accountTakeoverRiskConfiguration:SetRiskConfiguration' :: Maybe AccountTakeoverRiskConfigurationType
accountTakeoverRiskConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clientId:SetRiskConfiguration' :: Maybe (Sensitive Text)
clientId = forall a. Maybe a
Prelude.Nothing,
      $sel:compromisedCredentialsRiskConfiguration:SetRiskConfiguration' :: Maybe CompromisedCredentialsRiskConfigurationType
compromisedCredentialsRiskConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:riskExceptionConfiguration:SetRiskConfiguration' :: Maybe RiskExceptionConfigurationType
riskExceptionConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:userPoolId:SetRiskConfiguration' :: Text
userPoolId = Text
pUserPoolId_
    }

-- | The account takeover risk configuration.
setRiskConfiguration_accountTakeoverRiskConfiguration :: Lens.Lens' SetRiskConfiguration (Prelude.Maybe AccountTakeoverRiskConfigurationType)
setRiskConfiguration_accountTakeoverRiskConfiguration :: Lens'
  SetRiskConfiguration (Maybe AccountTakeoverRiskConfigurationType)
setRiskConfiguration_accountTakeoverRiskConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetRiskConfiguration' {Maybe AccountTakeoverRiskConfigurationType
accountTakeoverRiskConfiguration :: Maybe AccountTakeoverRiskConfigurationType
$sel:accountTakeoverRiskConfiguration:SetRiskConfiguration' :: SetRiskConfiguration -> Maybe AccountTakeoverRiskConfigurationType
accountTakeoverRiskConfiguration} -> Maybe AccountTakeoverRiskConfigurationType
accountTakeoverRiskConfiguration) (\s :: SetRiskConfiguration
s@SetRiskConfiguration' {} Maybe AccountTakeoverRiskConfigurationType
a -> SetRiskConfiguration
s {$sel:accountTakeoverRiskConfiguration:SetRiskConfiguration' :: Maybe AccountTakeoverRiskConfigurationType
accountTakeoverRiskConfiguration = Maybe AccountTakeoverRiskConfigurationType
a} :: SetRiskConfiguration)

-- | The app client ID. If @ClientId@ is null, then the risk configuration is
-- mapped to @userPoolId@. When the client ID is null, the same risk
-- configuration is applied to all the clients in the userPool.
--
-- Otherwise, @ClientId@ is mapped to the client. When the client ID isn\'t
-- null, the user pool configuration is overridden and the risk
-- configuration for the client is used instead.
setRiskConfiguration_clientId :: Lens.Lens' SetRiskConfiguration (Prelude.Maybe Prelude.Text)
setRiskConfiguration_clientId :: Lens' SetRiskConfiguration (Maybe Text)
setRiskConfiguration_clientId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetRiskConfiguration' {Maybe (Sensitive Text)
clientId :: Maybe (Sensitive Text)
$sel:clientId:SetRiskConfiguration' :: SetRiskConfiguration -> Maybe (Sensitive Text)
clientId} -> Maybe (Sensitive Text)
clientId) (\s :: SetRiskConfiguration
s@SetRiskConfiguration' {} Maybe (Sensitive Text)
a -> SetRiskConfiguration
s {$sel:clientId:SetRiskConfiguration' :: Maybe (Sensitive Text)
clientId = Maybe (Sensitive Text)
a} :: SetRiskConfiguration) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The compromised credentials risk configuration.
setRiskConfiguration_compromisedCredentialsRiskConfiguration :: Lens.Lens' SetRiskConfiguration (Prelude.Maybe CompromisedCredentialsRiskConfigurationType)
setRiskConfiguration_compromisedCredentialsRiskConfiguration :: Lens'
  SetRiskConfiguration
  (Maybe CompromisedCredentialsRiskConfigurationType)
setRiskConfiguration_compromisedCredentialsRiskConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetRiskConfiguration' {Maybe CompromisedCredentialsRiskConfigurationType
compromisedCredentialsRiskConfiguration :: Maybe CompromisedCredentialsRiskConfigurationType
$sel:compromisedCredentialsRiskConfiguration:SetRiskConfiguration' :: SetRiskConfiguration
-> Maybe CompromisedCredentialsRiskConfigurationType
compromisedCredentialsRiskConfiguration} -> Maybe CompromisedCredentialsRiskConfigurationType
compromisedCredentialsRiskConfiguration) (\s :: SetRiskConfiguration
s@SetRiskConfiguration' {} Maybe CompromisedCredentialsRiskConfigurationType
a -> SetRiskConfiguration
s {$sel:compromisedCredentialsRiskConfiguration:SetRiskConfiguration' :: Maybe CompromisedCredentialsRiskConfigurationType
compromisedCredentialsRiskConfiguration = Maybe CompromisedCredentialsRiskConfigurationType
a} :: SetRiskConfiguration)

-- | The configuration to override the risk decision.
setRiskConfiguration_riskExceptionConfiguration :: Lens.Lens' SetRiskConfiguration (Prelude.Maybe RiskExceptionConfigurationType)
setRiskConfiguration_riskExceptionConfiguration :: Lens' SetRiskConfiguration (Maybe RiskExceptionConfigurationType)
setRiskConfiguration_riskExceptionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetRiskConfiguration' {Maybe RiskExceptionConfigurationType
riskExceptionConfiguration :: Maybe RiskExceptionConfigurationType
$sel:riskExceptionConfiguration:SetRiskConfiguration' :: SetRiskConfiguration -> Maybe RiskExceptionConfigurationType
riskExceptionConfiguration} -> Maybe RiskExceptionConfigurationType
riskExceptionConfiguration) (\s :: SetRiskConfiguration
s@SetRiskConfiguration' {} Maybe RiskExceptionConfigurationType
a -> SetRiskConfiguration
s {$sel:riskExceptionConfiguration:SetRiskConfiguration' :: Maybe RiskExceptionConfigurationType
riskExceptionConfiguration = Maybe RiskExceptionConfigurationType
a} :: SetRiskConfiguration)

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

instance Core.AWSRequest SetRiskConfiguration where
  type
    AWSResponse SetRiskConfiguration =
      SetRiskConfigurationResponse
  request :: (Service -> Service)
-> SetRiskConfiguration -> Request SetRiskConfiguration
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 SetRiskConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SetRiskConfiguration)))
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 ->
          Int -> RiskConfigurationType -> SetRiskConfigurationResponse
SetRiskConfigurationResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"RiskConfiguration")
      )

instance Prelude.Hashable SetRiskConfiguration where
  hashWithSalt :: Int -> SetRiskConfiguration -> Int
hashWithSalt Int
_salt SetRiskConfiguration' {Maybe (Sensitive Text)
Maybe CompromisedCredentialsRiskConfigurationType
Maybe AccountTakeoverRiskConfigurationType
Maybe RiskExceptionConfigurationType
Text
userPoolId :: Text
riskExceptionConfiguration :: Maybe RiskExceptionConfigurationType
compromisedCredentialsRiskConfiguration :: Maybe CompromisedCredentialsRiskConfigurationType
clientId :: Maybe (Sensitive Text)
accountTakeoverRiskConfiguration :: Maybe AccountTakeoverRiskConfigurationType
$sel:userPoolId:SetRiskConfiguration' :: SetRiskConfiguration -> Text
$sel:riskExceptionConfiguration:SetRiskConfiguration' :: SetRiskConfiguration -> Maybe RiskExceptionConfigurationType
$sel:compromisedCredentialsRiskConfiguration:SetRiskConfiguration' :: SetRiskConfiguration
-> Maybe CompromisedCredentialsRiskConfigurationType
$sel:clientId:SetRiskConfiguration' :: SetRiskConfiguration -> Maybe (Sensitive Text)
$sel:accountTakeoverRiskConfiguration:SetRiskConfiguration' :: SetRiskConfiguration -> Maybe AccountTakeoverRiskConfigurationType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AccountTakeoverRiskConfigurationType
accountTakeoverRiskConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
clientId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CompromisedCredentialsRiskConfigurationType
compromisedCredentialsRiskConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RiskExceptionConfigurationType
riskExceptionConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userPoolId

instance Prelude.NFData SetRiskConfiguration where
  rnf :: SetRiskConfiguration -> ()
rnf SetRiskConfiguration' {Maybe (Sensitive Text)
Maybe CompromisedCredentialsRiskConfigurationType
Maybe AccountTakeoverRiskConfigurationType
Maybe RiskExceptionConfigurationType
Text
userPoolId :: Text
riskExceptionConfiguration :: Maybe RiskExceptionConfigurationType
compromisedCredentialsRiskConfiguration :: Maybe CompromisedCredentialsRiskConfigurationType
clientId :: Maybe (Sensitive Text)
accountTakeoverRiskConfiguration :: Maybe AccountTakeoverRiskConfigurationType
$sel:userPoolId:SetRiskConfiguration' :: SetRiskConfiguration -> Text
$sel:riskExceptionConfiguration:SetRiskConfiguration' :: SetRiskConfiguration -> Maybe RiskExceptionConfigurationType
$sel:compromisedCredentialsRiskConfiguration:SetRiskConfiguration' :: SetRiskConfiguration
-> Maybe CompromisedCredentialsRiskConfigurationType
$sel:clientId:SetRiskConfiguration' :: SetRiskConfiguration -> Maybe (Sensitive Text)
$sel:accountTakeoverRiskConfiguration:SetRiskConfiguration' :: SetRiskConfiguration -> Maybe AccountTakeoverRiskConfigurationType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AccountTakeoverRiskConfigurationType
accountTakeoverRiskConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
clientId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CompromisedCredentialsRiskConfigurationType
compromisedCredentialsRiskConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RiskExceptionConfigurationType
riskExceptionConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userPoolId

instance Data.ToHeaders SetRiskConfiguration where
  toHeaders :: SetRiskConfiguration -> 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.SetRiskConfiguration" ::
                          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 SetRiskConfiguration where
  toJSON :: SetRiskConfiguration -> Value
toJSON SetRiskConfiguration' {Maybe (Sensitive Text)
Maybe CompromisedCredentialsRiskConfigurationType
Maybe AccountTakeoverRiskConfigurationType
Maybe RiskExceptionConfigurationType
Text
userPoolId :: Text
riskExceptionConfiguration :: Maybe RiskExceptionConfigurationType
compromisedCredentialsRiskConfiguration :: Maybe CompromisedCredentialsRiskConfigurationType
clientId :: Maybe (Sensitive Text)
accountTakeoverRiskConfiguration :: Maybe AccountTakeoverRiskConfigurationType
$sel:userPoolId:SetRiskConfiguration' :: SetRiskConfiguration -> Text
$sel:riskExceptionConfiguration:SetRiskConfiguration' :: SetRiskConfiguration -> Maybe RiskExceptionConfigurationType
$sel:compromisedCredentialsRiskConfiguration:SetRiskConfiguration' :: SetRiskConfiguration
-> Maybe CompromisedCredentialsRiskConfigurationType
$sel:clientId:SetRiskConfiguration' :: SetRiskConfiguration -> Maybe (Sensitive Text)
$sel:accountTakeoverRiskConfiguration:SetRiskConfiguration' :: SetRiskConfiguration -> Maybe AccountTakeoverRiskConfigurationType
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccountTakeoverRiskConfiguration" 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 AccountTakeoverRiskConfigurationType
accountTakeoverRiskConfiguration,
            (Key
"ClientId" 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 (Sensitive Text)
clientId,
            (Key
"CompromisedCredentialsRiskConfiguration" 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 CompromisedCredentialsRiskConfigurationType
compromisedCredentialsRiskConfiguration,
            (Key
"RiskExceptionConfiguration" 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 RiskExceptionConfigurationType
riskExceptionConfiguration,
            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 SetRiskConfiguration where
  toPath :: SetRiskConfiguration -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newSetRiskConfigurationResponse' smart constructor.
data SetRiskConfigurationResponse = SetRiskConfigurationResponse'
  { -- | The response's http status code.
    SetRiskConfigurationResponse -> Int
httpStatus :: Prelude.Int,
    -- | The risk configuration.
    SetRiskConfigurationResponse -> RiskConfigurationType
riskConfiguration :: RiskConfigurationType
  }
  deriving (SetRiskConfigurationResponse
-> SetRiskConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetRiskConfigurationResponse
-> SetRiskConfigurationResponse -> Bool
$c/= :: SetRiskConfigurationResponse
-> SetRiskConfigurationResponse -> Bool
== :: SetRiskConfigurationResponse
-> SetRiskConfigurationResponse -> Bool
$c== :: SetRiskConfigurationResponse
-> SetRiskConfigurationResponse -> Bool
Prelude.Eq, Int -> SetRiskConfigurationResponse -> ShowS
[SetRiskConfigurationResponse] -> ShowS
SetRiskConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetRiskConfigurationResponse] -> ShowS
$cshowList :: [SetRiskConfigurationResponse] -> ShowS
show :: SetRiskConfigurationResponse -> String
$cshow :: SetRiskConfigurationResponse -> String
showsPrec :: Int -> SetRiskConfigurationResponse -> ShowS
$cshowsPrec :: Int -> SetRiskConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep SetRiskConfigurationResponse x -> SetRiskConfigurationResponse
forall x.
SetRiskConfigurationResponse -> Rep SetRiskConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SetRiskConfigurationResponse x -> SetRiskConfigurationResponse
$cfrom :: forall x.
SetRiskConfigurationResponse -> Rep SetRiskConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'SetRiskConfigurationResponse' 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:
--
-- 'httpStatus', 'setRiskConfigurationResponse_httpStatus' - The response's http status code.
--
-- 'riskConfiguration', 'setRiskConfigurationResponse_riskConfiguration' - The risk configuration.
newSetRiskConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'riskConfiguration'
  RiskConfigurationType ->
  SetRiskConfigurationResponse
newSetRiskConfigurationResponse :: Int -> RiskConfigurationType -> SetRiskConfigurationResponse
newSetRiskConfigurationResponse
  Int
pHttpStatus_
  RiskConfigurationType
pRiskConfiguration_ =
    SetRiskConfigurationResponse'
      { $sel:httpStatus:SetRiskConfigurationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:riskConfiguration:SetRiskConfigurationResponse' :: RiskConfigurationType
riskConfiguration = RiskConfigurationType
pRiskConfiguration_
      }

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

-- | The risk configuration.
setRiskConfigurationResponse_riskConfiguration :: Lens.Lens' SetRiskConfigurationResponse RiskConfigurationType
setRiskConfigurationResponse_riskConfiguration :: Lens' SetRiskConfigurationResponse RiskConfigurationType
setRiskConfigurationResponse_riskConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetRiskConfigurationResponse' {RiskConfigurationType
riskConfiguration :: RiskConfigurationType
$sel:riskConfiguration:SetRiskConfigurationResponse' :: SetRiskConfigurationResponse -> RiskConfigurationType
riskConfiguration} -> RiskConfigurationType
riskConfiguration) (\s :: SetRiskConfigurationResponse
s@SetRiskConfigurationResponse' {} RiskConfigurationType
a -> SetRiskConfigurationResponse
s {$sel:riskConfiguration:SetRiskConfigurationResponse' :: RiskConfigurationType
riskConfiguration = RiskConfigurationType
a} :: SetRiskConfigurationResponse)

instance Prelude.NFData SetRiskConfigurationResponse where
  rnf :: SetRiskConfigurationResponse -> ()
rnf SetRiskConfigurationResponse' {Int
RiskConfigurationType
riskConfiguration :: RiskConfigurationType
httpStatus :: Int
$sel:riskConfiguration:SetRiskConfigurationResponse' :: SetRiskConfigurationResponse -> RiskConfigurationType
$sel:httpStatus:SetRiskConfigurationResponse' :: SetRiskConfigurationResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RiskConfigurationType
riskConfiguration