{-# 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.APIGateway.CreateAuthorizer
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds a new Authorizer resource to an existing RestApi resource.
module Amazonka.APIGateway.CreateAuthorizer
  ( -- * Creating a Request
    CreateAuthorizer (..),
    newCreateAuthorizer,

    -- * Request Lenses
    createAuthorizer_authType,
    createAuthorizer_authorizerCredentials,
    createAuthorizer_authorizerResultTtlInSeconds,
    createAuthorizer_authorizerUri,
    createAuthorizer_identitySource,
    createAuthorizer_identityValidationExpression,
    createAuthorizer_providerARNs,
    createAuthorizer_restApiId,
    createAuthorizer_name,
    createAuthorizer_type,

    -- * Destructuring the Response
    Authorizer (..),
    newAuthorizer,

    -- * Response Lenses
    authorizer_authType,
    authorizer_authorizerCredentials,
    authorizer_authorizerResultTtlInSeconds,
    authorizer_authorizerUri,
    authorizer_id,
    authorizer_identitySource,
    authorizer_identityValidationExpression,
    authorizer_name,
    authorizer_providerARNs,
    authorizer_type,
  )
where

import Amazonka.APIGateway.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

-- | Request to add a new Authorizer to an existing RestApi resource.
--
-- /See:/ 'newCreateAuthorizer' smart constructor.
data CreateAuthorizer = CreateAuthorizer'
  { -- | Optional customer-defined field, used in OpenAPI imports and exports
    -- without functional impact.
    CreateAuthorizer -> Maybe Text
authType :: Prelude.Maybe Prelude.Text,
    -- | Specifies the required credentials as an IAM role for API Gateway to
    -- invoke the authorizer. To specify an IAM role for API Gateway to assume,
    -- use the role\'s Amazon Resource Name (ARN). To use resource-based
    -- permissions on the Lambda function, specify null.
    CreateAuthorizer -> Maybe Text
authorizerCredentials :: Prelude.Maybe Prelude.Text,
    -- | The TTL in seconds of cached authorizer results. If it equals 0,
    -- authorization caching is disabled. If it is greater than 0, API Gateway
    -- will cache authorizer responses. If this field is not set, the default
    -- value is 300. The maximum value is 3600, or 1 hour.
    CreateAuthorizer -> Maybe Int
authorizerResultTtlInSeconds :: Prelude.Maybe Prelude.Int,
    -- | Specifies the authorizer\'s Uniform Resource Identifier (URI). For
    -- @TOKEN@ or @REQUEST@ authorizers, this must be a well-formed Lambda
    -- function URI, for example,
    -- @arn:aws:apigateway:us-west-2:lambda:path\/2015-03-31\/functions\/arn:aws:lambda:us-west-2:{account_id}:function:{lambda_function_name}\/invocations@.
    -- In general, the URI has this form
    -- @arn:aws:apigateway:{region}:lambda:path\/{service_api}@, where
    -- @{region}@ is the same as the region hosting the Lambda function, @path@
    -- indicates that the remaining substring in the URI should be treated as
    -- the path to the resource, including the initial @\/@. For Lambda
    -- functions, this is usually of the form
    -- @\/2015-03-31\/functions\/[FunctionARN]\/invocations@.
    CreateAuthorizer -> Maybe Text
authorizerUri :: Prelude.Maybe Prelude.Text,
    -- | The identity source for which authorization is requested. For a @TOKEN@
    -- or @COGNITO_USER_POOLS@ authorizer, this is required and specifies the
    -- request header mapping expression for the custom header holding the
    -- authorization token submitted by the client. For example, if the token
    -- header name is @Auth@, the header mapping expression is
    -- @method.request.header.Auth@. For the @REQUEST@ authorizer, this is
    -- required when authorization caching is enabled. The value is a
    -- comma-separated string of one or more mapping expressions of the
    -- specified request parameters. For example, if an @Auth@ header, a @Name@
    -- query string parameter are defined as identity sources, this value is
    -- @method.request.header.Auth, method.request.querystring.Name@. These
    -- parameters will be used to derive the authorization caching key and to
    -- perform runtime validation of the @REQUEST@ authorizer by verifying all
    -- of the identity-related request parameters are present, not null and
    -- non-empty. Only when this is true does the authorizer invoke the
    -- authorizer Lambda function, otherwise, it returns a 401 Unauthorized
    -- response without calling the Lambda function. The valid value is a
    -- string of comma-separated mapping expressions of the specified request
    -- parameters. When the authorization caching is not enabled, this property
    -- is optional.
    CreateAuthorizer -> Maybe Text
identitySource :: Prelude.Maybe Prelude.Text,
    -- | A validation expression for the incoming identity token. For @TOKEN@
    -- authorizers, this value is a regular expression. For
    -- @COGNITO_USER_POOLS@ authorizers, API Gateway will match the @aud@ field
    -- of the incoming token from the client against the specified regular
    -- expression. It will invoke the authorizer\'s Lambda function when there
    -- is a match. Otherwise, it will return a 401 Unauthorized response
    -- without calling the Lambda function. The validation expression does not
    -- apply to the @REQUEST@ authorizer.
    CreateAuthorizer -> Maybe Text
identityValidationExpression :: Prelude.Maybe Prelude.Text,
    -- | A list of the Amazon Cognito user pool ARNs for the @COGNITO_USER_POOLS@
    -- authorizer. Each element is of this format:
    -- @arn:aws:cognito-idp:{region}:{account_id}:userpool\/{user_pool_id}@.
    -- For a @TOKEN@ or @REQUEST@ authorizer, this is not defined.
    CreateAuthorizer -> Maybe [Text]
providerARNs :: Prelude.Maybe [Prelude.Text],
    -- | The string identifier of the associated RestApi.
    CreateAuthorizer -> Text
restApiId :: Prelude.Text,
    -- | The name of the authorizer.
    CreateAuthorizer -> Text
name :: Prelude.Text,
    -- | The authorizer type. Valid values are @TOKEN@ for a Lambda function
    -- using a single authorization token submitted in a custom header,
    -- @REQUEST@ for a Lambda function using incoming request parameters, and
    -- @COGNITO_USER_POOLS@ for using an Amazon Cognito user pool.
    CreateAuthorizer -> AuthorizerType
type' :: AuthorizerType
  }
  deriving (CreateAuthorizer -> CreateAuthorizer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAuthorizer -> CreateAuthorizer -> Bool
$c/= :: CreateAuthorizer -> CreateAuthorizer -> Bool
== :: CreateAuthorizer -> CreateAuthorizer -> Bool
$c== :: CreateAuthorizer -> CreateAuthorizer -> Bool
Prelude.Eq, ReadPrec [CreateAuthorizer]
ReadPrec CreateAuthorizer
Int -> ReadS CreateAuthorizer
ReadS [CreateAuthorizer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAuthorizer]
$creadListPrec :: ReadPrec [CreateAuthorizer]
readPrec :: ReadPrec CreateAuthorizer
$creadPrec :: ReadPrec CreateAuthorizer
readList :: ReadS [CreateAuthorizer]
$creadList :: ReadS [CreateAuthorizer]
readsPrec :: Int -> ReadS CreateAuthorizer
$creadsPrec :: Int -> ReadS CreateAuthorizer
Prelude.Read, Int -> CreateAuthorizer -> ShowS
[CreateAuthorizer] -> ShowS
CreateAuthorizer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAuthorizer] -> ShowS
$cshowList :: [CreateAuthorizer] -> ShowS
show :: CreateAuthorizer -> String
$cshow :: CreateAuthorizer -> String
showsPrec :: Int -> CreateAuthorizer -> ShowS
$cshowsPrec :: Int -> CreateAuthorizer -> ShowS
Prelude.Show, forall x. Rep CreateAuthorizer x -> CreateAuthorizer
forall x. CreateAuthorizer -> Rep CreateAuthorizer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAuthorizer x -> CreateAuthorizer
$cfrom :: forall x. CreateAuthorizer -> Rep CreateAuthorizer x
Prelude.Generic)

