{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.UserPoolClientType
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.CognitoIdentityProvider.Types.UserPoolClientType where

import Amazonka.CognitoIdentityProvider.Types.AnalyticsConfigurationType
import Amazonka.CognitoIdentityProvider.Types.ExplicitAuthFlowsType
import Amazonka.CognitoIdentityProvider.Types.OAuthFlowType
import Amazonka.CognitoIdentityProvider.Types.PreventUserExistenceErrorTypes
import Amazonka.CognitoIdentityProvider.Types.TokenValidityUnitsType
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

-- | Contains information about a user pool client.
--
-- /See:/ 'newUserPoolClientType' smart constructor.
data UserPoolClientType = UserPoolClientType'
  { -- | 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.
    UserPoolClientType -> 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.
    UserPoolClientType -> 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.
    UserPoolClientType -> Maybe Bool
allowedOAuthFlowsUserPoolClient :: Prelude.Maybe Prelude.Bool,
    -- | The OAuth scopes that your app client supports. Possible values that
    -- OAuth provides are @phone@, @email@, @openid@, and @profile@. Possible
    -- values that Amazon Web Services provides are
    -- @aws.cognito.signin.user.admin@. Amazon Cognito also supports custom
    -- scopes that you create in Resource Servers.
    UserPoolClientType -> Maybe [Text]
allowedOAuthScopes :: Prelude.Maybe [Prelude.Text],
    -- | The Amazon Pinpoint analytics configuration for the user pool client.
    --
    -- Amazon Cognito user pools only support sending events to Amazon Pinpoint
    -- projects in the US East (N. Virginia) us-east-1 Region, regardless of
    -- the Region where the user pool resides.
    UserPoolClientType -> 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.
    UserPoolClientType -> 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.
    UserPoolClientType -> Maybe [Text]
callbackURLs :: Prelude.Maybe [Prelude.Text],
    -- | The ID of the client associated with the user pool.
    UserPoolClientType -> Maybe (Sensitive Text)
clientId :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The client name from the user pool request of the client type.
    UserPoolClientType -> Maybe Text
clientName :: Prelude.Maybe Prelude.Text,
    -- | The client secret from the user pool request of the client type.
    UserPoolClientType -> Maybe (Sensitive Text)
clientSecret :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The date the user pool client was created.
    UserPoolClientType -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | 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.
    UserPoolClientType -> Maybe Text
defaultRedirectURI :: Prelude.Maybe Prelude.Text,
    -- | When @EnablePropagateAdditionalUserContextData@ is true, Amazon Cognito
    -- accepts an @IpAddress@ value that you send in the @UserContextData@
    -- parameter. The @UserContextData@ parameter sends information to Amazon
    -- Cognito advanced security for risk analysis. You can send
    -- @UserContextData@ when you sign in Amazon Cognito native users with the
    -- @InitiateAuth@ and @RespondToAuthChallenge@ API operations.
    --
    -- When @EnablePropagateAdditionalUserContextData@ is false, you can\'t
    -- send your user\'s source IP address to Amazon Cognito advanced security
    -- with unauthenticated API operations.
    -- @EnablePropagateAdditionalUserContextData@ doesn\'t affect whether you
    -- can send a source IP address in a @ContextData@ parameter with the
    -- authenticated API operations @AdminInitiateAuth@ and
    -- @AdminRespondToAuthChallenge@.
    --
    -- You can only activate @EnablePropagateAdditionalUserContextData@ in an
    -- app client that has a client secret. For more information about
    -- propagation of user context data, see
    -- <https://docs.aws.amazon.com/cognito/latest/developerguide/cognito-user-pool-settings-adaptive-authentication.html#user-pool-settings-adaptive-authentication-device-fingerprint Adding user device and session data to API requests>.
    UserPoolClientType -> Maybe Bool
enablePropagateAdditionalUserContextData :: Prelude.Maybe Prelude.Bool,
    -- | Indicates whether token revocation is activated for the user pool
    -- client. When you create a new user pool client, token revocation is
    -- activated by default. For more information about revoking tokens, see
    -- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_RevokeToken.html RevokeToken>.
    UserPoolClientType -> 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@.
    UserPoolClientType -> 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.
    UserPoolClientType -> Maybe Natural
idTokenValidity :: Prelude.Maybe Prelude.Natural,
    -- | The date the user pool client was last modified.
    UserPoolClientType -> Maybe POSIX
lastModifiedDate :: Prelude.Maybe Data.POSIX,
    -- | A list of allowed logout URLs for the IdPs.
    UserPoolClientType -> 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 old behavior of Amazon Cognito where
    --     user existence related errors aren\'t prevented.
    UserPoolClientType -> Maybe PreventUserExistenceErrorTypes
preventUserExistenceErrors :: Prelude.Maybe PreventUserExistenceErrorTypes,
    -- | The Read-only attributes.
    UserPoolClientType -> 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.
    UserPoolClientType -> 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.
    UserPoolClientType -> Maybe [Text]
supportedIdentityProviders :: Prelude.Maybe [Prelude.Text],
    -- | The time units used to specify the token validity times of each token
    -- type: ID, access, and refresh.
    UserPoolClientType -> Maybe TokenValidityUnitsType
tokenValidityUnits :: Prelude.Maybe TokenValidityUnitsType,
    -- | The user pool ID for the user pool client.
    UserPoolClientType -> Maybe Text
userPoolId :: Prelude.Maybe Prelude.Text,
    -- | The writeable attributes.
    UserPoolClientType -> Maybe [Text]
writeAttributes :: Prelude.Maybe [Prelude.Text]
  }
  deriving (UserPoolClientType -> UserPoolClientType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserPoolClientType -> UserPoolClientType -> Bool
$c/= :: UserPoolClientType -> UserPoolClientType -> Bool
== :: UserPoolClientType -> UserPoolClientType -> Bool
$c== :: UserPoolClientType -> UserPoolClientType -> Bool
Prelude.Eq, Int -> UserPoolClientType -> ShowS
[UserPoolClientType] -> ShowS
UserPoolClientType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserPoolClientType] -> ShowS
$cshowList :: [UserPoolClientType] -> ShowS
show :: UserPoolClientType -> String
$cshow :: UserPoolClientType -> String
showsPrec :: Int -> UserPoolClientType -> ShowS
$cshowsPrec :: Int -> UserPoolClientType -> ShowS
Prelude.Show, forall x. Rep UserPoolClientType x -> UserPoolClientType
forall x. UserPoolClientType -> Rep UserPoolClientType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserPoolClientType x -> UserPoolClientType
$cfrom :: forall x. UserPoolClientType -> Rep UserPoolClientType x
Prelude.Generic)

