{-# 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.UpdateUserPoolClient
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the specified user pool app client with the specified
-- attributes. You can get a list of the current user pool app client
-- settings using
-- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_DescribeUserPoolClient.html DescribeUserPoolClient>.
--
-- If you don\'t provide a value for an attribute, it will be set to the
-- default value.
--
-- You can also use this operation to enable token revocation for user pool
-- clients. For more information about revoking tokens, see
-- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_RevokeToken.html RevokeToken>.
module Amazonka.CognitoIdentityProvider.UpdateUserPoolClient
  ( -- * Creating a Request
    UpdateUserPoolClient (..),
    newUpdateUserPoolClient,

    -- * Request Lenses
    updateUserPoolClient_accessTokenValidity,
    updateUserPoolClient_allowedOAuthFlows,
    updateUserPoolClient_allowedOAuthFlowsUserPoolClient,
    updateUserPoolClient_allowedOAuthScopes,
    updateUserPoolClient_analyticsConfiguration,
    updateUserPoolClient_authSessionValidity,
    updateUserPoolClient_callbackURLs,
    updateUserPoolClient_clientName,
    updateUserPoolClient_defaultRedirectURI,
    updateUserPoolClient_enablePropagateAdditionalUserContextData,
    updateUserPoolClient_enableTokenRevocation,
    updateUserPoolClient_explicitAuthFlows,
    updateUserPoolClient_idTokenValidity,
    updateUserPoolClient_logoutURLs,
    updateUserPoolClient_preventUserExistenceErrors,
    updateUserPoolClient_readAttributes,
    updateUserPoolClient_refreshTokenValidity,
    updateUserPoolClient_supportedIdentityProviders,
    updateUserPoolClient_tokenValidityUnits,
    updateUserPoolClient_writeAttributes,
    updateUserPoolClient_userPoolId,
    updateUserPoolClient_clientId,

    -- * Destructuring the Response
    UpdateUserPoolClientResponse (..),
    newUpdateUserPoolClientResponse,

    -- * Response Lenses
    updateUserPoolClientResponse_userPoolClient,
    updateUserPoolClientResponse_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

-- | Represents the request to update the user pool client.
--
-- /See:/ 'newUpdateUserPoolClient' smart constructor.
data UpdateUserPoolClient = UpdateUserPoolClient'
  { -- | The access token time limit. After this limit expires, your user can\'t
    -- use their access token. To specify the time unit for
    -- @AccessTokenValidity@ as @seconds@, @minutes@, @hours@, or @days@, set a
    -- @TokenValidityUnits@ value in your API request.
    --
    -- For example, when you set @AccessTokenValidity@ to @10@ and
    -- @TokenValidityUnits@ to @hours@, your user can authorize access with
    -- their access token for 10 hours.
    --
    -- The default time unit for @AccessTokenValidity@ in an API request is
    -- hours. /Valid range/ is displayed below in seconds.
    --
    -- If you don\'t specify otherwise in the configuration of your app client,
    -- your access tokens are valid for one hour.
    UpdateUserPoolClient -> Maybe Natural
accessTokenValidity :: Prelude.Maybe Prelude.Natural,
    -- | The allowed OAuth flows.
    --
    -- [code]
    --     Use a code grant flow, which provides an authorization code as the
    --     response. This code can be exchanged for access tokens with the
    --     @\/oauth2\/token@ endpoint.
    --
    -- [implicit]
    --     Issue the access token (and, optionally, ID token, based on scopes)
    --     directly to your user.
    --
    -- [client_credentials]
    --     Issue the access token from the @\/oauth2\/token@ endpoint directly
    --     to a non-person user using a combination of the client ID and client
    --     secret.
    UpdateUserPoolClient -> Maybe [OAuthFlowType]
allowedOAuthFlows :: Prelude.Maybe [OAuthFlowType],
    -- | Set to true if the client is allowed to follow the OAuth protocol when
    -- interacting with Amazon Cognito user pools.
    UpdateUserPoolClient -> Maybe Bool
allowedOAuthFlowsUserPoolClient :: Prelude.Maybe Prelude.Bool,
    -- | The allowed OAuth scopes. Possible values provided by OAuth are @phone@,
    -- @email@, @openid@, and @profile@. Possible values provided by Amazon Web
    -- Services are @aws.cognito.signin.user.admin@. Custom scopes created in
    -- Resource Servers are also supported.
    UpdateUserPoolClient -> Maybe [Text]
allowedOAuthScopes :: Prelude.Maybe [Prelude.Text],
    -- | The Amazon Pinpoint analytics configuration necessary to collect metrics
    -- for this user pool.
    --
    -- In Amazon Web Services Regions where Amazon Pinpoint isn\'t available,
    -- user pools only support sending events to Amazon Pinpoint projects in
    -- us-east-1. In Regions where Amazon Pinpoint is available, user pools
    -- support sending events to Amazon Pinpoint projects within that same
    -- Region.
    UpdateUserPoolClient -> Maybe AnalyticsConfigurationType
analyticsConfiguration :: Prelude.Maybe AnalyticsConfigurationType,
    -- | Amazon Cognito creates a session token for each API request in an
    -- authentication flow. @AuthSessionValidity@ is the duration, in minutes,
    -- of that session token. Your user pool native user must respond to each
    -- authentication challenge before the session expires.
    UpdateUserPoolClient -> Maybe Natural
authSessionValidity :: Prelude.Maybe Prelude.Natural,
    -- | A list of allowed redirect (callback) URLs for the IdPs.
    --
    -- A redirect URI must:
    --
    -- -   Be an absolute URI.
    --
    -- -   Be registered with the authorization server.
    --
    -- -   Not include a fragment component.
    --
    -- See
    -- <https://tools.ietf.org/html/rfc6749#section-3.1.2 OAuth 2.0 - Redirection Endpoint>.
    --
    -- Amazon Cognito requires HTTPS over HTTP except for http:\/\/localhost
    -- for testing purposes only.
    --
    -- App callback URLs such as @myapp:\/\/example@ are also supported.
    UpdateUserPoolClient -> Maybe [Text]
callbackURLs :: Prelude.Maybe [Prelude.Text],
    -- | The client name from the update user pool client request.
    UpdateUserPoolClient -> Maybe Text
clientName :: Prelude.Maybe Prelude.Text,
    -- | The default redirect URI. Must be in the @CallbackURLs@ list.
    --
    -- A redirect URI must:
    --
    -- -   Be an absolute URI.
    --
    -- -   Be registered with the authorization server.
    --
    -- -   Not include a fragment component.
    --
    -- See
    -- <https://tools.ietf.org/html/rfc6749#section-3.1.2 OAuth 2.0 - Redirection Endpoint>.
    --
    -- Amazon Cognito requires HTTPS over HTTP except for @http:\/\/localhost@
    -- for testing purposes only.
    --
    -- App callback URLs such as @myapp:\/\/example@ are also supported.
    UpdateUserPoolClient -> Maybe Text
defaultRedirectURI :: Prelude.Maybe Prelude.Text,
    -- | Activates the propagation of additional user context data. For more
    -- information about propagation of user context data, see
    -- <https://docs.aws.amazon.com/cognito/latest/developerguide/cognito-user-pool-settings-advanced-security.html Adding advanced security to a user pool>.
    -- If you don’t include this parameter, you can\'t send device fingerprint
    -- information, including source IP address, to Amazon Cognito advanced
    -- security. You can only activate
    -- @EnablePropagateAdditionalUserContextData@ in an app client that has a
    -- client secret.
    UpdateUserPoolClient -> Maybe Bool
enablePropagateAdditionalUserContextData :: Prelude.Maybe Prelude.Bool,
    -- | Activates or deactivates token revocation. For more information about
    -- revoking tokens, see
    -- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_RevokeToken.html RevokeToken>.
    UpdateUserPoolClient -> Maybe Bool
enableTokenRevocation :: Prelude.Maybe Prelude.Bool,
    -- | The authentication flows that you want your user pool client to support.
    -- For each app client in your user pool, you can sign in your users with
    -- any combination of one or more flows, including with a user name and
    -- Secure Remote Password (SRP), a user name and password, or a custom
    -- authentication process that you define with Lambda functions.
    --
    -- If you don\'t specify a value for @ExplicitAuthFlows@, your user client
    -- supports @ALLOW_REFRESH_TOKEN_AUTH@, @ALLOW_USER_SRP_AUTH@, and
    -- @ALLOW_CUSTOM_AUTH@.
    --
    -- Valid values include:
    --
    -- -   @ALLOW_ADMIN_USER_PASSWORD_AUTH@: Enable admin based user password
    --     authentication flow @ADMIN_USER_PASSWORD_AUTH@. This setting
    --     replaces the @ADMIN_NO_SRP_AUTH@ setting. With this authentication
    --     flow, your app passes a user name and password to Amazon Cognito in
    --     the request, instead of using the Secure Remote Password (SRP)
    --     protocol to securely transmit the password.
    --
    -- -   @ALLOW_CUSTOM_AUTH@: Enable Lambda trigger based authentication.
    --
    -- -   @ALLOW_USER_PASSWORD_AUTH@: Enable user password-based
    --     authentication. In this flow, Amazon Cognito receives the password
    --     in the request instead of using the SRP protocol to verify
    --     passwords.
    --
    -- -   @ALLOW_USER_SRP_AUTH@: Enable SRP-based authentication.
    --
    -- -   @ALLOW_REFRESH_TOKEN_AUTH@: Enable authflow to refresh tokens.
    --
    -- In some environments, you will see the values @ADMIN_NO_SRP_AUTH@,
    -- @CUSTOM_AUTH_FLOW_ONLY@, or @USER_PASSWORD_AUTH@. You can\'t assign
    -- these legacy @ExplicitAuthFlows@ values to user pool clients at the same
    -- time as values that begin with @ALLOW_@, like @ALLOW_USER_SRP_AUTH@.
    UpdateUserPoolClient -> Maybe [ExplicitAuthFlowsType]
explicitAuthFlows :: Prelude.Maybe [ExplicitAuthFlowsType],
    -- | The ID token time limit. After this limit expires, your user can\'t use
    -- their ID token. To specify the time unit for @IdTokenValidity@ as
    -- @seconds@, @minutes@, @hours@, or @days@, set a @TokenValidityUnits@
    -- value in your API request.
    --
    -- For example, when you set @IdTokenValidity@ as @10@ and
    -- @TokenValidityUnits@ as @hours@, your user can authenticate their
    -- session with their ID token for 10 hours.
    --
    -- The default time unit for @AccessTokenValidity@ in an API request is
    -- hours. /Valid range/ is displayed below in seconds.
    --
    -- If you don\'t specify otherwise in the configuration of your app client,
    -- your ID tokens are valid for one hour.
    UpdateUserPoolClient -> Maybe Natural
idTokenValidity :: Prelude.Maybe Prelude.Natural,
    -- | A list of allowed logout URLs for the IdPs.
    UpdateUserPoolClient -> Maybe [Text]
logoutURLs :: Prelude.Maybe [Prelude.Text],
    -- | Errors and responses that you want Amazon Cognito APIs to return during
    -- authentication, account confirmation, and password recovery when the
    -- user doesn\'t exist in the user pool. When set to @ENABLED@ and the user
    -- doesn\'t exist, authentication returns an error indicating either the
    -- username or password was incorrect. Account confirmation and password
    -- recovery return a response indicating a code was sent to a simulated
    -- destination. When set to @LEGACY@, those APIs return a
    -- @UserNotFoundException@ exception if the user doesn\'t exist in the user
    -- pool.
    --
    -- Valid values include:
    --
    -- -   @ENABLED@ - This prevents user existence-related errors.
    --
    -- -   @LEGACY@ - This represents the early behavior of Amazon Cognito
    --     where user existence related errors aren\'t prevented.
    UpdateUserPoolClient -> Maybe PreventUserExistenceErrorTypes
preventUserExistenceErrors :: Prelude.Maybe PreventUserExistenceErrorTypes,
    -- | The read-only attributes of the user pool.
    UpdateUserPoolClient -> Maybe [Text]
readAttributes :: Prelude.Maybe [Prelude.Text],
    -- | The refresh token time limit. After this limit expires, your user can\'t
    -- use their refresh token. To specify the time unit for
    -- @RefreshTokenValidity@ as @seconds@, @minutes@, @hours@, or @days@, set
    -- a @TokenValidityUnits@ value in your API request.
    --
    -- For example, when you set @RefreshTokenValidity@ as @10@ and
    -- @TokenValidityUnits@ as @days@, your user can refresh their session and
    -- retrieve new access and ID tokens for 10 days.
    --
    -- The default time unit for @RefreshTokenValidity@ in an API request is
    -- days. You can\'t set @RefreshTokenValidity@ to 0. If you do, Amazon
    -- Cognito overrides the value with the default value of 30 days. /Valid
    -- range/ is displayed below in seconds.
    --
    -- If you don\'t specify otherwise in the configuration of your app client,
    -- your refresh tokens are valid for 30 days.
    UpdateUserPoolClient -> Maybe Natural
refreshTokenValidity :: Prelude.Maybe Prelude.Natural,
    -- | A list of provider names for the IdPs that this client supports. The
    -- following are supported: @COGNITO@, @Facebook@, @Google@,
    -- @SignInWithApple@, @LoginWithAmazon@, and the names of your own SAML and
    -- OIDC providers.
    UpdateUserPoolClient -> Maybe [Text]
supportedIdentityProviders :: Prelude.Maybe [Prelude.Text],
    -- | The units in which the validity times are represented. The default unit
    -- for RefreshToken is days, and the default for ID and access tokens is
    -- hours.
    UpdateUserPoolClient -> Maybe TokenValidityUnitsType
tokenValidityUnits :: Prelude.Maybe TokenValidityUnitsType,
    -- | The writeable attributes of the user pool.
    UpdateUserPoolClient -> Maybe [Text]
writeAttributes :: Prelude.Maybe [Prelude.Text],
    -- | The user pool ID for the user pool where you want to update the user
    -- pool client.
    UpdateUserPoolClient -> Text
userPoolId :: Prelude.Text,
    -- | The ID of the client associated with the user pool.
    UpdateUserPoolClient -> Sensitive Text
clientId :: Data.Sensitive Prelude.Text
  }
  deriving (UpdateUserPoolClient -> UpdateUserPoolClient -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateUserPoolClient -> UpdateUserPoolClient -> Bool
$c/= :: UpdateUserPoolClient -> UpdateUserPoolClient -> Bool
== :: UpdateUserPoolClient -> UpdateUserPoolClient -> Bool
$c== :: UpdateUserPoolClient -> UpdateUserPoolClient -> Bool
Prelude.Eq, Int -> UpdateUserPoolClient -> ShowS
[UpdateUserPoolClient] -> ShowS
UpdateUserPoolClient -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateUserPoolClient] -> ShowS
$cshowList :: [UpdateUserPoolClient] -> ShowS
show :: UpdateUserPoolClient -> String
$cshow :: UpdateUserPoolClient -> String
showsPrec :: Int -> UpdateUserPoolClient -> ShowS
$cshowsPrec :: Int -> UpdateUserPoolClient -> ShowS
Prelude.Show, forall x. Rep UpdateUserPoolClient x -> UpdateUserPoolClient
forall x. UpdateUserPoolClient -> Rep UpdateUserPoolClient x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateUserPoolClient x -> UpdateUserPoolClient
$cfrom :: forall x. UpdateUserPoolClient -> Rep UpdateUserPoolClient x
Prelude.Generic)

-- |
-- Create a value of 'UpdateUserPoolClient' 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:
--
-- 'accessTokenValidity', 'updateUserPoolClient_accessTokenValidity' - The access token time limit. After this limit expires, your user can\'t
-- use their access token. To specify the time unit for
-- @AccessTokenValidity@ as @seconds@, @minutes@, @hours@, or @days@, set a
-- @TokenValidityUnits@ value in your API request.
--
-- For example, when you set @AccessTokenValidity@ to @10@ and
-- @TokenValidityUnits@ to @hours@, your user can authorize access with
-- their access token for 10 hours.
--
-- The default time unit for @AccessTokenValidity@ in an API request is
-- hours. /Valid range/ is displayed below in seconds.
--
-- If you don\'t specify otherwise in the configuration of your app client,
-- your access tokens are valid for one hour.
--
-- 'allowedOAuthFlows', 'updateUserPoolClient_allowedOAuthFlows' - The allowed OAuth flows.
--
-- [code]
--     Use a code grant flow, which provides an authorization code as the
--     response. This code can be exchanged for access tokens with the
--     @\/oauth2\/token@ endpoint.
--
-- [implicit]
--     Issue the access token (and, optionally, ID token, based on scopes)
--     directly to your user.
--
-- [client_credentials]
--     Issue the access token from the @\/oauth2\/token@ endpoint directly
--     to a non-person user using a combination of the client ID and client
--     secret.
--
-- 'allowedOAuthFlowsUserPoolClient', 'updateUserPoolClient_allowedOAuthFlowsUserPoolClient' - Set to true if the client is allowed to follow the OAuth protocol when
-- interacting with Amazon Cognito user pools.
--
-- 'allowedOAuthScopes', 'updateUserPoolClient_allowedOAuthScopes' - The allowed OAuth scopes. Possible values provided by OAuth are @phone@,
-- @email@, @openid@, and @profile@. Possible values provided by Amazon Web
-- Services are @aws.cognito.signin.user.admin@. Custom scopes created in
-- Resource Servers are also supported.
--
-- 'analyticsConfiguration', 'updateUserPoolClient_analyticsConfiguration' - The Amazon Pinpoint analytics configuration necessary to collect metrics
-- for this user pool.
--
-- In Amazon Web Services Regions where Amazon Pinpoint isn\'t available,
-- user pools only support sending events to Amazon Pinpoint projects in
-- us-east-1. In Regions where Amazon Pinpoint is available, user pools
-- support sending events to Amazon Pinpoint projects within that same
-- Region.
--
-- 'authSessionValidity', 'updateUserPoolClient_authSessionValidity' - Amazon Cognito creates a session token for each API request in an
-- authentication flow. @AuthSessionValidity@ is the duration, in minutes,
-- of that session token. Your user pool native user must respond to each
-- authentication challenge before the session expires.
--
-- 'callbackURLs', 'updateUserPoolClient_callbackURLs' - A list of allowed redirect (callback) URLs for the IdPs.
--
-- A redirect URI must:
--
-- -   Be an absolute URI.
--
-- -   Be registered with the authorization server.
--
-- -   Not include a fragment component.
--
-- See
-- <https://tools.ietf.org/html/rfc6749#section-3.1.2 OAuth 2.0 - Redirection Endpoint>.
--
-- Amazon Cognito requires HTTPS over HTTP except for http:\/\/localhost
-- for testing purposes only.
--
-- App callback URLs such as @myapp:\/\/example@ are also supported.
--
-- 'clientName', 'updateUserPoolClient_clientName' - The client name from the update user pool client request.
--
-- 'defaultRedirectURI', 'updateUserPoolClient_defaultRedirectURI' - The default redirect URI. Must be in the @CallbackURLs@ list.
--
-- A redirect URI must:
--
-- -   Be an absolute URI.
--
-- -   Be registered with the authorization server.
--
-- -   Not include a fragment component.
--
-- See
-- <https://tools.ietf.org/html/rfc6749#section-3.1.2 OAuth 2.0 - Redirection Endpoint>.
--
-- Amazon Cognito requires HTTPS over HTTP except for @http:\/\/localhost@
-- for testing purposes only.
--
-- App callback URLs such as @myapp:\/\/example@ are also supported.
--
-- 'enablePropagateAdditionalUserContextData', 'updateUserPoolClient_enablePropagateAdditionalUserContextData' - Activates the propagation of additional user context data. For more
-- information about propagation of user context data, see
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/cognito-user-pool-settings-advanced-security.html Adding advanced security to a user pool>.
-- If you don’t include this parameter, you can\'t send device fingerprint
-- information, including source IP address, to Amazon Cognito advanced
-- security. You can only activate
-- @EnablePropagateAdditionalUserContextData@ in an app client that has a
-- client secret.
--
-- 'enableTokenRevocation', 'updateUserPoolClient_enableTokenRevocation' - Activates or deactivates token revocation. For more information about
-- revoking tokens, see
-- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_RevokeToken.html RevokeToken>.
--
-- 'explicitAuthFlows', 'updateUserPoolClient_explicitAuthFlows' - The authentication flows that you want your user pool client to support.
-- For each app client in your user pool, you can sign in your users with
-- any combination of one or more flows, including with a user name and
-- Secure Remote Password (SRP), a user name and password, or a custom
-- authentication process that you define with Lambda functions.
--
-- If you don\'t specify a value for @ExplicitAuthFlows@, your user client
-- supports @ALLOW_REFRESH_TOKEN_AUTH@, @ALLOW_USER_SRP_AUTH@, and
-- @ALLOW_CUSTOM_AUTH@.
--
-- Valid values include:
--
-- -   @ALLOW_ADMIN_USER_PASSWORD_AUTH@: Enable admin based user password
--     authentication flow @ADMIN_USER_PASSWORD_AUTH@. This setting
--     replaces the @ADMIN_NO_SRP_AUTH@ setting. With this authentication
--     flow, your app passes a user name and password to Amazon Cognito in
--     the request, instead of using the Secure Remote Password (SRP)
--     protocol to securely transmit the password.
--
-- -   @ALLOW_CUSTOM_AUTH@: Enable Lambda trigger based authentication.
--
-- -   @ALLOW_USER_PASSWORD_AUTH@: Enable user password-based
--     authentication. In this flow, Amazon Cognito receives the password
--     in the request instead of using the SRP protocol to verify
--     passwords.
--
-- -   @ALLOW_USER_SRP_AUTH@: Enable SRP-based authentication.
--
-- -   @ALLOW_REFRESH_TOKEN_AUTH@: Enable authflow to refresh tokens.
--
-- In some environments, you will see the values @ADMIN_NO_SRP_AUTH@,
-- @CUSTOM_AUTH_FLOW_ONLY@, or @USER_PASSWORD_AUTH@. You can\'t assign
-- these legacy @ExplicitAuthFlows@ values to user pool clients at the same
-- time as values that begin with @ALLOW_@, like @ALLOW_USER_SRP_AUTH@.
--
-- 'idTokenValidity', 'updateUserPoolClient_idTokenValidity' - The ID token time limit. After this limit expires, your user can\'t use
-- their ID token. To specify the time unit for @IdTokenValidity@ as
-- @seconds@, @minutes@, @hours@, or @days@, set a @TokenValidityUnits@
-- value in your API request.
--
-- For example, when you set @IdTokenValidity@ as @10@ and
-- @TokenValidityUnits@ as @hours@, your user can authenticate their
-- session with their ID token for 10 hours.
--
-- The default time unit for @AccessTokenValidity@ in an API request is
-- hours. /Valid range/ is displayed below in seconds.
--
-- If you don\'t specify otherwise in the configuration of your app client,
-- your ID tokens are valid for one hour.
--
-- 'logoutURLs', 'updateUserPoolClient_logoutURLs' - A list of allowed logout URLs for the IdPs.
--
-- 'preventUserExistenceErrors', 'updateUserPoolClient_preventUserExistenceErrors' - Errors and responses that you want Amazon Cognito APIs to return during
-- authentication, account confirmation, and password recovery when the
-- user doesn\'t exist in the user pool. When set to @ENABLED@ and the user
-- doesn\'t exist, authentication returns an error indicating either the
-- username or password was incorrect. Account confirmation and password
-- recovery return a response indicating a code was sent to a simulated
-- destination. When set to @LEGACY@, those APIs return a
-- @UserNotFoundException@ exception if the user doesn\'t exist in the user
-- pool.
--
-- Valid values include:
--
-- -   @ENABLED@ - This prevents user existence-related errors.
--
-- -   @LEGACY@ - This represents the early behavior of Amazon Cognito
--     where user existence related errors aren\'t prevented.
--
-- 'readAttributes', 'updateUserPoolClient_readAttributes' - The read-only attributes of the user pool.
--
-- 'refreshTokenValidity', 'updateUserPoolClient_refreshTokenValidity' - The refresh token time limit. After this limit expires, your user can\'t
-- use their refresh token. To specify the time unit for
-- @RefreshTokenValidity@ as @seconds@, @minutes@, @hours@, or @days@, set
-- a @TokenValidityUnits@ value in your API request.
--
-- For example, when you set @RefreshTokenValidity@ as @10@ and
-- @TokenValidityUnits@ as @days@, your user can refresh their session and
-- retrieve new access and ID tokens for 10 days.
--
-- The default time unit for @RefreshTokenValidity@ in an API request is
-- days. You can\'t set @RefreshTokenValidity@ to 0. If you do, Amazon
-- Cognito overrides the value with the default value of 30 days. /Valid
-- range/ is displayed below in seconds.
--
-- If you don\'t specify otherwise in the configuration of your app client,
-- your refresh tokens are valid for 30 days.
--
-- 'supportedIdentityProviders', 'updateUserPoolClient_supportedIdentityProviders' - A list of provider names for the IdPs that this client supports. The
-- following are supported: @COGNITO@, @Facebook@, @Google@,
-- @SignInWithApple@, @LoginWithAmazon@, and the names of your own SAML and
-- OIDC providers.
--
-- 'tokenValidityUnits', 'updateUserPoolClient_tokenValidityUnits' - The units in which the validity times are represented. The default unit
-- for RefreshToken is days, and the default for ID and access tokens is
-- hours.
--
-- 'writeAttributes', 'updateUserPoolClient_writeAttributes' - The writeable attributes of the user pool.
--
-- 'userPoolId', 'updateUserPoolClient_userPoolId' - The user pool ID for the user pool where you want to update the user
-- pool client.
--
-- 'clientId', 'updateUserPoolClient_clientId' - The ID of the client associated with the user pool.
newUpdateUserPoolClient ::
  -- | 'userPoolId'
  Prelude.Text ->
  -- | 'clientId'
  Prelude.Text ->
  UpdateUserPoolClient
newUpdateUserPoolClient :: Text -> Text -> UpdateUserPoolClient
newUpdateUserPoolClient Text
pUserPoolId_ Text
pClientId_ =
  UpdateUserPoolClient'
    { $sel:accessTokenValidity:UpdateUserPoolClient' :: Maybe Natural
accessTokenValidity =
        forall a. Maybe a
Prelude.Nothing,
      $sel:allowedOAuthFlows:UpdateUserPoolClient' :: Maybe [OAuthFlowType]
allowedOAuthFlows = forall a. Maybe a
Prelude.Nothing,
      $sel:allowedOAuthFlowsUserPoolClient:UpdateUserPoolClient' :: Maybe Bool
allowedOAuthFlowsUserPoolClient = forall a. Maybe a
Prelude.Nothing,
      $sel:allowedOAuthScopes:UpdateUserPoolClient' :: Maybe [Text]
allowedOAuthScopes = forall a. Maybe a
Prelude.Nothing,
      $sel:analyticsConfiguration:UpdateUserPoolClient' :: Maybe AnalyticsConfigurationType
analyticsConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:authSessionValidity:UpdateUserPoolClient' :: Maybe Natural
authSessionValidity = forall a. Maybe a
Prelude.Nothing,
      $sel:callbackURLs:UpdateUserPoolClient' :: Maybe [Text]
callbackURLs = forall a. Maybe a
Prelude.Nothing,
      $sel:clientName:UpdateUserPoolClient' :: Maybe Text
clientName = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultRedirectURI:UpdateUserPoolClient' :: Maybe Text
defaultRedirectURI = forall a. Maybe a
Prelude.Nothing,
      $sel:enablePropagateAdditionalUserContextData:UpdateUserPoolClient' :: Maybe Bool
enablePropagateAdditionalUserContextData =
        forall a. Maybe a
Prelude.Nothing,
      $sel:enableTokenRevocation:UpdateUserPoolClient' :: Maybe Bool
enableTokenRevocation = forall a. Maybe a
Prelude.Nothing,
      $sel:explicitAuthFlows:UpdateUserPoolClient' :: Maybe [ExplicitAuthFlowsType]
explicitAuthFlows = forall a. Maybe a
Prelude.Nothing,
      $sel:idTokenValidity:UpdateUserPoolClient' :: Maybe Natural
idTokenValidity = forall a. Maybe a
Prelude.Nothing,
      $sel:logoutURLs:UpdateUserPoolClient' :: Maybe [Text]
logoutURLs = forall a. Maybe a
Prelude.Nothing,
      $sel:preventUserExistenceErrors:UpdateUserPoolClient' :: Maybe PreventUserExistenceErrorTypes
preventUserExistenceErrors = forall a. Maybe a
Prelude.Nothing,
      $sel:readAttributes:UpdateUserPoolClient' :: Maybe [Text]
readAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:refreshTokenValidity:UpdateUserPoolClient' :: Maybe Natural
refreshTokenValidity = forall a. Maybe a
Prelude.Nothing,
      $sel:supportedIdentityProviders:UpdateUserPoolClient' :: Maybe [Text]
supportedIdentityProviders = forall a. Maybe a
Prelude.Nothing,
      $sel:tokenValidityUnits:UpdateUserPoolClient' :: Maybe TokenValidityUnitsType
tokenValidityUnits = forall a. Maybe a
Prelude.Nothing,
      $sel:writeAttributes:UpdateUserPoolClient' :: Maybe [Text]
writeAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:userPoolId:UpdateUserPoolClient' :: Text
userPoolId = Text
pUserPoolId_,
      $sel:clientId:UpdateUserPoolClient' :: Sensitive Text
clientId = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pClientId_
    }

-- | The access token time limit. After this limit expires, your user can\'t
-- use their access token. To specify the time unit for
-- @AccessTokenValidity@ as @seconds@, @minutes@, @hours@, or @days@, set a
-- @TokenValidityUnits@ value in your API request.
--
-- For example, when you set @AccessTokenValidity@ to @10@ and
-- @TokenValidityUnits@ to @hours@, your user can authorize access with
-- their access token for 10 hours.
--
-- The default time unit for @AccessTokenValidity@ in an API request is
-- hours. /Valid range/ is displayed below in seconds.
--
-- If you don\'t specify otherwise in the configuration of your app client,
-- your access tokens are valid for one hour.
updateUserPoolClient_accessTokenValidity :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe Prelude.Natural)
updateUserPoolClient_accessTokenValidity :: Lens' UpdateUserPoolClient (Maybe Natural)
updateUserPoolClient_accessTokenValidity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe Natural
accessTokenValidity :: Maybe Natural
$sel:accessTokenValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
accessTokenValidity} -> Maybe Natural
accessTokenValidity) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe Natural
a -> UpdateUserPoolClient
s {$sel:accessTokenValidity:UpdateUserPoolClient' :: Maybe Natural
accessTokenValidity = Maybe Natural
a} :: UpdateUserPoolClient)