-- |
-- Create a value of 'CreateAuthorizer' 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:
--
-- 'authType', 'createAuthorizer_authType' - Optional customer-defined field, used in OpenAPI imports and exports
-- without functional impact.
--
-- 'authorizerCredentials', 'createAuthorizer_authorizerCredentials' - Specifies the required credentials as an IAM role for API Gateway to
-- invoke the authorizer. To specify an IAM role for API Gateway to assume,
-- use the role\'s Amazon Resource Name (ARN). To use resource-based
-- permissions on the Lambda function, specify null.
--
-- 'authorizerResultTtlInSeconds', 'createAuthorizer_authorizerResultTtlInSeconds' - The TTL in seconds of cached authorizer results. If it equals 0,
-- authorization caching is disabled. If it is greater than 0, API Gateway
-- will cache authorizer responses. If this field is not set, the default
-- value is 300. The maximum value is 3600, or 1 hour.
--
-- 'authorizerUri', 'createAuthorizer_authorizerUri' - Specifies the authorizer\'s Uniform Resource Identifier (URI). For
-- @TOKEN@ or @REQUEST@ authorizers, this must be a well-formed Lambda
-- function URI, for example,
-- @arn:aws:apigateway:us-west-2:lambda:path\/2015-03-31\/functions\/arn:aws:lambda:us-west-2:{account_id}:function:{lambda_function_name}\/invocations@.
-- In general, the URI has this form
-- @arn:aws:apigateway:{region}:lambda:path\/{service_api}@, where
-- @{region}@ is the same as the region hosting the Lambda function, @path@
-- indicates that the remaining substring in the URI should be treated as
-- the path to the resource, including the initial @\/@. For Lambda
-- functions, this is usually of the form
-- @\/2015-03-31\/functions\/[FunctionARN]\/invocations@.
--
-- 'identitySource', 'createAuthorizer_identitySource' - The identity source for which authorization is requested. For a @TOKEN@
-- or @COGNITO_USER_POOLS@ authorizer, this is required and specifies the
-- request header mapping expression for the custom header holding the
-- authorization token submitted by the client. For example, if the token
-- header name is @Auth@, the header mapping expression is
-- @method.request.header.Auth@. For the @REQUEST@ authorizer, this is
-- required when authorization caching is enabled. The value is a
-- comma-separated string of one or more mapping expressions of the
-- specified request parameters. For example, if an @Auth@ header, a @Name@
-- query string parameter are defined as identity sources, this value is
-- @method.request.header.Auth, method.request.querystring.Name@. These
-- parameters will be used to derive the authorization caching key and to
-- perform runtime validation of the @REQUEST@ authorizer by verifying all
-- of the identity-related request parameters are present, not null and
-- non-empty. Only when this is true does the authorizer invoke the
-- authorizer Lambda function, otherwise, it returns a 401 Unauthorized
-- response without calling the Lambda function. The valid value is a
-- string of comma-separated mapping expressions of the specified request
-- parameters. When the authorization caching is not enabled, this property
-- is optional.
--
-- 'identityValidationExpression', 'createAuthorizer_identityValidationExpression' - A validation expression for the incoming identity token. For @TOKEN@
-- authorizers, this value is a regular expression. For
-- @COGNITO_USER_POOLS@ authorizers, API Gateway will match the @aud@ field
-- of the incoming token from the client against the specified regular
-- expression. It will invoke the authorizer\'s Lambda function when there
-- is a match. Otherwise, it will return a 401 Unauthorized response
-- without calling the Lambda function. The validation expression does not
-- apply to the @REQUEST@ authorizer.
--
-- 'providerARNs', 'createAuthorizer_providerARNs' - A list of the Amazon Cognito user pool ARNs for the @COGNITO_USER_POOLS@
-- authorizer. Each element is of this format:
-- @arn:aws:cognito-idp:{region}:{account_id}:userpool\/{user_pool_id}@.
-- For a @TOKEN@ or @REQUEST@ authorizer, this is not defined.
--
-- 'restApiId', 'createAuthorizer_restApiId' - The string identifier of the associated RestApi.
--
-- 'name', 'createAuthorizer_name' - The name of the authorizer.
--
-- 'type'', 'createAuthorizer_type' - The authorizer type. Valid values are @TOKEN@ for a Lambda function
-- using a single authorization token submitted in a custom header,
-- @REQUEST@ for a Lambda function using incoming request parameters, and
-- @COGNITO_USER_POOLS@ for using an Amazon Cognito user pool.
newCreateAuthorizer ::
  -- | 'restApiId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'type''
  AuthorizerType ->
  CreateAuthorizer