-- |
-- Create a value of 'UserPoolClientType' 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', 'userPoolClientType_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', 'userPoolClientType_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', 'userPoolClientType_allowedOAuthFlowsUserPoolClient' - Set to true if the client is allowed to follow the OAuth protocol when
-- interacting with Amazon Cognito user pools.
--
-- 'allowedOAuthScopes', 'userPoolClientType_allowedOAuthScopes' - The OAuth scopes that your app client supports. Possible values that
-- OAuth provides are @phone@, @email@, @openid@, and @profile@. Possible
-- values that Amazon Web Services provides are
-- @aws.cognito.signin.user.admin@. Amazon Cognito also supports custom
-- scopes that you create in Resource Servers.
--
-- 'analyticsConfiguration', 'userPoolClientType_analyticsConfiguration' - The Amazon Pinpoint analytics configuration for the user pool client.
--
-- Amazon Cognito user pools only support sending events to Amazon Pinpoint
-- projects in the US East (N. Virginia) us-east-1 Region, regardless of
-- the Region where the user pool resides.
--
-- 'authSessionValidity', 'userPoolClientType_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', 'userPoolClientType_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.
--
-- 'clientId', 'userPoolClientType_clientId' - The ID of the client associated with the user pool.
--
-- 'clientName', 'userPoolClientType_clientName' - The client name from the user pool request of the client type.
--
-- 'clientSecret', 'userPoolClientType_clientSecret' - The client secret from the user pool request of the client type.
--
-- 'creationDate', 'userPoolClientType_creationDate' - The date the user pool client was created.
--
-- 'defaultRedirectURI', 'userPoolClientType_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', 'userPoolClientType_enablePropagateAdditionalUserContextData' - When @EnablePropagateAdditionalUserContextData@ is true, Amazon Cognito
-- accepts an @IpAddress@ value that you send in the @UserContextData@
-- parameter. The @UserContextData@ parameter sends information to Amazon
-- Cognito advanced security for risk analysis. You can send
-- @UserContextData@ when you sign in Amazon Cognito native users with the
-- @InitiateAuth@ and @RespondToAuthChallenge@ API operations.
--
-- When @EnablePropagateAdditionalUserContextData@ is false, you can\'t
-- send your user\'s source IP address to Amazon Cognito advanced security
-- with unauthenticated API operations.
-- @EnablePropagateAdditionalUserContextData@ doesn\'t affect whether you
-- can send a source IP address in a @ContextData@ parameter with the
-- authenticated API operations @AdminInitiateAuth@ and
-- @AdminRespondToAuthChallenge@.
--
-- You can only activate @EnablePropagateAdditionalUserContextData@ in an
-- app client that has a client secret. For more information about
-- propagation of user context data, see
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/cognito-user-pool-settings-adaptive-authentication.html#user-pool-settings-adaptive-authentication-device-fingerprint Adding user device and session data to API requests>.
--
-- 'enableTokenRevocation', 'userPoolClientType_enableTokenRevocation' - Indicates whether token revocation is activated for the user pool
-- client. When you create a new user pool client, token revocation is
-- activated by default. For more information about revoking tokens, see
-- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_RevokeToken.html RevokeToken>.
--
-- 'explicitAuthFlows', 'userPoolClientType_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', 'userPoolClientType_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.
--
-- 'lastModifiedDate', 'userPoolClientType_lastModifiedDate' - The date the user pool client was last modified.
--
-- 'logoutURLs', 'userPoolClientType_logoutURLs' - A list of allowed logout URLs for the IdPs.
--
-- 'preventUserExistenceErrors', 'userPoolClientType_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 old behavior of Amazon Cognito where
--     user existence related errors aren\'t prevented.
--
-- 'readAttributes', 'userPoolClientType_readAttributes' - The Read-only attributes.
--
-- 'refreshTokenValidity', 'userPoolClientType_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', 'userPoolClientType_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', 'userPoolClientType_tokenValidityUnits' - The time units used to specify the token validity times of each token
-- type: ID, access, and refresh.
--
-- 'userPoolId', 'userPoolClientType_userPoolId' - The user pool ID for the user pool client.
--
-- 'writeAttributes', 'userPoolClientType_writeAttributes' - The writeable attributes.
newUserPoolClientType ::
  UserPoolClientType