-- | The allowed OAuth flows.
--
-- [code]
--     Use a code grant flow, which provides an authorization code as the
--     response. This code can be exchanged for access tokens with the
--     @\/oauth2\/token@ endpoint.
--
-- [implicit]
--     Issue the access token (and, optionally, ID token, based on scopes)
--     directly to your user.
--
-- [client_credentials]
--     Issue the access token from the @\/oauth2\/token@ endpoint directly
--     to a non-person user using a combination of the client ID and client
--     secret.
updateUserPoolClient_allowedOAuthFlows :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe [OAuthFlowType])
updateUserPoolClient_allowedOAuthFlows :: Lens' UpdateUserPoolClient (Maybe [OAuthFlowType])
updateUserPoolClient_allowedOAuthFlows = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe [OAuthFlowType]
allowedOAuthFlows :: Maybe [OAuthFlowType]
$sel:allowedOAuthFlows:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [OAuthFlowType]
allowedOAuthFlows} -> Maybe [OAuthFlowType]
allowedOAuthFlows) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe [OAuthFlowType]
a -> UpdateUserPoolClient
s {$sel:allowedOAuthFlows:UpdateUserPoolClient' :: Maybe [OAuthFlowType]
allowedOAuthFlows = Maybe [OAuthFlowType]
a} :: UpdateUserPoolClient) 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