newCreateAuthorizer :: Text -> Text -> AuthorizerType -> CreateAuthorizer
newCreateAuthorizer Text
pRestApiId_ Text
pName_ AuthorizerType
pType_ =
  CreateAuthorizer'
    { $sel:authType:CreateAuthorizer' :: Maybe Text
authType = forall a. Maybe a
Prelude.Nothing,
      $sel:authorizerCredentials:CreateAuthorizer' :: Maybe Text
authorizerCredentials = forall a. Maybe a
Prelude.Nothing,
      $sel:authorizerResultTtlInSeconds:CreateAuthorizer' :: Maybe Int
authorizerResultTtlInSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:authorizerUri:CreateAuthorizer' :: Maybe Text
authorizerUri = forall a. Maybe a
Prelude.Nothing,
      $sel:identitySource:CreateAuthorizer' :: Maybe Text
identitySource = forall a. Maybe a
Prelude.Nothing,
      $sel:identityValidationExpression:CreateAuthorizer' :: Maybe Text
identityValidationExpression = forall a. Maybe a
Prelude.Nothing,
      $sel:providerARNs:CreateAuthorizer' :: Maybe [Text]
providerARNs = forall a. Maybe a
Prelude.Nothing,
      $sel:restApiId:CreateAuthorizer' :: Text
restApiId = Text
pRestApiId_,
      $sel:name:CreateAuthorizer' :: Text
name = Text
pName_,
      $sel:type':CreateAuthorizer' :: AuthorizerType
type' = AuthorizerType
pType_
    }