newUserPoolClientType :: UserPoolClientType
newUserPoolClientType =
  UserPoolClientType'
    { $sel:accessTokenValidity:UserPoolClientType' :: Maybe Natural
accessTokenValidity =
        forall a. Maybe a
Prelude.Nothing,
      $sel:allowedOAuthFlows:UserPoolClientType' :: Maybe [OAuthFlowType]
allowedOAuthFlows = forall a. Maybe a
Prelude.Nothing,
      $sel:allowedOAuthFlowsUserPoolClient:UserPoolClientType' :: Maybe Bool
allowedOAuthFlowsUserPoolClient = forall a. Maybe a
Prelude.Nothing,
      $sel:allowedOAuthScopes:UserPoolClientType' :: Maybe [Text]
allowedOAuthScopes = forall a. Maybe a
Prelude.Nothing,
      $sel:analyticsConfiguration:UserPoolClientType' :: Maybe AnalyticsConfigurationType
analyticsConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:authSessionValidity:UserPoolClientType' :: Maybe Natural
authSessionValidity = forall a. Maybe a
Prelude.Nothing,
      $sel:callbackURLs:UserPoolClientType' :: Maybe [Text]
callbackURLs = forall a. Maybe a
Prelude.Nothing,
      $sel:clientId:UserPoolClientType' :: Maybe (Sensitive Text)
clientId = forall a. Maybe a
Prelude.Nothing,
      $sel:clientName:UserPoolClientType' :: Maybe Text
clientName = forall a. Maybe a
Prelude.Nothing,
      $sel:clientSecret:UserPoolClientType' :: Maybe (Sensitive Text)
clientSecret = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:UserPoolClientType' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultRedirectURI:UserPoolClientType' :: Maybe Text
defaultRedirectURI = forall a. Maybe a
Prelude.Nothing,
      $sel:enablePropagateAdditionalUserContextData:UserPoolClientType' :: Maybe Bool
enablePropagateAdditionalUserContextData =
        forall a. Maybe a
Prelude.Nothing,
      $sel:enableTokenRevocation:UserPoolClientType' :: Maybe Bool
enableTokenRevocation = forall a. Maybe a
Prelude.Nothing,
      $sel:explicitAuthFlows:UserPoolClientType' :: Maybe [ExplicitAuthFlowsType]
explicitAuthFlows = forall a. Maybe a
Prelude.Nothing,
      $sel:idTokenValidity:UserPoolClientType' :: Maybe Natural
idTokenValidity = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedDate:UserPoolClientType' :: Maybe POSIX
lastModifiedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:logoutURLs:UserPoolClientType' :: Maybe [Text]
logoutURLs = forall a. Maybe a
Prelude.Nothing,
      $sel:preventUserExistenceErrors:UserPoolClientType' :: Maybe PreventUserExistenceErrorTypes
preventUserExistenceErrors = forall a. Maybe a
Prelude.Nothing,
      $sel:readAttributes:UserPoolClientType' :: Maybe [Text]
readAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:refreshTokenValidity:UserPoolClientType' :: Maybe Natural
refreshTokenValidity = forall a. Maybe a
Prelude.Nothing,
      $sel:supportedIdentityProviders:UserPoolClientType' :: Maybe [Text]
supportedIdentityProviders = forall a. Maybe a
Prelude.Nothing,
      $sel:tokenValidityUnits:UserPoolClientType' :: Maybe TokenValidityUnitsType
tokenValidityUnits = forall a. Maybe a
Prelude.Nothing,
      $sel:userPoolId:UserPoolClientType' :: Maybe Text
userPoolId = forall a. Maybe a
Prelude.Nothing,
      $sel:writeAttributes:UserPoolClientType' :: Maybe [Text]
writeAttributes = forall a. Maybe a
Prelude.Nothing
    }

-- | 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.
userPoolClientType_accessTokenValidity :: Lens.Lens' UserPoolClientType (Prelude.Maybe Prelude.Natural)
userPoolClientType_accessTokenValidity :: Lens' UserPoolClientType (Maybe Natural)
userPoolClientType_accessTokenValidity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe Natural
accessTokenValidity :: Maybe Natural
$sel:accessTokenValidity:UserPoolClientType' :: UserPoolClientType -> Maybe Natural
accessTokenValidity} -> Maybe Natural
accessTokenValidity) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe Natural
a -> UserPoolClientType
s {$sel:accessTokenValidity:UserPoolClientType' :: Maybe Natural
accessTokenValidity = Maybe Natural
a} :: UserPoolClientType)