-- | Set to true if the client is allowed to follow the OAuth protocol when
-- interacting with Amazon Cognito user pools.
updateUserPoolClient_allowedOAuthFlowsUserPoolClient :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe Prelude.Bool)
updateUserPoolClient_allowedOAuthFlowsUserPoolClient :: Lens' UpdateUserPoolClient (Maybe Bool)
updateUserPoolClient_allowedOAuthFlowsUserPoolClient = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe Bool
allowedOAuthFlowsUserPoolClient :: Maybe Bool
$sel:allowedOAuthFlowsUserPoolClient:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Bool
allowedOAuthFlowsUserPoolClient} -> Maybe Bool
allowedOAuthFlowsUserPoolClient) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe Bool
a -> UpdateUserPoolClient
s {$sel:allowedOAuthFlowsUserPoolClient:UpdateUserPoolClient' :: Maybe Bool
allowedOAuthFlowsUserPoolClient = Maybe Bool
a} :: UpdateUserPoolClient)

-- | The allowed OAuth scopes. Possible values provided by OAuth are @phone@,
-- @email@, @openid@, and @profile@. Possible values provided by Amazon Web
-- Services are @aws.cognito.signin.user.admin@. Custom scopes created in
-- Resource Servers are also supported.
updateUserPoolClient_allowedOAuthScopes :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe [Prelude.Text])
updateUserPoolClient_allowedOAuthScopes :: Lens' UpdateUserPoolClient (Maybe [Text])
updateUserPoolClient_allowedOAuthScopes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe [Text]
allowedOAuthScopes :: Maybe [Text]
$sel:allowedOAuthScopes:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
allowedOAuthScopes} -> Maybe [Text]
allowedOAuthScopes) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe [Text]
a -> UpdateUserPoolClient
s {$sel:allowedOAuthScopes:UpdateUserPoolClient' :: Maybe [Text]
allowedOAuthScopes = Maybe [Text]
a} :: UpdateUserPoolClient) 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 Amazon Pinpoint analytics configuration necessary to collect metrics
-- for this user pool.
--
-- In Amazon Web Services Regions where Amazon Pinpoint isn\'t available,
-- user pools only support sending events to Amazon Pinpoint projects in
-- us-east-1. In Regions where Amazon Pinpoint is available, user pools
-- support sending events to Amazon Pinpoint projects within that same
-- Region.
updateUserPoolClient_analyticsConfiguration :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe AnalyticsConfigurationType)
updateUserPoolClient_analyticsConfiguration :: Lens' UpdateUserPoolClient (Maybe AnalyticsConfigurationType)
updateUserPoolClient_analyticsConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe AnalyticsConfigurationType
analyticsConfiguration :: Maybe AnalyticsConfigurationType
$sel:analyticsConfiguration:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe AnalyticsConfigurationType
analyticsConfiguration} -> Maybe AnalyticsConfigurationType
analyticsConfiguration) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe AnalyticsConfigurationType
a -> UpdateUserPoolClient
s {$sel:analyticsConfiguration:UpdateUserPoolClient' :: Maybe AnalyticsConfigurationType
analyticsConfiguration = Maybe AnalyticsConfigurationType
a} :: UpdateUserPoolClient)