-- | Optional customer-defined field, used in OpenAPI imports and exports
-- without functional impact.
createAuthorizer_authType :: Lens.Lens' CreateAuthorizer (Prelude.Maybe Prelude.Text)
createAuthorizer_authType :: Lens' CreateAuthorizer (Maybe Text)
createAuthorizer_authType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAuthorizer' {Maybe Text
authType :: Maybe Text
$sel:authType:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
authType} -> Maybe Text
authType) (\s :: CreateAuthorizer
s@CreateAuthorizer' {} Maybe Text
a -> CreateAuthorizer
s {$sel:authType:CreateAuthorizer' :: Maybe Text
authType = Maybe Text
a} :: CreateAuthorizer)

-- | Specifies the required credentials as an IAM role for API Gateway to
-- invoke the authorizer. To specify an IAM role for API Gateway to assume,
-- use the role\'s Amazon Resource Name (ARN). To use resource-based
-- permissions on the Lambda function, specify null.
createAuthorizer_authorizerCredentials :: Lens.Lens' CreateAuthorizer (Prelude.Maybe Prelude.Text)
createAuthorizer_authorizerCredentials :: Lens' CreateAuthorizer (Maybe Text)
createAuthorizer_authorizerCredentials = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAuthorizer' {Maybe Text
authorizerCredentials :: Maybe Text
$sel:authorizerCredentials:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
authorizerCredentials} -> Maybe Text
authorizerCredentials) (\s :: CreateAuthorizer
s@CreateAuthorizer' {} Maybe Text
a -> CreateAuthorizer
s {$sel:authorizerCredentials:CreateAuthorizer' :: Maybe Text
authorizerCredentials = Maybe Text
a} :: CreateAuthorizer)