-- | 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.
userPoolClientType_allowedOAuthFlows :: Lens.Lens' UserPoolClientType (Prelude.Maybe [OAuthFlowType])
userPoolClientType_allowedOAuthFlows :: Lens' UserPoolClientType (Maybe [OAuthFlowType])
userPoolClientType_allowedOAuthFlows = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe [OAuthFlowType]
allowedOAuthFlows :: Maybe [OAuthFlowType]
$sel:allowedOAuthFlows:UserPoolClientType' :: UserPoolClientType -> Maybe [OAuthFlowType]
allowedOAuthFlows} -> Maybe [OAuthFlowType]
allowedOAuthFlows) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe [OAuthFlowType]
a -> UserPoolClientType
s {$sel:allowedOAuthFlows:UserPoolClientType' :: Maybe [OAuthFlowType]
allowedOAuthFlows = Maybe [OAuthFlowType]
a} :: UserPoolClientType) 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.
userPoolClientType_allowedOAuthFlowsUserPoolClient :: Lens.Lens' UserPoolClientType (Prelude.Maybe Prelude.Bool)
userPoolClientType_allowedOAuthFlowsUserPoolClient :: Lens' UserPoolClientType (Maybe Bool)
userPoolClientType_allowedOAuthFlowsUserPoolClient = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe Bool
allowedOAuthFlowsUserPoolClient :: Maybe Bool
$sel:allowedOAuthFlowsUserPoolClient:UserPoolClientType' :: UserPoolClientType -> Maybe Bool
allowedOAuthFlowsUserPoolClient} -> Maybe Bool
allowedOAuthFlowsUserPoolClient) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe Bool
a -> UserPoolClientType
s {$sel:allowedOAuthFlowsUserPoolClient:UserPoolClientType' :: Maybe Bool
allowedOAuthFlowsUserPoolClient = Maybe Bool
a} :: UserPoolClientType)

-- | The OAuth scopes that your app client supports. Possible values that
-- OAuth provides are @phone@, @email@, @openid@, and @profile@. Possible
-- values that Amazon Web Services provides are
-- @aws.cognito.signin.user.admin@. Amazon Cognito also supports custom
-- scopes that you create in Resource Servers.
userPoolClientType_allowedOAuthScopes :: Lens.Lens' UserPoolClientType (Prelude.Maybe [Prelude.Text])
userPoolClientType_allowedOAuthScopes :: Lens' UserPoolClientType (Maybe [Text])
userPoolClientType_allowedOAuthScopes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe [Text]
allowedOAuthScopes :: Maybe [Text]
$sel:allowedOAuthScopes:UserPoolClientType' :: UserPoolClientType -> Maybe [Text]
allowedOAuthScopes} -> Maybe [Text]
allowedOAuthScopes) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe [Text]
a -> UserPoolClientType
s {$sel:allowedOAuthScopes:UserPoolClientType' :: Maybe [Text]
allowedOAuthScopes = Maybe [Text]
a} :: UserPoolClientType) 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 for the user pool client.
--
-- Amazon Cognito user pools only support sending events to Amazon Pinpoint
-- projects in the US East (N. Virginia) us-east-1 Region, regardless of
-- the Region where the user pool resides.
userPoolClientType_analyticsConfiguration :: Lens.Lens' UserPoolClientType (Prelude.Maybe AnalyticsConfigurationType)
userPoolClientType_analyticsConfiguration :: Lens' UserPoolClientType (Maybe AnalyticsConfigurationType)
userPoolClientType_analyticsConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe AnalyticsConfigurationType
analyticsConfiguration :: Maybe AnalyticsConfigurationType
$sel:analyticsConfiguration:UserPoolClientType' :: UserPoolClientType -> Maybe AnalyticsConfigurationType
analyticsConfiguration} -> Maybe AnalyticsConfigurationType
analyticsConfiguration) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe AnalyticsConfigurationType
a -> UserPoolClientType
s {$sel:analyticsConfiguration:UserPoolClientType' :: Maybe AnalyticsConfigurationType
analyticsConfiguration = Maybe AnalyticsConfigurationType
a} :: UserPoolClientType)

-- | 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.
userPoolClientType_authSessionValidity :: Lens.Lens' UserPoolClientType (Prelude.Maybe Prelude.Natural)
userPoolClientType_authSessionValidity :: Lens' UserPoolClientType (Maybe Natural)
userPoolClientType_authSessionValidity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe Natural
authSessionValidity :: Maybe Natural
$sel:authSessionValidity:UserPoolClientType' :: UserPoolClientType -> Maybe Natural
authSessionValidity} -> Maybe Natural
authSessionValidity) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe Natural
a -> UserPoolClientType
s {$sel:authSessionValidity:UserPoolClientType' :: Maybe Natural
authSessionValidity = Maybe Natural
a} :: UserPoolClientType)

-- | 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.
userPoolClientType_callbackURLs :: Lens.Lens' UserPoolClientType (Prelude.Maybe [Prelude.Text])
userPoolClientType_callbackURLs :: Lens' UserPoolClientType (Maybe [Text])
userPoolClientType_callbackURLs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe [Text]
callbackURLs :: Maybe [Text]
$sel:callbackURLs:UserPoolClientType' :: UserPoolClientType -> Maybe [Text]
callbackURLs} -> Maybe [Text]
callbackURLs) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe [Text]
a -> UserPoolClientType
s {$sel:callbackURLs:UserPoolClientType' :: Maybe [Text]
callbackURLs = Maybe [Text]
a} :: UserPoolClientType) 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 of the client associated with the user pool.
userPoolClientType_clientId :: Lens.Lens' UserPoolClientType (Prelude.Maybe Prelude.Text)
userPoolClientType_clientId :: Lens' UserPoolClientType (Maybe Text)
userPoolClientType_clientId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe (Sensitive Text)
clientId :: Maybe (Sensitive Text)
$sel:clientId:UserPoolClientType' :: UserPoolClientType -> Maybe (Sensitive Text)
clientId} -> Maybe (Sensitive Text)
clientId) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe (Sensitive Text)
a -> UserPoolClientType
s {$sel:clientId:UserPoolClientType' :: Maybe (Sensitive Text)
clientId = Maybe (Sensitive Text)
a} :: UserPoolClientType) 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 client name from the user pool request of the client type.
userPoolClientType_clientName :: Lens.Lens' UserPoolClientType (Prelude.Maybe Prelude.Text)
userPoolClientType_clientName :: Lens' UserPoolClientType (Maybe Text)
userPoolClientType_clientName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe Text
clientName :: Maybe Text
$sel:clientName:UserPoolClientType' :: UserPoolClientType -> Maybe Text
clientName} -> Maybe Text
clientName) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe Text
a -> UserPoolClientType
s {$sel:clientName:UserPoolClientType' :: Maybe Text
clientName = Maybe Text
a} :: UserPoolClientType)