-- | Amazon Cognito creates a session token for each API request in an
-- authentication flow. @AuthSessionValidity@ is the duration, in minutes,
-- of that session token. Your user pool native user must respond to each
-- authentication challenge before the session expires.
updateUserPoolClient_authSessionValidity :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe Prelude.Natural)
updateUserPoolClient_authSessionValidity :: Lens' UpdateUserPoolClient (Maybe Natural)
updateUserPoolClient_authSessionValidity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe Natural
authSessionValidity :: Maybe Natural
$sel:authSessionValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
authSessionValidity} -> Maybe Natural
authSessionValidity) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe Natural
a -> UpdateUserPoolClient
s {$sel:authSessionValidity:UpdateUserPoolClient' :: Maybe Natural
authSessionValidity = Maybe Natural
a} :: UpdateUserPoolClient)

-- | A list of allowed redirect (callback) URLs for the IdPs.
--
-- A redirect URI must:
--
-- -   Be an absolute URI.
--
-- -   Be registered with the authorization server.
--
-- -   Not include a fragment component.
--
-- See
-- <https://tools.ietf.org/html/rfc6749#section-3.1.2 OAuth 2.0 - Redirection Endpoint>.
--
-- Amazon Cognito requires HTTPS over HTTP except for http:\/\/localhost
-- for testing purposes only.
--
-- App callback URLs such as @myapp:\/\/example@ are also supported.
updateUserPoolClient_callbackURLs :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe [Prelude.Text])
updateUserPoolClient_callbackURLs :: Lens' UpdateUserPoolClient (Maybe [Text])
updateUserPoolClient_callbackURLs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe [Text]
callbackURLs :: Maybe [Text]
$sel:callbackURLs:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
callbackURLs} -> Maybe [Text]
callbackURLs) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe [Text]
a -> UpdateUserPoolClient
s {$sel:callbackURLs:UpdateUserPoolClient' :: Maybe [Text]
callbackURLs = Maybe [Text]
a} :: UpdateUserPoolClient) 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 client name from the update user pool client request.
updateUserPoolClient_clientName :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe Prelude.Text)
updateUserPoolClient_clientName :: Lens' UpdateUserPoolClient (Maybe Text)
updateUserPoolClient_clientName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe Text
clientName :: Maybe Text
$sel:clientName:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Text
clientName} -> Maybe Text
clientName) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe Text
a -> UpdateUserPoolClient
s {$sel:clientName:UpdateUserPoolClient' :: Maybe Text
clientName = Maybe Text
a} :: UpdateUserPoolClient)