-- | The TTL in seconds of cached authorizer results. If it equals 0,
-- authorization caching is disabled. If it is greater than 0, API Gateway
-- will cache authorizer responses. If this field is not set, the default
-- value is 300. The maximum value is 3600, or 1 hour.
createAuthorizer_authorizerResultTtlInSeconds :: Lens.Lens' CreateAuthorizer (Prelude.Maybe Prelude.Int)
createAuthorizer_authorizerResultTtlInSeconds :: Lens' CreateAuthorizer (Maybe Int)
createAuthorizer_authorizerResultTtlInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAuthorizer' {Maybe Int
authorizerResultTtlInSeconds :: Maybe Int
$sel:authorizerResultTtlInSeconds:CreateAuthorizer' :: CreateAuthorizer -> Maybe Int
authorizerResultTtlInSeconds} -> Maybe Int
authorizerResultTtlInSeconds) (\s :: CreateAuthorizer
s@CreateAuthorizer' {} Maybe Int
a -> CreateAuthorizer
s {$sel:authorizerResultTtlInSeconds:CreateAuthorizer' :: Maybe Int
authorizerResultTtlInSeconds = Maybe Int
a} :: CreateAuthorizer)

-- | Specifies the authorizer\'s Uniform Resource Identifier (URI). For
-- @TOKEN@ or @REQUEST@ authorizers, this must be a well-formed Lambda
-- function URI, for example,
-- @arn:aws:apigateway:us-west-2:lambda:path\/2015-03-31\/functions\/arn:aws:lambda:us-west-2:{account_id}:function:{lambda_function_name}\/invocations@.
-- In general, the URI has this form
-- @arn:aws:apigateway:{region}:lambda:path\/{service_api}@, where
-- @{region}@ is the same as the region hosting the Lambda function, @path@
-- indicates that the remaining substring in the URI should be treated as
-- the path to the resource, including the initial @\/@. For Lambda
-- functions, this is usually of the form
-- @\/2015-03-31\/functions\/[FunctionARN]\/invocations@.
createAuthorizer_authorizerUri :: Lens.Lens' CreateAuthorizer (Prelude.Maybe Prelude.Text)
createAuthorizer_authorizerUri :: Lens' CreateAuthorizer (Maybe Text)
createAuthorizer_authorizerUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAuthorizer' {Maybe Text
authorizerUri :: Maybe Text
$sel:authorizerUri:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
authorizerUri} -> Maybe Text
authorizerUri) (\s :: CreateAuthorizer
s@CreateAuthorizer' {} Maybe Text
a -> CreateAuthorizer
s {$sel:authorizerUri:CreateAuthorizer' :: Maybe Text
authorizerUri = Maybe Text
a} :: CreateAuthorizer)