-- | The client secret from the user pool request of the client type.
userPoolClientType_clientSecret :: Lens.Lens' UserPoolClientType (Prelude.Maybe Prelude.Text)
userPoolClientType_clientSecret :: Lens' UserPoolClientType (Maybe Text)
userPoolClientType_clientSecret = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe (Sensitive Text)
clientSecret :: Maybe (Sensitive Text)
$sel:clientSecret:UserPoolClientType' :: UserPoolClientType -> Maybe (Sensitive Text)
clientSecret} -> Maybe (Sensitive Text)
clientSecret) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe (Sensitive Text)
a -> UserPoolClientType
s {$sel:clientSecret:UserPoolClientType' :: Maybe (Sensitive Text)
clientSecret = Maybe (Sensitive Text)
a} :: UserPoolClientType) 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 date the user pool client was created.
userPoolClientType_creationDate :: Lens.Lens' UserPoolClientType (Prelude.Maybe Prelude.UTCTime)
userPoolClientType_creationDate :: Lens' UserPoolClientType (Maybe UTCTime)
userPoolClientType_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:UserPoolClientType' :: UserPoolClientType -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe POSIX
a -> UserPoolClientType
s {$sel:creationDate:UserPoolClientType' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: UserPoolClientType) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | 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.
userPoolClientType_defaultRedirectURI :: Lens.Lens' UserPoolClientType (Prelude.Maybe Prelude.Text)
userPoolClientType_defaultRedirectURI :: Lens' UserPoolClientType (Maybe Text)
userPoolClientType_defaultRedirectURI = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe Text
defaultRedirectURI :: Maybe Text
$sel:defaultRedirectURI:UserPoolClientType' :: UserPoolClientType -> Maybe Text
defaultRedirectURI} -> Maybe Text
defaultRedirectURI) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe Text
a -> UserPoolClientType
s {$sel:defaultRedirectURI:UserPoolClientType' :: Maybe Text
defaultRedirectURI = Maybe Text
a} :: UserPoolClientType)

-- | When @EnablePropagateAdditionalUserContextData@ is true, Amazon Cognito
-- accepts an @IpAddress@ value that you send in the @UserContextData@
-- parameter. The @UserContextData@ parameter sends information to Amazon
-- Cognito advanced security for risk analysis. You can send
-- @UserContextData@ when you sign in Amazon Cognito native users with the
-- @InitiateAuth@ and @RespondToAuthChallenge@ API operations.
--
-- When @EnablePropagateAdditionalUserContextData@ is false, you can\'t
-- send your user\'s source IP address to Amazon Cognito advanced security
-- with unauthenticated API operations.
-- @EnablePropagateAdditionalUserContextData@ doesn\'t affect whether you
-- can send a source IP address in a @ContextData@ parameter with the
-- authenticated API operations @AdminInitiateAuth@ and
-- @AdminRespondToAuthChallenge@.
--
-- You can only activate @EnablePropagateAdditionalUserContextData@ in an
-- app client that has a client secret. For more information about
-- propagation of user context data, see
-- <https://docs.aws.amazon.com/cognito/latest/developerguide/cognito-user-pool-settings-adaptive-authentication.html#user-pool-settings-adaptive-authentication-device-fingerprint Adding user device and session data to API requests>.
userPoolClientType_enablePropagateAdditionalUserContextData :: Lens.Lens' UserPoolClientType (Prelude.Maybe Prelude.Bool)
userPoolClientType_enablePropagateAdditionalUserContextData :: Lens' UserPoolClientType (Maybe Bool)
userPoolClientType_enablePropagateAdditionalUserContextData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe Bool
enablePropagateAdditionalUserContextData :: Maybe Bool
$sel:enablePropagateAdditionalUserContextData:UserPoolClientType' :: UserPoolClientType -> Maybe Bool
enablePropagateAdditionalUserContextData} -> Maybe Bool
enablePropagateAdditionalUserContextData) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe Bool
a -> UserPoolClientType
s {$sel:enablePropagateAdditionalUserContextData:UserPoolClientType' :: Maybe Bool
enablePropagateAdditionalUserContextData = Maybe Bool
a} :: UserPoolClientType)