-- | The default redirect URI. Must be in the @CallbackURLs@ list.
--
-- A redirect URI must:
--
-- -   Be an absolute URI.
--
-- -   Be registered with the authorization server.
--
-- -   Not include a fragment component.
--
-- See
-- <https://tools.ietf.org/html/rfc6749#section-3.1.2 OAuth 2.0 - Redirection Endpoint>.
--
-- Amazon Cognito requires HTTPS over HTTP except for @http:\/\/localhost@
-- for testing purposes only.
--
-- App callback URLs such as @myapp:\/\/example@ are also supported.
updateUserPoolClient_defaultRedirectURI :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe Prelude.Text)
updateUserPoolClient_defaultRedirectURI :: Lens' UpdateUserPoolClient (Maybe Text)
updateUserPoolClient_defaultRedirectURI = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe Text
defaultRedirectURI :: Maybe Text
$sel:defaultRedirectURI:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Text
defaultRedirectURI} -> Maybe Text
defaultRedirectURI) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe Text
a -> UpdateUserPoolClient
s {$sel:defaultRedirectURI:UpdateUserPoolClient' :: Maybe Text
defaultRedirectURI = Maybe Text
a} :: UpdateUserPoolClient)

-- | Activates the propagation of additional user context data. For more
-- information about propagation of user context data, see
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/cognito-user-pool-settings-advanced-security.html Adding advanced security to a user pool>.
-- If you don’t include this parameter, you can\'t send device fingerprint
-- information, including source IP address, to Amazon Cognito advanced
-- security. You can only activate
-- @EnablePropagateAdditionalUserContextData@ in an app client that has a
-- client secret.
updateUserPoolClient_enablePropagateAdditionalUserContextData :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe Prelude.Bool)
updateUserPoolClient_enablePropagateAdditionalUserContextData :: Lens' UpdateUserPoolClient (Maybe Bool)
updateUserPoolClient_enablePropagateAdditionalUserContextData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe Bool
enablePropagateAdditionalUserContextData :: Maybe Bool
$sel:enablePropagateAdditionalUserContextData:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Bool
enablePropagateAdditionalUserContextData} -> Maybe Bool
enablePropagateAdditionalUserContextData) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe Bool
a -> UpdateUserPoolClient
s {$sel:enablePropagateAdditionalUserContextData:UpdateUserPoolClient' :: Maybe Bool
enablePropagateAdditionalUserContextData = Maybe Bool
a} :: UpdateUserPoolClient)

-- | Activates or deactivates token revocation. For more information about
-- revoking tokens, see
-- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_RevokeToken.html RevokeToken>.
updateUserPoolClient_enableTokenRevocation :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe Prelude.Bool)
updateUserPoolClient_enableTokenRevocation :: Lens' UpdateUserPoolClient (Maybe Bool)
updateUserPoolClient_enableTokenRevocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe Bool
enableTokenRevocation :: Maybe Bool
$sel:enableTokenRevocation:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Bool
enableTokenRevocation} -> Maybe Bool
enableTokenRevocation) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe Bool
a -> UpdateUserPoolClient
s {$sel:enableTokenRevocation:UpdateUserPoolClient' :: Maybe Bool
enableTokenRevocation = Maybe Bool
a} :: UpdateUserPoolClient)

-- | The authentication flows that you want your user pool client to support.
-- For each app client in your user pool, you can sign in your users with
-- any combination of one or more flows, including with a user name and
-- Secure Remote Password (SRP), a user name and password, or a custom
-- authentication process that you define with Lambda functions.
--
-- If you don\'t specify a value for @ExplicitAuthFlows@, your user client
-- supports @ALLOW_REFRESH_TOKEN_AUTH@, @ALLOW_USER_SRP_AUTH@, and
-- @ALLOW_CUSTOM_AUTH@.
--
-- Valid values include:
--
-- -   @ALLOW_ADMIN_USER_PASSWORD_AUTH@: Enable admin based user password
--     authentication flow @ADMIN_USER_PASSWORD_AUTH@. This setting
--     replaces the @ADMIN_NO_SRP_AUTH@ setting. With this authentication
--     flow, your app passes a user name and password to Amazon Cognito in
--     the request, instead of using the Secure Remote Password (SRP)
--     protocol to securely transmit the password.
--
-- -   @ALLOW_CUSTOM_AUTH@: Enable Lambda trigger based authentication.
--
-- -   @ALLOW_USER_PASSWORD_AUTH@: Enable user password-based
--     authentication. In this flow, Amazon Cognito receives the password
--     in the request instead of using the SRP protocol to verify
--     passwords.
--
-- -   @ALLOW_USER_SRP_AUTH@: Enable SRP-based authentication.
--
-- -   @ALLOW_REFRESH_TOKEN_AUTH@: Enable authflow to refresh tokens.
--
-- In some environments, you will see the values @ADMIN_NO_SRP_AUTH@,
-- @CUSTOM_AUTH_FLOW_ONLY@, or @USER_PASSWORD_AUTH@. You can\'t assign
-- these legacy @ExplicitAuthFlows@ values to user pool clients at the same
-- time as values that begin with @ALLOW_@, like @ALLOW_USER_SRP_AUTH@.
updateUserPoolClient_explicitAuthFlows :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe [ExplicitAuthFlowsType])
updateUserPoolClient_explicitAuthFlows :: Lens' UpdateUserPoolClient (Maybe [ExplicitAuthFlowsType])
updateUserPoolClient_explicitAuthFlows = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe [ExplicitAuthFlowsType]
explicitAuthFlows :: Maybe [ExplicitAuthFlowsType]
$sel:explicitAuthFlows:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [ExplicitAuthFlowsType]
explicitAuthFlows} -> Maybe [ExplicitAuthFlowsType]
explicitAuthFlows) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe [ExplicitAuthFlowsType]
a -> UpdateUserPoolClient
s {$sel:explicitAuthFlows:UpdateUserPoolClient' :: Maybe [ExplicitAuthFlowsType]
explicitAuthFlows = Maybe [ExplicitAuthFlowsType]
a} :: UpdateUserPoolClient) 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 ID token time limit. After this limit expires, your user can\'t use
-- their ID token. To specify the time unit for @IdTokenValidity@ as
-- @seconds@, @minutes@, @hours@, or @days@, set a @TokenValidityUnits@
-- value in your API request.
--
-- For example, when you set @IdTokenValidity@ as @10@ and
-- @TokenValidityUnits@ as @hours@, your user can authenticate their
-- session with their ID token for 10 hours.
--
-- The default time unit for @AccessTokenValidity@ in an API request is
-- hours. /Valid range/ is displayed below in seconds.
--
-- If you don\'t specify otherwise in the configuration of your app client,
-- your ID tokens are valid for one hour.
updateUserPoolClient_idTokenValidity :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe Prelude.Natural)
updateUserPoolClient_idTokenValidity :: Lens' UpdateUserPoolClient (Maybe Natural)
updateUserPoolClient_idTokenValidity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe Natural
idTokenValidity :: Maybe Natural
$sel:idTokenValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
idTokenValidity} -> Maybe Natural
idTokenValidity) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe Natural
a -> UpdateUserPoolClient
s {$sel:idTokenValidity:UpdateUserPoolClient' :: Maybe Natural
idTokenValidity = Maybe Natural
a} :: UpdateUserPoolClient)