-- | The identity source for which authorization is requested. For a @TOKEN@
-- or @COGNITO_USER_POOLS@ authorizer, this is required and specifies the
-- request header mapping expression for the custom header holding the
-- authorization token submitted by the client. For example, if the token
-- header name is @Auth@, the header mapping expression is
-- @method.request.header.Auth@. For the @REQUEST@ authorizer, this is
-- required when authorization caching is enabled. The value is a
-- comma-separated string of one or more mapping expressions of the
-- specified request parameters. For example, if an @Auth@ header, a @Name@
-- query string parameter are defined as identity sources, this value is
-- @method.request.header.Auth, method.request.querystring.Name@. These
-- parameters will be used to derive the authorization caching key and to
-- perform runtime validation of the @REQUEST@ authorizer by verifying all
-- of the identity-related request parameters are present, not null and
-- non-empty. Only when this is true does the authorizer invoke the
-- authorizer Lambda function, otherwise, it returns a 401 Unauthorized
-- response without calling the Lambda function. The valid value is a
-- string of comma-separated mapping expressions of the specified request
-- parameters. When the authorization caching is not enabled, this property
-- is optional.
createAuthorizer_identitySource :: Lens.Lens' CreateAuthorizer (Prelude.Maybe Prelude.Text)
createAuthorizer_identitySource :: Lens' CreateAuthorizer (Maybe Text)
createAuthorizer_identitySource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAuthorizer' {Maybe Text
identitySource :: Maybe Text
$sel:identitySource:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
identitySource} -> Maybe Text
identitySource) (\s :: CreateAuthorizer
s@CreateAuthorizer' {} Maybe Text
a -> CreateAuthorizer
s {$sel:identitySource:CreateAuthorizer' :: Maybe Text
identitySource = Maybe Text
a} :: CreateAuthorizer)

-- | A validation expression for the incoming identity token. For @TOKEN@
-- authorizers, this value is a regular expression. For
-- @COGNITO_USER_POOLS@ authorizers, API Gateway will match the @aud@ field
-- of the incoming token from the client against the specified regular
-- expression. It will invoke the authorizer\'s Lambda function when there
-- is a match. Otherwise, it will return a 401 Unauthorized response
-- without calling the Lambda function. The validation expression does not
-- apply to the @REQUEST@ authorizer.
createAuthorizer_identityValidationExpression :: Lens.Lens' CreateAuthorizer (Prelude.Maybe Prelude.Text)
createAuthorizer_identityValidationExpression :: Lens' CreateAuthorizer (Maybe Text)
createAuthorizer_identityValidationExpression = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAuthorizer' {Maybe Text
identityValidationExpression :: Maybe Text
$sel:identityValidationExpression:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
identityValidationExpression} -> Maybe Text
identityValidationExpression) (\s :: CreateAuthorizer
s@CreateAuthorizer' {} Maybe Text
a -> CreateAuthorizer
s {$sel:identityValidationExpression:CreateAuthorizer' :: Maybe Text
identityValidationExpression = Maybe Text
a} :: CreateAuthorizer)

-- | A list of the Amazon Cognito user pool ARNs for the @COGNITO_USER_POOLS@
-- authorizer. Each element is of this format:
-- @arn:aws:cognito-idp:{region}:{account_id}:userpool\/{user_pool_id}@.
-- For a @TOKEN@ or @REQUEST@ authorizer, this is not defined.
createAuthorizer_providerARNs :: Lens.Lens' CreateAuthorizer (Prelude.Maybe [Prelude.Text])
createAuthorizer_providerARNs :: Lens' CreateAuthorizer (Maybe [Text])
createAuthorizer_providerARNs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAuthorizer' {Maybe [Text]
providerARNs :: Maybe [Text]
$sel:providerARNs:CreateAuthorizer' :: CreateAuthorizer -> Maybe [Text]
providerARNs} -> Maybe [Text]
providerARNs) (\s :: CreateAuthorizer
s@CreateAuthorizer' {} Maybe [Text]
a -> CreateAuthorizer
s {$sel:providerARNs:CreateAuthorizer' :: Maybe [Text]
providerARNs = Maybe [Text]
a} :: CreateAuthorizer) 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 string identifier of the associated RestApi.
createAuthorizer_restApiId :: Lens.Lens' CreateAuthorizer Prelude.Text
createAuthorizer_restApiId :: Lens' CreateAuthorizer Text
createAuthorizer_restApiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAuthorizer' {Text
restApiId :: Text
$sel:restApiId:CreateAuthorizer' :: CreateAuthorizer -> Text
restApiId} -> Text
restApiId) (\s :: CreateAuthorizer
s@CreateAuthorizer' {} Text
a -> CreateAuthorizer
s {$sel:restApiId:CreateAuthorizer' :: Text
restApiId = Text
a} :: CreateAuthorizer)