-- | Indicates whether token revocation is activated for the user pool
-- client. When you create a new user pool client, token revocation is
-- activated by default. For more information about revoking tokens, see
-- <https://docs.aws.amazon.com/cognito-user-identity-pools/latest/APIReference/API_RevokeToken.html RevokeToken>.
userPoolClientType_enableTokenRevocation :: Lens.Lens' UserPoolClientType (Prelude.Maybe Prelude.Bool)
userPoolClientType_enableTokenRevocation :: Lens' UserPoolClientType (Maybe Bool)
userPoolClientType_enableTokenRevocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe Bool
enableTokenRevocation :: Maybe Bool
$sel:enableTokenRevocation:UserPoolClientType' :: UserPoolClientType -> Maybe Bool
enableTokenRevocation} -> Maybe Bool
enableTokenRevocation) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe Bool
a -> UserPoolClientType
s {$sel:enableTokenRevocation:UserPoolClientType' :: Maybe Bool
enableTokenRevocation = Maybe Bool
a} :: UserPoolClientType)

-- | 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@.
userPoolClientType_explicitAuthFlows :: Lens.Lens' UserPoolClientType (Prelude.Maybe [ExplicitAuthFlowsType])
userPoolClientType_explicitAuthFlows :: Lens' UserPoolClientType (Maybe [ExplicitAuthFlowsType])
userPoolClientType_explicitAuthFlows = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe [ExplicitAuthFlowsType]
explicitAuthFlows :: Maybe [ExplicitAuthFlowsType]
$sel:explicitAuthFlows:UserPoolClientType' :: UserPoolClientType -> Maybe [ExplicitAuthFlowsType]
explicitAuthFlows} -> Maybe [ExplicitAuthFlowsType]
explicitAuthFlows) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe [ExplicitAuthFlowsType]
a -> UserPoolClientType
s {$sel:explicitAuthFlows:UserPoolClientType' :: Maybe [ExplicitAuthFlowsType]
explicitAuthFlows = Maybe [ExplicitAuthFlowsType]
a} :: UserPoolClientType) 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.
userPoolClientType_idTokenValidity :: Lens.Lens' UserPoolClientType (Prelude.Maybe Prelude.Natural)
userPoolClientType_idTokenValidity :: Lens' UserPoolClientType (Maybe Natural)
userPoolClientType_idTokenValidity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe Natural
idTokenValidity :: Maybe Natural
$sel:idTokenValidity:UserPoolClientType' :: UserPoolClientType -> Maybe Natural
idTokenValidity} -> Maybe Natural
idTokenValidity) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe Natural
a -> UserPoolClientType
s {$sel:idTokenValidity:UserPoolClientType' :: Maybe Natural
idTokenValidity = Maybe Natural
a} :: UserPoolClientType)

-- | The date the user pool client was last modified.
userPoolClientType_lastModifiedDate :: Lens.Lens' UserPoolClientType (Prelude.Maybe Prelude.UTCTime)
userPoolClientType_lastModifiedDate :: Lens' UserPoolClientType (Maybe UTCTime)
userPoolClientType_lastModifiedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe POSIX
lastModifiedDate :: Maybe POSIX
$sel:lastModifiedDate:UserPoolClientType' :: UserPoolClientType -> Maybe POSIX
lastModifiedDate} -> Maybe POSIX
lastModifiedDate) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe POSIX
a -> UserPoolClientType
s {$sel:lastModifiedDate:UserPoolClientType' :: Maybe POSIX
lastModifiedDate = Maybe POSIX
a} :: UserPoolClientType) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | A list of allowed logout URLs for the IdPs.
userPoolClientType_logoutURLs :: Lens.Lens' UserPoolClientType (Prelude.Maybe [Prelude.Text])
userPoolClientType_logoutURLs :: Lens' UserPoolClientType (Maybe [Text])
userPoolClientType_logoutURLs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe [Text]
logoutURLs :: Maybe [Text]
$sel:logoutURLs:UserPoolClientType' :: UserPoolClientType -> Maybe [Text]
logoutURLs} -> Maybe [Text]
logoutURLs) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe [Text]
a -> UserPoolClientType
s {$sel:logoutURLs:UserPoolClientType' :: Maybe [Text]
logoutURLs = Maybe [Text]
a} :: UserPoolClientType) 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 old behavior of Amazon Cognito where
--     user existence related errors aren\'t prevented.
userPoolClientType_preventUserExistenceErrors :: Lens.Lens' UserPoolClientType (Prelude.Maybe PreventUserExistenceErrorTypes)
userPoolClientType_preventUserExistenceErrors :: Lens' UserPoolClientType (Maybe PreventUserExistenceErrorTypes)
userPoolClientType_preventUserExistenceErrors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe PreventUserExistenceErrorTypes
preventUserExistenceErrors :: Maybe PreventUserExistenceErrorTypes
$sel:preventUserExistenceErrors:UserPoolClientType' :: UserPoolClientType -> Maybe PreventUserExistenceErrorTypes
preventUserExistenceErrors} -> Maybe PreventUserExistenceErrorTypes
preventUserExistenceErrors) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe PreventUserExistenceErrorTypes
a -> UserPoolClientType
s {$sel:preventUserExistenceErrors:UserPoolClientType' :: Maybe PreventUserExistenceErrorTypes
preventUserExistenceErrors = Maybe PreventUserExistenceErrorTypes
a} :: UserPoolClientType)