-- | A list of allowed logout URLs for the IdPs.
updateUserPoolClient_logoutURLs :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe [Prelude.Text])
updateUserPoolClient_logoutURLs :: Lens' UpdateUserPoolClient (Maybe [Text])
updateUserPoolClient_logoutURLs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe [Text]
logoutURLs :: Maybe [Text]
$sel:logoutURLs:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
logoutURLs} -> Maybe [Text]
logoutURLs) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe [Text]
a -> UpdateUserPoolClient
s {$sel:logoutURLs:UpdateUserPoolClient' :: Maybe [Text]
logoutURLs = Maybe [Text]
a} :: UpdateUserPoolClient) 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

-- | Errors and responses that you want Amazon Cognito APIs to return during
-- authentication, account confirmation, and password recovery when the
-- user doesn\'t exist in the user pool. When set to @ENABLED@ and the user
-- doesn\'t exist, authentication returns an error indicating either the
-- username or password was incorrect. Account confirmation and password
-- recovery return a response indicating a code was sent to a simulated
-- destination. When set to @LEGACY@, those APIs return a
-- @UserNotFoundException@ exception if the user doesn\'t exist in the user
-- pool.
--
-- Valid values include:
--
-- -   @ENABLED@ - This prevents user existence-related errors.
--
-- -   @LEGACY@ - This represents the early behavior of Amazon Cognito
--     where user existence related errors aren\'t prevented.
updateUserPoolClient_preventUserExistenceErrors :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe PreventUserExistenceErrorTypes)
updateUserPoolClient_preventUserExistenceErrors :: Lens' UpdateUserPoolClient (Maybe PreventUserExistenceErrorTypes)
updateUserPoolClient_preventUserExistenceErrors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe PreventUserExistenceErrorTypes
preventUserExistenceErrors :: Maybe PreventUserExistenceErrorTypes
$sel:preventUserExistenceErrors:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe PreventUserExistenceErrorTypes
preventUserExistenceErrors} -> Maybe PreventUserExistenceErrorTypes
preventUserExistenceErrors) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe PreventUserExistenceErrorTypes
a -> UpdateUserPoolClient
s {$sel:preventUserExistenceErrors:UpdateUserPoolClient' :: Maybe PreventUserExistenceErrorTypes
preventUserExistenceErrors = Maybe PreventUserExistenceErrorTypes
a} :: UpdateUserPoolClient)

-- | The read-only attributes of the user pool.
updateUserPoolClient_readAttributes :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe [Prelude.Text])
updateUserPoolClient_readAttributes :: Lens' UpdateUserPoolClient (Maybe [Text])
updateUserPoolClient_readAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe [Text]
readAttributes :: Maybe [Text]
$sel:readAttributes:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
readAttributes} -> Maybe [Text]
readAttributes) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe [Text]
a -> UpdateUserPoolClient
s {$sel:readAttributes:UpdateUserPoolClient' :: Maybe [Text]
readAttributes = Maybe [Text]
a} :: UpdateUserPoolClient) 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 refresh token time limit. After this limit expires, your user can\'t
-- use their refresh token. To specify the time unit for
-- @RefreshTokenValidity@ as @seconds@, @minutes@, @hours@, or @days@, set
-- a @TokenValidityUnits@ value in your API request.
--
-- For example, when you set @RefreshTokenValidity@ as @10@ and
-- @TokenValidityUnits@ as @days@, your user can refresh their session and
-- retrieve new access and ID tokens for 10 days.
--
-- The default time unit for @RefreshTokenValidity@ in an API request is
-- days. You can\'t set @RefreshTokenValidity@ to 0. If you do, Amazon
-- Cognito overrides the value with the default value of 30 days. /Valid
-- range/ is displayed below in seconds.
--
-- If you don\'t specify otherwise in the configuration of your app client,
-- your refresh tokens are valid for 30 days.
updateUserPoolClient_refreshTokenValidity :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe Prelude.Natural)
updateUserPoolClient_refreshTokenValidity :: Lens' UpdateUserPoolClient (Maybe Natural)
updateUserPoolClient_refreshTokenValidity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe Natural
refreshTokenValidity :: Maybe Natural
$sel:refreshTokenValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
refreshTokenValidity} -> Maybe Natural
refreshTokenValidity) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe Natural
a -> UpdateUserPoolClient
s {$sel:refreshTokenValidity:UpdateUserPoolClient' :: Maybe Natural
refreshTokenValidity = Maybe Natural
a} :: UpdateUserPoolClient)

-- | A list of provider names for the IdPs that this client supports. The
-- following are supported: @COGNITO@, @Facebook@, @Google@,
-- @SignInWithApple@, @LoginWithAmazon@, and the names of your own SAML and
-- OIDC providers.
updateUserPoolClient_supportedIdentityProviders :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe [Prelude.Text])
updateUserPoolClient_supportedIdentityProviders :: Lens' UpdateUserPoolClient (Maybe [Text])
updateUserPoolClient_supportedIdentityProviders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe [Text]
supportedIdentityProviders :: Maybe [Text]
$sel:supportedIdentityProviders:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
supportedIdentityProviders} -> Maybe [Text]
supportedIdentityProviders) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe [Text]
a -> UpdateUserPoolClient
s {$sel:supportedIdentityProviders:UpdateUserPoolClient' :: Maybe [Text]
supportedIdentityProviders = Maybe [Text]
a} :: UpdateUserPoolClient) 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 units in which the validity times are represented. The default unit
-- for RefreshToken is days, and the default for ID and access tokens is
-- hours.
updateUserPoolClient_tokenValidityUnits :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe TokenValidityUnitsType)
updateUserPoolClient_tokenValidityUnits :: Lens' UpdateUserPoolClient (Maybe TokenValidityUnitsType)
updateUserPoolClient_tokenValidityUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe TokenValidityUnitsType
tokenValidityUnits :: Maybe TokenValidityUnitsType
$sel:tokenValidityUnits:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe TokenValidityUnitsType
tokenValidityUnits} -> Maybe TokenValidityUnitsType
tokenValidityUnits) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe TokenValidityUnitsType
a -> UpdateUserPoolClient
s {$sel:tokenValidityUnits:UpdateUserPoolClient' :: Maybe TokenValidityUnitsType
tokenValidityUnits = Maybe TokenValidityUnitsType
a} :: UpdateUserPoolClient)