-- | The name of the authorizer.
createAuthorizer_name :: Lens.Lens' CreateAuthorizer Prelude.Text
createAuthorizer_name :: Lens' CreateAuthorizer Text
createAuthorizer_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAuthorizer' {Text
name :: Text
$sel:name:CreateAuthorizer' :: CreateAuthorizer -> Text
name} -> Text
name) (\s :: CreateAuthorizer
s@CreateAuthorizer' {} Text
a -> CreateAuthorizer
s {$sel:name:CreateAuthorizer' :: Text
name = Text
a} :: CreateAuthorizer)

-- | The authorizer type. Valid values are @TOKEN@ for a Lambda function
-- using a single authorization token submitted in a custom header,
-- @REQUEST@ for a Lambda function using incoming request parameters, and
-- @COGNITO_USER_POOLS@ for using an Amazon Cognito user pool.
createAuthorizer_type :: Lens.Lens' CreateAuthorizer AuthorizerType
createAuthorizer_type :: Lens' CreateAuthorizer AuthorizerType
createAuthorizer_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAuthorizer' {AuthorizerType
type' :: AuthorizerType
$sel:type':CreateAuthorizer' :: CreateAuthorizer -> AuthorizerType
type'} -> AuthorizerType
type') (\s :: CreateAuthorizer
s@CreateAuthorizer' {} AuthorizerType
a -> CreateAuthorizer
s {$sel:type':CreateAuthorizer' :: AuthorizerType
type' = AuthorizerType
a} :: CreateAuthorizer)

instance Core.AWSRequest CreateAuthorizer where
  type AWSResponse CreateAuthorizer = Authorizer
  request :: (Service -> Service)
-> CreateAuthorizer -> Request CreateAuthorizer
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 CreateAuthorizer
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateAuthorizer)))
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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable CreateAuthorizer where
  hashWithSalt :: Int -> CreateAuthorizer -> Int
hashWithSalt Int
_salt CreateAuthorizer' {Maybe Int
Maybe [Text]
Maybe Text
Text
AuthorizerType
type' :: AuthorizerType
name :: Text
restApiId :: Text
providerARNs :: Maybe [Text]
identityValidationExpression :: Maybe Text
identitySource :: Maybe Text
authorizerUri :: Maybe Text
authorizerResultTtlInSeconds :: Maybe Int
authorizerCredentials :: Maybe Text
authType :: Maybe Text
$sel:type':CreateAuthorizer' :: CreateAuthorizer -> AuthorizerType
$sel:name:CreateAuthorizer' :: CreateAuthorizer -> Text
$sel:restApiId:CreateAuthorizer' :: CreateAuthorizer -> Text
$sel:providerARNs:CreateAuthorizer' :: CreateAuthorizer -> Maybe [Text]
$sel:identityValidationExpression:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:identitySource:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:authorizerUri:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:authorizerResultTtlInSeconds:CreateAuthorizer' :: CreateAuthorizer -> Maybe Int
$sel:authorizerCredentials:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:authType:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
authType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
authorizerCredentials
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
authorizerResultTtlInSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
authorizerUri
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
identitySource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
identityValidationExpression
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
providerARNs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
restApiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AuthorizerType
type'

instance Prelude.NFData CreateAuthorizer where
  rnf :: CreateAuthorizer -> ()