-- | The Read-only attributes.
userPoolClientType_readAttributes :: Lens.Lens' UserPoolClientType (Prelude.Maybe [Prelude.Text])
userPoolClientType_readAttributes :: Lens' UserPoolClientType (Maybe [Text])
userPoolClientType_readAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe [Text]
readAttributes :: Maybe [Text]
$sel:readAttributes:UserPoolClientType' :: UserPoolClientType -> Maybe [Text]
readAttributes} -> Maybe [Text]
readAttributes) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe [Text]
a -> UserPoolClientType
s {$sel:readAttributes:UserPoolClientType' :: Maybe [Text]
readAttributes = Maybe [Text]
a} :: UserPoolClientType) 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.
userPoolClientType_refreshTokenValidity :: Lens.Lens' UserPoolClientType (Prelude.Maybe Prelude.Natural)
userPoolClientType_refreshTokenValidity :: Lens' UserPoolClientType (Maybe Natural)
userPoolClientType_refreshTokenValidity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe Natural
refreshTokenValidity :: Maybe Natural
$sel:refreshTokenValidity:UserPoolClientType' :: UserPoolClientType -> Maybe Natural
refreshTokenValidity} -> Maybe Natural
refreshTokenValidity) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe Natural
a -> UserPoolClientType
s {$sel:refreshTokenValidity:UserPoolClientType' :: Maybe Natural
refreshTokenValidity = Maybe Natural
a} :: UserPoolClientType)

-- | 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.
userPoolClientType_supportedIdentityProviders :: Lens.Lens' UserPoolClientType (Prelude.Maybe [Prelude.Text])
userPoolClientType_supportedIdentityProviders :: Lens' UserPoolClientType (Maybe [Text])
userPoolClientType_supportedIdentityProviders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe [Text]
supportedIdentityProviders :: Maybe [Text]
$sel:supportedIdentityProviders:UserPoolClientType' :: UserPoolClientType -> Maybe [Text]
supportedIdentityProviders} -> Maybe [Text]
supportedIdentityProviders) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe [Text]
a -> UserPoolClientType
s {$sel:supportedIdentityProviders:UserPoolClientType' :: Maybe [Text]
supportedIdentityProviders = Maybe [Text]
a} :: UserPoolClientType) 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 time units used to specify the token validity times of each token
-- type: ID, access, and refresh.
userPoolClientType_tokenValidityUnits :: Lens.Lens' UserPoolClientType (Prelude.Maybe TokenValidityUnitsType)
userPoolClientType_tokenValidityUnits :: Lens' UserPoolClientType (Maybe TokenValidityUnitsType)
userPoolClientType_tokenValidityUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe TokenValidityUnitsType
tokenValidityUnits :: Maybe TokenValidityUnitsType
$sel:tokenValidityUnits:UserPoolClientType' :: UserPoolClientType -> Maybe TokenValidityUnitsType
tokenValidityUnits} -> Maybe TokenValidityUnitsType
tokenValidityUnits) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe TokenValidityUnitsType
a -> UserPoolClientType
s {$sel:tokenValidityUnits:UserPoolClientType' :: Maybe TokenValidityUnitsType
tokenValidityUnits = Maybe TokenValidityUnitsType
a} :: UserPoolClientType)

-- | The user pool ID for the user pool client.
userPoolClientType_userPoolId :: Lens.Lens' UserPoolClientType (Prelude.Maybe Prelude.Text)
userPoolClientType_userPoolId :: Lens' UserPoolClientType (Maybe Text)
userPoolClientType_userPoolId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe Text
userPoolId :: Maybe Text
$sel:userPoolId:UserPoolClientType' :: UserPoolClientType -> Maybe Text
userPoolId} -> Maybe Text
userPoolId) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe Text
a -> UserPoolClientType
s {$sel:userPoolId:UserPoolClientType' :: Maybe Text
userPoolId = Maybe Text
a} :: UserPoolClientType)

-- | The writeable attributes.
userPoolClientType_writeAttributes :: Lens.Lens' UserPoolClientType (Prelude.Maybe [Prelude.Text])
userPoolClientType_writeAttributes :: Lens' UserPoolClientType (Maybe [Text])
userPoolClientType_writeAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserPoolClientType' {Maybe [Text]
writeAttributes :: Maybe [Text]
$sel:writeAttributes:UserPoolClientType' :: UserPoolClientType -> Maybe [Text]
writeAttributes} -> Maybe [Text]
writeAttributes) (\s :: UserPoolClientType
s@UserPoolClientType' {} Maybe [Text]
a -> UserPoolClientType
s {$sel:writeAttributes:UserPoolClientType' :: Maybe [Text]
writeAttributes = Maybe [Text]
a} :: UserPoolClientType) 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

instance Data.FromJSON UserPoolClientType where
  parseJSON :: Value -> Parser UserPoolClientType
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"UserPoolClientType"
      ( \Object
x ->
          Maybe Natural
-> Maybe [OAuthFlowType]
-> Maybe Bool
-> Maybe [Text]
-> Maybe AnalyticsConfigurationType
-> Maybe Natural
-> Maybe [Text]
-> Maybe (Sensitive Text)
-> Maybe Text
-> Maybe (Sensitive Text)
-> Maybe POSIX
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe [ExplicitAuthFlowsType]
-> Maybe Natural
-> Maybe POSIX
-> Maybe [Text]
-> Maybe PreventUserExistenceErrorTypes
-> Maybe [Text]
-> Maybe Natural
-> Maybe [Text]
-> Maybe TokenValidityUnitsType
-> Maybe Text
-> Maybe [Text]
-> UserPoolClientType
UserPoolClientType'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AccessTokenValidity")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AllowedOAuthFlows"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AllowedOAuthFlowsUserPoolClient")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AllowedOAuthScopes"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AnalyticsConfiguration")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AuthSessionValidity")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"CallbackURLs" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ClientId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ClientName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ClientSecret")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"CreationDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"DefaultRedirectURI")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"EnablePropagateAdditionalUserContextData"
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"EnableTokenRevocation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ExplicitAuthFlows"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"IdTokenValidity")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"LastModifiedDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"LogoutURLs" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"PreventUserExistenceErrors")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ReadAttributes" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"RefreshTokenValidity")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SupportedIdentityProviders"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"TokenValidityUnits")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"UserPoolId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"WriteAttributes"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable UserPoolClientType where
  hashWithSalt :: Int -> UserPoolClientType -> Int
hashWithSalt Int
_salt UserPoolClientType' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe [ExplicitAuthFlowsType]
Maybe [OAuthFlowType]
Maybe Text
Maybe (Sensitive Text)
Maybe POSIX
Maybe AnalyticsConfigurationType
Maybe PreventUserExistenceErrorTypes
Maybe TokenValidityUnitsType
writeAttributes :: Maybe [Text]
userPoolId :: Maybe Text
tokenValidityUnits :: Maybe TokenValidityUnitsType
supportedIdentityProviders :: Maybe [Text]
refreshTokenValidity :: Maybe Natural
readAttributes :: Maybe [Text]
preventUserExistenceErrors :: Maybe PreventUserExistenceErrorTypes
logoutURLs :: Maybe [Text]
lastModifiedDate :: Maybe POSIX
idTokenValidity :: Maybe Natural
explicitAuthFlows :: Maybe [ExplicitAuthFlowsType]
enableTokenRevocation :: Maybe Bool
enablePropagateAdditionalUserContextData :: Maybe Bool
defaultRedirectURI :: Maybe Text
creationDate :: Maybe POSIX
clientSecret :: Maybe (Sensitive Text)
clientName :: Maybe Text
clientId :: Maybe (Sensitive Text)
callbackURLs :: Maybe [Text]
authSessionValidity :: Maybe Natural
analyticsConfiguration :: Maybe AnalyticsConfigurationType
allowedOAuthScopes :: Maybe [Text]
allowedOAuthFlowsUserPoolClient :: Maybe Bool
allowedOAuthFlows :: Maybe [OAuthFlowType]
accessTokenValidity :: Maybe Natural
$sel:writeAttributes:UserPoolClientType' :: UserPoolClientType -> Maybe [Text]
$sel:userPoolId:UserPoolClientType' :: UserPoolClientType -> Maybe Text
$sel:tokenValidityUnits:UserPoolClientType' :: UserPoolClientType -> Maybe TokenValidityUnitsType
$sel:supportedIdentityProviders:UserPoolClientType' :: UserPoolClientType -> Maybe [Text]
$sel:refreshTokenValidity:UserPoolClientType' :: UserPoolClientType -> Maybe Natural
$sel:readAttributes:UserPoolClientType' :: UserPoolClientType -> Maybe [Text]
$sel:preventUserExistenceErrors:UserPoolClientType' :: UserPoolClientType -> Maybe PreventUserExistenceErrorTypes
$sel:logoutURLs:UserPoolClientType' :: UserPoolClientType -> Maybe [Text]
$sel:lastModifiedDate:UserPoolClientType' :: UserPoolClientType -> Maybe POSIX
$sel:idTokenValidity:UserPoolClientType' :: UserPoolClientType -> Maybe Natural
$sel:explicitAuthFlows:UserPoolClientType' :: UserPoolClientType -> Maybe [ExplicitAuthFlowsType]
$sel:enableTokenRevocation:UserPoolClientType' :: UserPoolClientType -> Maybe Bool
$sel:enablePropagateAdditionalUserContextData:UserPoolClientType' :: UserPoolClientType -> Maybe Bool
$sel:defaultRedirectURI:UserPoolClientType' :: UserPoolClientType -> Maybe Text
$sel:creationDate:UserPoolClientType' :: UserPoolClientType -> Maybe POSIX
$sel:clientSecret:UserPoolClientType' :: UserPoolClientType -> Maybe (Sensitive Text)
$sel:clientName:UserPoolClientType' :: UserPoolClientType -> Maybe Text
$sel:clientId:UserPoolClientType' :: UserPoolClientType -> Maybe (Sensitive Text)
$sel:callbackURLs:UserPoolClientType' :: UserPoolClientType -> Maybe [Text]
$sel:authSessionValidity:UserPoolClientType' :: UserPoolClientType -> Maybe Natural
$sel:analyticsConfiguration:UserPoolClientType' :: UserPoolClientType -> Maybe AnalyticsConfigurationType
$sel:allowedOAuthScopes:UserPoolClientType' :: UserPoolClientType -> Maybe [Text]
$sel:allowedOAuthFlowsUserPoolClient:UserPoolClientType' :: UserPoolClientType -> Maybe Bool
$sel:allowedOAuthFlows:UserPoolClientType' :: UserPoolClientType -> Maybe [OAuthFlowType]
$sel:accessTokenValidity:UserPoolClientType' :: UserPoolClientType -> 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 (Sensitive Text)
clientId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
clientSecret
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
creationDate
      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 POSIX
lastModifiedDate
      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
userPoolId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
writeAttributes

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