-- | The writeable attributes of the user pool.
updateUserPoolClient_writeAttributes :: Lens.Lens' UpdateUserPoolClient (Prelude.Maybe [Prelude.Text])
updateUserPoolClient_writeAttributes :: Lens' UpdateUserPoolClient (Maybe [Text])
updateUserPoolClient_writeAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Maybe [Text]
writeAttributes :: Maybe [Text]
$sel:writeAttributes:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
writeAttributes} -> Maybe [Text]
writeAttributes) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Maybe [Text]
a -> UpdateUserPoolClient
s {$sel:writeAttributes:UpdateUserPoolClient' :: Maybe [Text]
writeAttributes = Maybe [Text]
a} :: UpdateUserPoolClient) 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 user pool ID for the user pool where you want to update the user
-- pool client.
updateUserPoolClient_userPoolId :: Lens.Lens' UpdateUserPoolClient Prelude.Text
updateUserPoolClient_userPoolId :: Lens' UpdateUserPoolClient Text
updateUserPoolClient_userPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Text
userPoolId :: Text
$sel:userPoolId:UpdateUserPoolClient' :: UpdateUserPoolClient -> Text
userPoolId} -> Text
userPoolId) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Text
a -> UpdateUserPoolClient
s {$sel:userPoolId:UpdateUserPoolClient' :: Text
userPoolId = Text
a} :: UpdateUserPoolClient)

-- | The ID of the client associated with the user pool.
updateUserPoolClient_clientId :: Lens.Lens' UpdateUserPoolClient Prelude.Text
updateUserPoolClient_clientId :: Lens' UpdateUserPoolClient Text
updateUserPoolClient_clientId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClient' {Sensitive Text
clientId :: Sensitive Text
$sel:clientId:UpdateUserPoolClient' :: UpdateUserPoolClient -> Sensitive Text
clientId} -> Sensitive Text
clientId) (\s :: UpdateUserPoolClient
s@UpdateUserPoolClient' {} Sensitive Text
a -> UpdateUserPoolClient
s {$sel:clientId:UpdateUserPoolClient' :: Sensitive Text
clientId = Sensitive Text
a} :: UpdateUserPoolClient) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest UpdateUserPoolClient where
  type
    AWSResponse UpdateUserPoolClient =
      UpdateUserPoolClientResponse
  request :: (Service -> Service)
-> UpdateUserPoolClient -> Request UpdateUserPoolClient
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 UpdateUserPoolClient
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateUserPoolClient)))
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 UserPoolClientType -> Int -> UpdateUserPoolClientResponse
UpdateUserPoolClientResponse'
            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
"UserPoolClient")
            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 UpdateUserPoolClient where
  hashWithSalt :: Int -> UpdateUserPoolClient -> Int
hashWithSalt Int
_salt UpdateUserPoolClient' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe [ExplicitAuthFlowsType]
Maybe [OAuthFlowType]
Maybe Text
Maybe AnalyticsConfigurationType
Maybe PreventUserExistenceErrorTypes
Maybe TokenValidityUnitsType
Text
Sensitive Text
clientId :: Sensitive Text
userPoolId :: Text
writeAttributes :: Maybe [Text]
tokenValidityUnits :: Maybe TokenValidityUnitsType
supportedIdentityProviders :: Maybe [Text]
refreshTokenValidity :: Maybe Natural
readAttributes :: Maybe [Text]
preventUserExistenceErrors :: Maybe PreventUserExistenceErrorTypes
logoutURLs :: Maybe [Text]
idTokenValidity :: Maybe Natural
explicitAuthFlows :: Maybe [ExplicitAuthFlowsType]
enableTokenRevocation :: Maybe Bool
enablePropagateAdditionalUserContextData :: Maybe Bool
defaultRedirectURI :: Maybe Text
clientName :: Maybe Text
callbackURLs :: Maybe [Text]
authSessionValidity :: Maybe Natural
analyticsConfiguration :: Maybe AnalyticsConfigurationType
allowedOAuthScopes :: Maybe [Text]
allowedOAuthFlowsUserPoolClient :: Maybe Bool
allowedOAuthFlows :: Maybe [OAuthFlowType]
accessTokenValidity :: Maybe Natural
$sel:clientId:UpdateUserPoolClient' :: UpdateUserPoolClient -> Sensitive Text
$sel:userPoolId:UpdateUserPoolClient' :: UpdateUserPoolClient -> Text
$sel:writeAttributes:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:tokenValidityUnits:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe TokenValidityUnitsType
$sel:supportedIdentityProviders:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:refreshTokenValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
$sel:readAttributes:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:preventUserExistenceErrors:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe PreventUserExistenceErrorTypes
$sel:logoutURLs:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:idTokenValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
$sel:explicitAuthFlows:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [ExplicitAuthFlowsType]
$sel:enableTokenRevocation:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Bool
$sel:enablePropagateAdditionalUserContextData:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Bool
$sel:defaultRedirectURI:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Text
$sel:clientName:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Text
$sel:callbackURLs:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:authSessionValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
$sel:analyticsConfiguration:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe AnalyticsConfigurationType
$sel:allowedOAuthScopes:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:allowedOAuthFlowsUserPoolClient:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Bool
$sel:allowedOAuthFlows:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [OAuthFlowType]
$sel:accessTokenValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
accessTokenValidity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [OAuthFlowType]
allowedOAuthFlows
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
allowedOAuthFlowsUserPoolClient
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
allowedOAuthScopes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AnalyticsConfigurationType
analyticsConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
authSessionValidity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
callbackURLs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
defaultRedirectURI
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enablePropagateAdditionalUserContextData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableTokenRevocation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ExplicitAuthFlowsType]
explicitAuthFlows
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
idTokenValidity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
logoutURLs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PreventUserExistenceErrorTypes
preventUserExistenceErrors
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
readAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
refreshTokenValidity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
supportedIdentityProviders
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TokenValidityUnitsType
tokenValidityUnits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
writeAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
clientId

instance Prelude.NFData UpdateUserPoolClient where
  rnf :: UpdateUserPoolClient -> ()
rnf UpdateUserPoolClient' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe [ExplicitAuthFlowsType]
Maybe [OAuthFlowType]
Maybe Text
Maybe AnalyticsConfigurationType
Maybe PreventUserExistenceErrorTypes
Maybe TokenValidityUnitsType
Text
Sensitive Text
clientId :: Sensitive Text
userPoolId :: Text
writeAttributes :: Maybe [Text]
tokenValidityUnits :: Maybe TokenValidityUnitsType
supportedIdentityProviders :: Maybe [Text]
refreshTokenValidity :: Maybe Natural
readAttributes :: Maybe [Text]
preventUserExistenceErrors :: Maybe PreventUserExistenceErrorTypes
logoutURLs :: Maybe [Text]
idTokenValidity :: Maybe Natural
explicitAuthFlows :: Maybe [ExplicitAuthFlowsType]
enableTokenRevocation :: Maybe Bool
enablePropagateAdditionalUserContextData :: Maybe Bool
defaultRedirectURI :: Maybe Text
clientName :: Maybe Text
callbackURLs :: Maybe [Text]
authSessionValidity :: Maybe Natural
analyticsConfiguration :: Maybe AnalyticsConfigurationType
allowedOAuthScopes :: Maybe [Text]
allowedOAuthFlowsUserPoolClient :: Maybe Bool
allowedOAuthFlows :: Maybe [OAuthFlowType]
accessTokenValidity :: Maybe Natural
$sel:clientId:UpdateUserPoolClient' :: UpdateUserPoolClient -> Sensitive Text
$sel:userPoolId:UpdateUserPoolClient' :: UpdateUserPoolClient -> Text
$sel:writeAttributes:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:tokenValidityUnits:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe TokenValidityUnitsType
$sel:supportedIdentityProviders:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:refreshTokenValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
$sel:readAttributes:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:preventUserExistenceErrors:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe PreventUserExistenceErrorTypes
$sel:logoutURLs:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:idTokenValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
$sel:explicitAuthFlows:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [ExplicitAuthFlowsType]
$sel:enableTokenRevocation:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Bool
$sel:enablePropagateAdditionalUserContextData:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Bool
$sel:defaultRedirectURI:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Text
$sel:clientName:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Text
$sel:callbackURLs:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:authSessionValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
$sel:analyticsConfiguration:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe AnalyticsConfigurationType
$sel:allowedOAuthScopes:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:allowedOAuthFlowsUserPoolClient:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Bool
$sel:allowedOAuthFlows:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [OAuthFlowType]
$sel:accessTokenValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
accessTokenValidity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [OAuthFlowType]
allowedOAuthFlows
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
allowedOAuthFlowsUserPoolClient
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
allowedOAuthScopes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AnalyticsConfigurationType
analyticsConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
authSessionValidity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
callbackURLs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
defaultRedirectURI
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Bool
enablePropagateAdditionalUserContextData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableTokenRevocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ExplicitAuthFlowsType]
explicitAuthFlows
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
idTokenValidity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
logoutURLs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PreventUserExistenceErrorTypes
preventUserExistenceErrors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
readAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
refreshTokenValidity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe [Text]
supportedIdentityProviders
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TokenValidityUnitsType
tokenValidityUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
writeAttributes
      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

instance Data.ToHeaders UpdateUserPoolClient where
  toHeaders :: UpdateUserPoolClient -> 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.UpdateUserPoolClient" ::
                          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 UpdateUserPoolClient where
  toJSON :: UpdateUserPoolClient -> Value