rnf CreateAuthorizer' {Maybe Int
Maybe [Text]
Maybe Text
Text
AuthorizerType
type' :: AuthorizerType
name :: Text
restApiId :: Text
providerARNs :: Maybe [Text]
identityValidationExpression :: Maybe Text
identitySource :: Maybe Text
authorizerUri :: Maybe Text
authorizerResultTtlInSeconds :: Maybe Int
authorizerCredentials :: Maybe Text
authType :: Maybe Text
$sel:type':CreateAuthorizer' :: CreateAuthorizer -> AuthorizerType
$sel:name:CreateAuthorizer' :: CreateAuthorizer -> Text
$sel:restApiId:CreateAuthorizer' :: CreateAuthorizer -> Text
$sel:providerARNs:CreateAuthorizer' :: CreateAuthorizer -> Maybe [Text]
$sel:identityValidationExpression:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:identitySource:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:authorizerUri:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:authorizerResultTtlInSeconds:CreateAuthorizer' :: CreateAuthorizer -> Maybe Int
$sel:authorizerCredentials:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:authType:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
authType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
authorizerCredentials
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
authorizerResultTtlInSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
authorizerUri
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
identitySource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
identityValidationExpression
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
providerARNs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
restApiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AuthorizerType
type'

instance Data.ToHeaders CreateAuthorizer where
  toHeaders :: CreateAuthorizer -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Accept"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/json" :: Prelude.ByteString)
          ]
      )

instance Data.ToJSON CreateAuthorizer where
  toJSON :: CreateAuthorizer -> Value
toJSON CreateAuthorizer' {Maybe Int
Maybe [Text]
Maybe Text
Text
AuthorizerType
type' :: AuthorizerType
name :: Text
restApiId :: Text
providerARNs :: Maybe [Text]
identityValidationExpression :: Maybe Text
identitySource :: Maybe Text
authorizerUri :: Maybe Text
authorizerResultTtlInSeconds :: Maybe Int
authorizerCredentials :: Maybe Text
authType :: Maybe Text
$sel:type':CreateAuthorizer' :: CreateAuthorizer -> AuthorizerType
$sel:name:CreateAuthorizer' :: CreateAuthorizer -> Text
$sel:restApiId:CreateAuthorizer' :: CreateAuthorizer -> Text
$sel:providerARNs:CreateAuthorizer' :: CreateAuthorizer -> Maybe [Text]
$sel:identityValidationExpression:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:identitySource:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:authorizerUri:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:authorizerResultTtlInSeconds:CreateAuthorizer' :: CreateAuthorizer -> Maybe Int
$sel:authorizerCredentials:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:authType:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"authType" 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
authType,
            (Key
"authorizerCredentials" 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
authorizerCredentials,
            (Key
"authorizerResultTtlInSeconds" 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 Int
authorizerResultTtlInSeconds,
            (Key
"authorizerUri" 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
authorizerUri,
            (Key
"identitySource" 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
identitySource,
            (Key
"identityValidationExpression" 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
identityValidationExpression,
            (Key
"providerARNs" 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]
providerARNs,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AuthorizerType
type')
          ]
      )

instance Data.ToPath CreateAuthorizer where
  toPath :: CreateAuthorizer -> ByteString
toPath CreateAuthorizer' {Maybe Int
Maybe [Text]
Maybe Text
Text
AuthorizerType
type' :: AuthorizerType
name :: Text
restApiId :: Text
providerARNs :: Maybe [Text]
identityValidationExpression :: Maybe Text
identitySource :: Maybe Text
authorizerUri :: Maybe Text
authorizerResultTtlInSeconds :: Maybe Int
authorizerCredentials :: Maybe Text
authType :: Maybe Text
$sel:type':CreateAuthorizer' :: CreateAuthorizer -> AuthorizerType
$sel:name:CreateAuthorizer' :: CreateAuthorizer -> Text
$sel:restApiId:CreateAuthorizer' :: CreateAuthorizer -> Text
$sel:providerARNs:CreateAuthorizer' :: CreateAuthorizer -> Maybe [Text]
$sel:identityValidationExpression:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:identitySource:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:authorizerUri:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:authorizerResultTtlInSeconds:CreateAuthorizer' :: CreateAuthorizer -> Maybe Int
$sel:authorizerCredentials:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
$sel:authType:CreateAuthorizer' :: CreateAuthorizer -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/restapis/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
restApiId, ByteString
"/authorizers"]

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