toJSON UpdateUserPoolClient' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe [ExplicitAuthFlowsType]
Maybe [OAuthFlowType]
Maybe Text
Maybe AnalyticsConfigurationType
Maybe PreventUserExistenceErrorTypes
Maybe TokenValidityUnitsType
Text
Sensitive Text
clientId :: Sensitive Text
userPoolId :: Text
writeAttributes :: Maybe [Text]
tokenValidityUnits :: Maybe TokenValidityUnitsType
supportedIdentityProviders :: Maybe [Text]
refreshTokenValidity :: Maybe Natural
readAttributes :: Maybe [Text]
preventUserExistenceErrors :: Maybe PreventUserExistenceErrorTypes
logoutURLs :: Maybe [Text]
idTokenValidity :: Maybe Natural
explicitAuthFlows :: Maybe [ExplicitAuthFlowsType]
enableTokenRevocation :: Maybe Bool
enablePropagateAdditionalUserContextData :: Maybe Bool
defaultRedirectURI :: Maybe Text
clientName :: Maybe Text
callbackURLs :: Maybe [Text]
authSessionValidity :: Maybe Natural
analyticsConfiguration :: Maybe AnalyticsConfigurationType
allowedOAuthScopes :: Maybe [Text]
allowedOAuthFlowsUserPoolClient :: Maybe Bool
allowedOAuthFlows :: Maybe [OAuthFlowType]
accessTokenValidity :: Maybe Natural
$sel:clientId:UpdateUserPoolClient' :: UpdateUserPoolClient -> Sensitive Text
$sel:userPoolId:UpdateUserPoolClient' :: UpdateUserPoolClient -> Text
$sel:writeAttributes:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:tokenValidityUnits:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe TokenValidityUnitsType
$sel:supportedIdentityProviders:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:refreshTokenValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
$sel:readAttributes:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:preventUserExistenceErrors:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe PreventUserExistenceErrorTypes
$sel:logoutURLs:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:idTokenValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
$sel:explicitAuthFlows:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [ExplicitAuthFlowsType]
$sel:enableTokenRevocation:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Bool
$sel:enablePropagateAdditionalUserContextData:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Bool
$sel:defaultRedirectURI:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Text
$sel:clientName:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Text
$sel:callbackURLs:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:authSessionValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
$sel:analyticsConfiguration:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe AnalyticsConfigurationType
$sel:allowedOAuthScopes:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [Text]
$sel:allowedOAuthFlowsUserPoolClient:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Bool
$sel:allowedOAuthFlows:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe [OAuthFlowType]
$sel:accessTokenValidity:UpdateUserPoolClient' :: UpdateUserPoolClient -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccessTokenValidity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
accessTokenValidity,
            (Key
"AllowedOAuthFlows" 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 [OAuthFlowType]
allowedOAuthFlows,
            (Key
"AllowedOAuthFlowsUserPoolClient" 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 Bool
allowedOAuthFlowsUserPoolClient,
            (Key
"AllowedOAuthScopes" 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]
allowedOAuthScopes,
            (Key
"AnalyticsConfiguration" 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 AnalyticsConfigurationType
analyticsConfiguration,
            (Key
"AuthSessionValidity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
authSessionValidity,
            (Key
"CallbackURLs" 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]
callbackURLs,
            (Key
"ClientName" 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
clientName,
            (Key
"DefaultRedirectURI" 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
defaultRedirectURI,
            (Key
"EnablePropagateAdditionalUserContextData" 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 Bool
enablePropagateAdditionalUserContextData,
            (Key
"EnableTokenRevocation" 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 Bool
enableTokenRevocation,
            (Key
"ExplicitAuthFlows" 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 [ExplicitAuthFlowsType]
explicitAuthFlows,
            (Key
"IdTokenValidity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
idTokenValidity,
            (Key
"LogoutURLs" 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]
logoutURLs,
            (Key
"PreventUserExistenceErrors" 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 PreventUserExistenceErrorTypes
preventUserExistenceErrors,
            (Key
"ReadAttributes" 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]
readAttributes,
            (Key
"RefreshTokenValidity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
refreshTokenValidity,
            (Key
"SupportedIdentityProviders" 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]
supportedIdentityProviders,
            (Key
"TokenValidityUnits" 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 TokenValidityUnitsType
tokenValidityUnits,
            (Key
"WriteAttributes" 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]
writeAttributes,
            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)
          ]
      )

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

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

-- | Represents the response from the server to the request to update the
-- user pool client.
--
-- /See:/ 'newUpdateUserPoolClientResponse' smart constructor.
data UpdateUserPoolClientResponse = UpdateUserPoolClientResponse'
  { -- | The user pool client value from the response from the server when you
    -- request to update the user pool client.
    UpdateUserPoolClientResponse -> Maybe UserPoolClientType
userPoolClient :: Prelude.Maybe UserPoolClientType,
    -- | The response's http status code.
    UpdateUserPoolClientResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateUserPoolClientResponse
-> UpdateUserPoolClientResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateUserPoolClientResponse
-> UpdateUserPoolClientResponse -> Bool
$c/= :: UpdateUserPoolClientResponse
-> UpdateUserPoolClientResponse -> Bool
== :: UpdateUserPoolClientResponse
-> UpdateUserPoolClientResponse -> Bool
$c== :: UpdateUserPoolClientResponse
-> UpdateUserPoolClientResponse -> Bool
Prelude.Eq, Int -> UpdateUserPoolClientResponse -> ShowS
[UpdateUserPoolClientResponse] -> ShowS
UpdateUserPoolClientResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateUserPoolClientResponse] -> ShowS
$cshowList :: [UpdateUserPoolClientResponse] -> ShowS
show :: UpdateUserPoolClientResponse -> String
$cshow :: UpdateUserPoolClientResponse -> String
showsPrec :: Int -> UpdateUserPoolClientResponse -> ShowS
$cshowsPrec :: Int -> UpdateUserPoolClientResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateUserPoolClientResponse x -> UpdateUserPoolClientResponse
forall x.
UpdateUserPoolClientResponse -> Rep UpdateUserPoolClientResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateUserPoolClientResponse x -> UpdateUserPoolClientResponse
$cfrom :: forall x.
UpdateUserPoolClientResponse -> Rep UpdateUserPoolClientResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateUserPoolClientResponse' 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:
--
-- 'userPoolClient', 'updateUserPoolClientResponse_userPoolClient' - The user pool client value from the response from the server when you
-- request to update the user pool client.
--
-- 'httpStatus', 'updateUserPoolClientResponse_httpStatus' - The response's http status code.
newUpdateUserPoolClientResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateUserPoolClientResponse
newUpdateUserPoolClientResponse :: Int -> UpdateUserPoolClientResponse
newUpdateUserPoolClientResponse Int
pHttpStatus_ =
  UpdateUserPoolClientResponse'
    { $sel:userPoolClient:UpdateUserPoolClientResponse' :: Maybe UserPoolClientType
userPoolClient =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateUserPoolClientResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The user pool client value from the response from the server when you
-- request to update the user pool client.
updateUserPoolClientResponse_userPoolClient :: Lens.Lens' UpdateUserPoolClientResponse (Prelude.Maybe UserPoolClientType)
updateUserPoolClientResponse_userPoolClient :: Lens' UpdateUserPoolClientResponse (Maybe UserPoolClientType)
updateUserPoolClientResponse_userPoolClient = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateUserPoolClientResponse' {Maybe UserPoolClientType
userPoolClient :: Maybe UserPoolClientType
$sel:userPoolClient:UpdateUserPoolClientResponse' :: UpdateUserPoolClientResponse -> Maybe UserPoolClientType
userPoolClient} -> Maybe UserPoolClientType
userPoolClient) (\s :: UpdateUserPoolClientResponse
s@UpdateUserPoolClientResponse' {} Maybe UserPoolClientType
a -> UpdateUserPoolClientResponse
s {$sel:userPoolClient:UpdateUserPoolClientResponse' :: Maybe UserPoolClientType
userPoolClient = Maybe UserPoolClientType
a} :: UpdateUserPoolClientResponse)

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

instance Prelude.NFData UpdateUserPoolClientResponse where
  rnf :: UpdateUserPoolClientResponse -> ()
rnf UpdateUserPoolClientResponse' {Int
Maybe UserPoolClientType
httpStatus :: Int
userPoolClient :: Maybe UserPoolClientType
$sel:httpStatus:UpdateUserPoolClientResponse' :: UpdateUserPoolClientResponse -> Int
$sel:userPoolClient:UpdateUserPoolClientResponse' :: UpdateUserPoolClientResponse -> Maybe UserPoolClientType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe UserPoolClientType
userPoolClient
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus