{-# 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.TestInvokeAuthorizer
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Simulate the execution of an Authorizer in your RestApi with headers,
-- parameters, and an incoming request body.
module Amazonka.APIGateway.TestInvokeAuthorizer
  ( -- * Creating a Request
    TestInvokeAuthorizer (..),
    newTestInvokeAuthorizer,

    -- * Request Lenses
    testInvokeAuthorizer_additionalContext,
    testInvokeAuthorizer_body,
    testInvokeAuthorizer_headers,
    testInvokeAuthorizer_multiValueHeaders,
    testInvokeAuthorizer_pathWithQueryString,
    testInvokeAuthorizer_stageVariables,
    testInvokeAuthorizer_restApiId,
    testInvokeAuthorizer_authorizerId,

    -- * Destructuring the Response
    TestInvokeAuthorizerResponse (..),
    newTestInvokeAuthorizerResponse,

    -- * Response Lenses
    testInvokeAuthorizerResponse_authorization,
    testInvokeAuthorizerResponse_claims,
    testInvokeAuthorizerResponse_clientStatus,
    testInvokeAuthorizerResponse_latency,
    testInvokeAuthorizerResponse_log,
    testInvokeAuthorizerResponse_policy,
    testInvokeAuthorizerResponse_principalId,
    testInvokeAuthorizerResponse_httpStatus,
  )
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

-- | Make a request to simulate the invocation of an Authorizer.
--
-- /See:/ 'newTestInvokeAuthorizer' smart constructor.
data TestInvokeAuthorizer = TestInvokeAuthorizer'
  { -- | A key-value map of additional context variables.
    TestInvokeAuthorizer -> Maybe (HashMap Text Text)
additionalContext :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The simulated request body of an incoming invocation request.
    TestInvokeAuthorizer -> Maybe Text
body :: Prelude.Maybe Prelude.Text,
    -- | A key-value map of headers to simulate an incoming invocation request.
    -- This is where the incoming authorization token, or identity source,
    -- should be specified.
    TestInvokeAuthorizer -> Maybe (HashMap Text Text)
headers :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The headers as a map from string to list of values to simulate an
    -- incoming invocation request. This is where the incoming authorization
    -- token, or identity source, may be specified.
    TestInvokeAuthorizer -> Maybe (HashMap Text [Text])
multiValueHeaders :: Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]),
    -- | The URI path, including query string, of the simulated invocation
    -- request. Use this to specify path parameters and query string
    -- parameters.
    TestInvokeAuthorizer -> Maybe Text
pathWithQueryString :: Prelude.Maybe Prelude.Text,
    -- | A key-value map of stage variables to simulate an invocation on a
    -- deployed Stage.
    TestInvokeAuthorizer -> Maybe (HashMap Text Text)
stageVariables :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The string identifier of the associated RestApi.
    TestInvokeAuthorizer -> Text
restApiId :: Prelude.Text,
    -- | Specifies a test invoke authorizer request\'s Authorizer ID.
    TestInvokeAuthorizer -> Text
authorizerId :: Prelude.Text
  }
  deriving (TestInvokeAuthorizer -> TestInvokeAuthorizer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestInvokeAuthorizer -> TestInvokeAuthorizer -> Bool
$c/= :: TestInvokeAuthorizer -> TestInvokeAuthorizer -> Bool
== :: TestInvokeAuthorizer -> TestInvokeAuthorizer -> Bool
$c== :: TestInvokeAuthorizer -> TestInvokeAuthorizer -> Bool
Prelude.Eq, ReadPrec [TestInvokeAuthorizer]
ReadPrec TestInvokeAuthorizer
Int -> ReadS TestInvokeAuthorizer
ReadS [TestInvokeAuthorizer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestInvokeAuthorizer]
$creadListPrec :: ReadPrec [TestInvokeAuthorizer]
readPrec :: ReadPrec TestInvokeAuthorizer
$creadPrec :: ReadPrec TestInvokeAuthorizer
readList :: ReadS [TestInvokeAuthorizer]
$creadList :: ReadS [TestInvokeAuthorizer]
readsPrec :: Int -> ReadS TestInvokeAuthorizer
$creadsPrec :: Int -> ReadS TestInvokeAuthorizer
Prelude.Read, Int -> TestInvokeAuthorizer -> ShowS
[TestInvokeAuthorizer] -> ShowS
TestInvokeAuthorizer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestInvokeAuthorizer] -> ShowS
$cshowList :: [TestInvokeAuthorizer] -> ShowS
show :: TestInvokeAuthorizer -> String
$cshow :: TestInvokeAuthorizer -> String
showsPrec :: Int -> TestInvokeAuthorizer -> ShowS
$cshowsPrec :: Int -> TestInvokeAuthorizer -> ShowS
Prelude.Show, forall x. Rep TestInvokeAuthorizer x -> TestInvokeAuthorizer
forall x. TestInvokeAuthorizer -> Rep TestInvokeAuthorizer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestInvokeAuthorizer x -> TestInvokeAuthorizer
$cfrom :: forall x. TestInvokeAuthorizer -> Rep TestInvokeAuthorizer x
Prelude.Generic)

-- |
-- Create a value of 'TestInvokeAuthorizer' 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:
--
-- 'additionalContext', 'testInvokeAuthorizer_additionalContext' - A key-value map of additional context variables.
--
-- 'body', 'testInvokeAuthorizer_body' - The simulated request body of an incoming invocation request.
--
-- 'headers', 'testInvokeAuthorizer_headers' - A key-value map of headers to simulate an incoming invocation request.
-- This is where the incoming authorization token, or identity source,
-- should be specified.
--
-- 'multiValueHeaders', 'testInvokeAuthorizer_multiValueHeaders' - The headers as a map from string to list of values to simulate an
-- incoming invocation request. This is where the incoming authorization
-- token, or identity source, may be specified.
--
-- 'pathWithQueryString', 'testInvokeAuthorizer_pathWithQueryString' - The URI path, including query string, of the simulated invocation
-- request. Use this to specify path parameters and query string
-- parameters.
--
-- 'stageVariables', 'testInvokeAuthorizer_stageVariables' - A key-value map of stage variables to simulate an invocation on a
-- deployed Stage.
--
-- 'restApiId', 'testInvokeAuthorizer_restApiId' - The string identifier of the associated RestApi.
--
-- 'authorizerId', 'testInvokeAuthorizer_authorizerId' - Specifies a test invoke authorizer request\'s Authorizer ID.
newTestInvokeAuthorizer ::
  -- | 'restApiId'
  Prelude.Text ->
  -- | 'authorizerId'
  Prelude.Text ->
  TestInvokeAuthorizer
newTestInvokeAuthorizer :: Text -> Text -> TestInvokeAuthorizer
newTestInvokeAuthorizer Text
pRestApiId_ Text
pAuthorizerId_ =
  TestInvokeAuthorizer'
    { $sel:additionalContext:TestInvokeAuthorizer' :: Maybe (HashMap Text Text)
additionalContext =
        forall a. Maybe a
Prelude.Nothing,
      $sel:body:TestInvokeAuthorizer' :: Maybe Text
body = forall a. Maybe a
Prelude.Nothing,
      $sel:headers:TestInvokeAuthorizer' :: Maybe (HashMap Text Text)
headers = forall a. Maybe a
Prelude.Nothing,
      $sel:multiValueHeaders:TestInvokeAuthorizer' :: Maybe (HashMap Text [Text])
multiValueHeaders = forall a. Maybe a
Prelude.Nothing,
      $sel:pathWithQueryString:TestInvokeAuthorizer' :: Maybe Text
pathWithQueryString = forall a. Maybe a
Prelude.Nothing,
      $sel:stageVariables:TestInvokeAuthorizer' :: Maybe (HashMap Text Text)
stageVariables = forall a. Maybe a
Prelude.Nothing,
      $sel:restApiId:TestInvokeAuthorizer' :: Text
restApiId = Text
pRestApiId_,
      $sel:authorizerId:TestInvokeAuthorizer' :: Text
authorizerId = Text
pAuthorizerId_
    }

-- | A key-value map of additional context variables.
testInvokeAuthorizer_additionalContext :: Lens.Lens' TestInvokeAuthorizer (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
testInvokeAuthorizer_additionalContext :: Lens' TestInvokeAuthorizer (Maybe (HashMap Text Text))
testInvokeAuthorizer_additionalContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizer' {Maybe (HashMap Text Text)
additionalContext :: Maybe (HashMap Text Text)
$sel:additionalContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
additionalContext} -> Maybe (HashMap Text Text)
additionalContext) (\s :: TestInvokeAuthorizer
s@TestInvokeAuthorizer' {} Maybe (HashMap Text Text)
a -> TestInvokeAuthorizer
s {$sel:additionalContext:TestInvokeAuthorizer' :: Maybe (HashMap Text Text)
additionalContext = Maybe (HashMap Text Text)
a} :: TestInvokeAuthorizer) 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 simulated request body of an incoming invocation request.
testInvokeAuthorizer_body :: Lens.Lens' TestInvokeAuthorizer (Prelude.Maybe Prelude.Text)
testInvokeAuthorizer_body :: Lens' TestInvokeAuthorizer (Maybe Text)
testInvokeAuthorizer_body = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizer' {Maybe Text
body :: Maybe Text
$sel:body:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
body} -> Maybe Text
body) (\s :: TestInvokeAuthorizer
s@TestInvokeAuthorizer' {} Maybe Text
a -> TestInvokeAuthorizer
s {$sel:body:TestInvokeAuthorizer' :: Maybe Text
body = Maybe Text
a} :: TestInvokeAuthorizer)

-- | A key-value map of headers to simulate an incoming invocation request.
-- This is where the incoming authorization token, or identity source,
-- should be specified.
testInvokeAuthorizer_headers :: Lens.Lens' TestInvokeAuthorizer (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
testInvokeAuthorizer_headers :: Lens' TestInvokeAuthorizer (Maybe (HashMap Text Text))
testInvokeAuthorizer_headers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizer' {Maybe (HashMap Text Text)
headers :: Maybe (HashMap Text Text)
$sel:headers:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
headers} -> Maybe (HashMap Text Text)
headers) (\s :: TestInvokeAuthorizer
s@TestInvokeAuthorizer' {} Maybe (HashMap Text Text)
a -> TestInvokeAuthorizer
s {$sel:headers:TestInvokeAuthorizer' :: Maybe (HashMap Text Text)
headers = Maybe (HashMap Text Text)
a} :: TestInvokeAuthorizer) 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 headers as a map from string to list of values to simulate an
-- incoming invocation request. This is where the incoming authorization
-- token, or identity source, may be specified.
testInvokeAuthorizer_multiValueHeaders :: Lens.Lens' TestInvokeAuthorizer (Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]))
testInvokeAuthorizer_multiValueHeaders :: Lens' TestInvokeAuthorizer (Maybe (HashMap Text [Text]))
testInvokeAuthorizer_multiValueHeaders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizer' {Maybe (HashMap Text [Text])
multiValueHeaders :: Maybe (HashMap Text [Text])
$sel:multiValueHeaders:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text [Text])
multiValueHeaders} -> Maybe (HashMap Text [Text])
multiValueHeaders) (\s :: TestInvokeAuthorizer
s@TestInvokeAuthorizer' {} Maybe (HashMap Text [Text])
a -> TestInvokeAuthorizer
s {$sel:multiValueHeaders:TestInvokeAuthorizer' :: Maybe (HashMap Text [Text])
multiValueHeaders = Maybe (HashMap Text [Text])
a} :: TestInvokeAuthorizer) 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 URI path, including query string, of the simulated invocation
-- request. Use this to specify path parameters and query string
-- parameters.
testInvokeAuthorizer_pathWithQueryString :: Lens.Lens' TestInvokeAuthorizer (Prelude.Maybe Prelude.Text)
testInvokeAuthorizer_pathWithQueryString :: Lens' TestInvokeAuthorizer (Maybe Text)
testInvokeAuthorizer_pathWithQueryString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizer' {Maybe Text
pathWithQueryString :: Maybe Text
$sel:pathWithQueryString:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
pathWithQueryString} -> Maybe Text
pathWithQueryString) (\s :: TestInvokeAuthorizer
s@TestInvokeAuthorizer' {} Maybe Text
a -> TestInvokeAuthorizer
s {$sel:pathWithQueryString:TestInvokeAuthorizer' :: Maybe Text
pathWithQueryString = Maybe Text
a} :: TestInvokeAuthorizer)

-- | A key-value map of stage variables to simulate an invocation on a
-- deployed Stage.
testInvokeAuthorizer_stageVariables :: Lens.Lens' TestInvokeAuthorizer (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
testInvokeAuthorizer_stageVariables :: Lens' TestInvokeAuthorizer (Maybe (HashMap Text Text))
testInvokeAuthorizer_stageVariables = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizer' {Maybe (HashMap Text Text)
stageVariables :: Maybe (HashMap Text Text)
$sel:stageVariables:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
stageVariables} -> Maybe (HashMap Text Text)
stageVariables) (\s :: TestInvokeAuthorizer
s@TestInvokeAuthorizer' {} Maybe (HashMap Text Text)
a -> TestInvokeAuthorizer
s {$sel:stageVariables:TestInvokeAuthorizer' :: Maybe (HashMap Text Text)
stageVariables = Maybe (HashMap Text Text)
a} :: TestInvokeAuthorizer) 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.
testInvokeAuthorizer_restApiId :: Lens.Lens' TestInvokeAuthorizer Prelude.Text
testInvokeAuthorizer_restApiId :: Lens' TestInvokeAuthorizer Text
testInvokeAuthorizer_restApiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizer' {Text
restApiId :: Text
$sel:restApiId:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
restApiId} -> Text
restApiId) (\s :: TestInvokeAuthorizer
s@TestInvokeAuthorizer' {} Text
a -> TestInvokeAuthorizer
s {$sel:restApiId:TestInvokeAuthorizer' :: Text
restApiId = Text
a} :: TestInvokeAuthorizer)

-- | Specifies a test invoke authorizer request\'s Authorizer ID.
testInvokeAuthorizer_authorizerId :: Lens.Lens' TestInvokeAuthorizer Prelude.Text
testInvokeAuthorizer_authorizerId :: Lens' TestInvokeAuthorizer Text
testInvokeAuthorizer_authorizerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizer' {Text
authorizerId :: Text
$sel:authorizerId:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
authorizerId} -> Text
authorizerId) (\s :: TestInvokeAuthorizer
s@TestInvokeAuthorizer' {} Text
a -> TestInvokeAuthorizer
s {$sel:authorizerId:TestInvokeAuthorizer' :: Text
authorizerId = Text
a} :: TestInvokeAuthorizer)

instance Core.AWSRequest TestInvokeAuthorizer where
  type
    AWSResponse TestInvokeAuthorizer =
      TestInvokeAuthorizerResponse
  request :: (Service -> Service)
-> TestInvokeAuthorizer -> Request TestInvokeAuthorizer
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 TestInvokeAuthorizer
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse TestInvokeAuthorizer)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe (HashMap Text [Text])
-> Maybe (HashMap Text Text)
-> Maybe Int
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> TestInvokeAuthorizerResponse
TestInvokeAuthorizerResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"authorization" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ 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 -> Either String (Maybe a)
Data..?> Key
"claims" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ 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 -> Either String (Maybe a)
Data..?> Key
"clientStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"latency")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"log")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"policy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"principalId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable TestInvokeAuthorizer where
  hashWithSalt :: Int -> TestInvokeAuthorizer -> Int
hashWithSalt Int
_salt TestInvokeAuthorizer' {Maybe Text
Maybe (HashMap Text [Text])
Maybe (HashMap Text Text)
Text
authorizerId :: Text
restApiId :: Text
stageVariables :: Maybe (HashMap Text Text)
pathWithQueryString :: Maybe Text
multiValueHeaders :: Maybe (HashMap Text [Text])
headers :: Maybe (HashMap Text Text)
body :: Maybe Text
additionalContext :: Maybe (HashMap Text Text)
$sel:authorizerId:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
$sel:restApiId:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
$sel:stageVariables:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
$sel:pathWithQueryString:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:multiValueHeaders:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text [Text])
$sel:headers:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
$sel:body:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:additionalContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
additionalContext
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
body
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
headers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text [Text])
multiValueHeaders
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pathWithQueryString
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
stageVariables
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
restApiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
authorizerId

instance Prelude.NFData TestInvokeAuthorizer where
  rnf :: TestInvokeAuthorizer -> ()
rnf TestInvokeAuthorizer' {Maybe Text
Maybe (HashMap Text [Text])
Maybe (HashMap Text Text)
Text
authorizerId :: Text
restApiId :: Text
stageVariables :: Maybe (HashMap Text Text)
pathWithQueryString :: Maybe Text
multiValueHeaders :: Maybe (HashMap Text [Text])
headers :: Maybe (HashMap Text Text)
body :: Maybe Text
additionalContext :: Maybe (HashMap Text Text)
$sel:authorizerId:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
$sel:restApiId:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
$sel:stageVariables:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
$sel:pathWithQueryString:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:multiValueHeaders:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text [Text])
$sel:headers:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
$sel:body:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:additionalContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
additionalContext
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
body
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
headers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text [Text])
multiValueHeaders
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pathWithQueryString
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
stageVariables
      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
authorizerId

instance Data.ToHeaders TestInvokeAuthorizer where
  toHeaders :: TestInvokeAuthorizer -> 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 TestInvokeAuthorizer where
  toJSON :: TestInvokeAuthorizer -> Value
toJSON TestInvokeAuthorizer' {Maybe Text
Maybe (HashMap Text [Text])
Maybe (HashMap Text Text)
Text
authorizerId :: Text
restApiId :: Text
stageVariables :: Maybe (HashMap Text Text)
pathWithQueryString :: Maybe Text
multiValueHeaders :: Maybe (HashMap Text [Text])
headers :: Maybe (HashMap Text Text)
body :: Maybe Text
additionalContext :: Maybe (HashMap Text Text)
$sel:authorizerId:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
$sel:restApiId:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
$sel:stageVariables:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
$sel:pathWithQueryString:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:multiValueHeaders:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text [Text])
$sel:headers:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
$sel:body:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:additionalContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"additionalContext" 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 (HashMap Text Text)
additionalContext,
            (Key
"body" 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
body,
            (Key
"headers" 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 (HashMap Text Text)
headers,
            (Key
"multiValueHeaders" 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 (HashMap Text [Text])
multiValueHeaders,
            (Key
"pathWithQueryString" 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
pathWithQueryString,
            (Key
"stageVariables" 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 (HashMap Text Text)
stageVariables
          ]
      )

instance Data.ToPath TestInvokeAuthorizer where
  toPath :: TestInvokeAuthorizer -> ByteString
toPath TestInvokeAuthorizer' {Maybe Text
Maybe (HashMap Text [Text])
Maybe (HashMap Text Text)
Text
authorizerId :: Text
restApiId :: Text
stageVariables :: Maybe (HashMap Text Text)
pathWithQueryString :: Maybe Text
multiValueHeaders :: Maybe (HashMap Text [Text])
headers :: Maybe (HashMap Text Text)
body :: Maybe Text
additionalContext :: Maybe (HashMap Text Text)
$sel:authorizerId:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
$sel:restApiId:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
$sel:stageVariables:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
$sel:pathWithQueryString:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:multiValueHeaders:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text [Text])
$sel:headers:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
$sel:body:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:additionalContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe (HashMap Text Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/restapis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
restApiId,
        ByteString
"/authorizers/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
authorizerId
      ]

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

-- | Represents the response of the test invoke request for a custom
-- Authorizer
--
-- /See:/ 'newTestInvokeAuthorizerResponse' smart constructor.
data TestInvokeAuthorizerResponse = TestInvokeAuthorizerResponse'
  { -- | The authorization response.
    TestInvokeAuthorizerResponse -> Maybe (HashMap Text [Text])
authorization :: Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]),
    -- | The open identity claims, with any supported custom attributes, returned
    -- from the Cognito Your User Pool configured for the API.
    TestInvokeAuthorizerResponse -> Maybe (HashMap Text Text)
claims :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The HTTP status code that the client would have received. Value is 0 if
    -- the authorizer succeeded.
    TestInvokeAuthorizerResponse -> Maybe Int
clientStatus :: Prelude.Maybe Prelude.Int,
    -- | The execution latency of the test authorizer request.
    TestInvokeAuthorizerResponse -> Maybe Integer
latency :: Prelude.Maybe Prelude.Integer,
    -- | The API Gateway execution log for the test authorizer request.
    TestInvokeAuthorizerResponse -> Maybe Text
log :: Prelude.Maybe Prelude.Text,
    -- | The JSON policy document returned by the Authorizer
    TestInvokeAuthorizerResponse -> Maybe Text
policy :: Prelude.Maybe Prelude.Text,
    -- | The principal identity returned by the Authorizer
    TestInvokeAuthorizerResponse -> Maybe Text
principalId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    TestInvokeAuthorizerResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (TestInvokeAuthorizerResponse
-> TestInvokeAuthorizerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestInvokeAuthorizerResponse
-> TestInvokeAuthorizerResponse -> Bool
$c/= :: TestInvokeAuthorizerResponse
-> TestInvokeAuthorizerResponse -> Bool
== :: TestInvokeAuthorizerResponse
-> TestInvokeAuthorizerResponse -> Bool
$c== :: TestInvokeAuthorizerResponse
-> TestInvokeAuthorizerResponse -> Bool
Prelude.Eq, ReadPrec [TestInvokeAuthorizerResponse]
ReadPrec TestInvokeAuthorizerResponse
Int -> ReadS TestInvokeAuthorizerResponse
ReadS [TestInvokeAuthorizerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestInvokeAuthorizerResponse]
$creadListPrec :: ReadPrec [TestInvokeAuthorizerResponse]
readPrec :: ReadPrec TestInvokeAuthorizerResponse
$creadPrec :: ReadPrec TestInvokeAuthorizerResponse
readList :: ReadS [TestInvokeAuthorizerResponse]
$creadList :: ReadS [TestInvokeAuthorizerResponse]
readsPrec :: Int -> ReadS TestInvokeAuthorizerResponse
$creadsPrec :: Int -> ReadS TestInvokeAuthorizerResponse
Prelude.Read, Int -> TestInvokeAuthorizerResponse -> ShowS
[TestInvokeAuthorizerResponse] -> ShowS
TestInvokeAuthorizerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestInvokeAuthorizerResponse] -> ShowS
$cshowList :: [TestInvokeAuthorizerResponse] -> ShowS
show :: TestInvokeAuthorizerResponse -> String
$cshow :: TestInvokeAuthorizerResponse -> String
showsPrec :: Int -> TestInvokeAuthorizerResponse -> ShowS
$cshowsPrec :: Int -> TestInvokeAuthorizerResponse -> ShowS
Prelude.Show, forall x.
Rep TestInvokeAuthorizerResponse x -> TestInvokeAuthorizerResponse
forall x.
TestInvokeAuthorizerResponse -> Rep TestInvokeAuthorizerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep TestInvokeAuthorizerResponse x -> TestInvokeAuthorizerResponse
$cfrom :: forall x.
TestInvokeAuthorizerResponse -> Rep TestInvokeAuthorizerResponse x
Prelude.Generic)

-- |
-- Create a value of 'TestInvokeAuthorizerResponse' 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:
--
-- 'authorization', 'testInvokeAuthorizerResponse_authorization' - The authorization response.
--
-- 'claims', 'testInvokeAuthorizerResponse_claims' - The open identity claims, with any supported custom attributes, returned
-- from the Cognito Your User Pool configured for the API.
--
-- 'clientStatus', 'testInvokeAuthorizerResponse_clientStatus' - The HTTP status code that the client would have received. Value is 0 if
-- the authorizer succeeded.
--
-- 'latency', 'testInvokeAuthorizerResponse_latency' - The execution latency of the test authorizer request.
--
-- 'log', 'testInvokeAuthorizerResponse_log' - The API Gateway execution log for the test authorizer request.
--
-- 'policy', 'testInvokeAuthorizerResponse_policy' - The JSON policy document returned by the Authorizer
--
-- 'principalId', 'testInvokeAuthorizerResponse_principalId' - The principal identity returned by the Authorizer
--
-- 'httpStatus', 'testInvokeAuthorizerResponse_httpStatus' - The response's http status code.
newTestInvokeAuthorizerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  TestInvokeAuthorizerResponse
newTestInvokeAuthorizerResponse :: Int -> TestInvokeAuthorizerResponse
newTestInvokeAuthorizerResponse Int
pHttpStatus_ =
  TestInvokeAuthorizerResponse'
    { $sel:authorization:TestInvokeAuthorizerResponse' :: Maybe (HashMap Text [Text])
authorization =
        forall a. Maybe a
Prelude.Nothing,
      $sel:claims:TestInvokeAuthorizerResponse' :: Maybe (HashMap Text Text)
claims = forall a. Maybe a
Prelude.Nothing,
      $sel:clientStatus:TestInvokeAuthorizerResponse' :: Maybe Int
clientStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:latency:TestInvokeAuthorizerResponse' :: Maybe Integer
latency = forall a. Maybe a
Prelude.Nothing,
      $sel:log:TestInvokeAuthorizerResponse' :: Maybe Text
log = forall a. Maybe a
Prelude.Nothing,
      $sel:policy:TestInvokeAuthorizerResponse' :: Maybe Text
policy = forall a. Maybe a
Prelude.Nothing,
      $sel:principalId:TestInvokeAuthorizerResponse' :: Maybe Text
principalId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:TestInvokeAuthorizerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The authorization response.
testInvokeAuthorizerResponse_authorization :: Lens.Lens' TestInvokeAuthorizerResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]))
testInvokeAuthorizerResponse_authorization :: Lens' TestInvokeAuthorizerResponse (Maybe (HashMap Text [Text]))
testInvokeAuthorizerResponse_authorization = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizerResponse' {Maybe (HashMap Text [Text])
authorization :: Maybe (HashMap Text [Text])
$sel:authorization:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe (HashMap Text [Text])
authorization} -> Maybe (HashMap Text [Text])
authorization) (\s :: TestInvokeAuthorizerResponse
s@TestInvokeAuthorizerResponse' {} Maybe (HashMap Text [Text])
a -> TestInvokeAuthorizerResponse
s {$sel:authorization:TestInvokeAuthorizerResponse' :: Maybe (HashMap Text [Text])
authorization = Maybe (HashMap Text [Text])
a} :: TestInvokeAuthorizerResponse) 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 open identity claims, with any supported custom attributes, returned
-- from the Cognito Your User Pool configured for the API.
testInvokeAuthorizerResponse_claims :: Lens.Lens' TestInvokeAuthorizerResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
testInvokeAuthorizerResponse_claims :: Lens' TestInvokeAuthorizerResponse (Maybe (HashMap Text Text))
testInvokeAuthorizerResponse_claims = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizerResponse' {Maybe (HashMap Text Text)
claims :: Maybe (HashMap Text Text)
$sel:claims:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe (HashMap Text Text)
claims} -> Maybe (HashMap Text Text)
claims) (\s :: TestInvokeAuthorizerResponse
s@TestInvokeAuthorizerResponse' {} Maybe (HashMap Text Text)
a -> TestInvokeAuthorizerResponse
s {$sel:claims:TestInvokeAuthorizerResponse' :: Maybe (HashMap Text Text)
claims = Maybe (HashMap Text Text)
a} :: TestInvokeAuthorizerResponse) 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 HTTP status code that the client would have received. Value is 0 if
-- the authorizer succeeded.
testInvokeAuthorizerResponse_clientStatus :: Lens.Lens' TestInvokeAuthorizerResponse (Prelude.Maybe Prelude.Int)
testInvokeAuthorizerResponse_clientStatus :: Lens' TestInvokeAuthorizerResponse (Maybe Int)
testInvokeAuthorizerResponse_clientStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizerResponse' {Maybe Int
clientStatus :: Maybe Int
$sel:clientStatus:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Int
clientStatus} -> Maybe Int
clientStatus) (\s :: TestInvokeAuthorizerResponse
s@TestInvokeAuthorizerResponse' {} Maybe Int
a -> TestInvokeAuthorizerResponse
s {$sel:clientStatus:TestInvokeAuthorizerResponse' :: Maybe Int
clientStatus = Maybe Int
a} :: TestInvokeAuthorizerResponse)

-- | The execution latency of the test authorizer request.
testInvokeAuthorizerResponse_latency :: Lens.Lens' TestInvokeAuthorizerResponse (Prelude.Maybe Prelude.Integer)
testInvokeAuthorizerResponse_latency :: Lens' TestInvokeAuthorizerResponse (Maybe Integer)
testInvokeAuthorizerResponse_latency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizerResponse' {Maybe Integer
latency :: Maybe Integer
$sel:latency:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Integer
latency} -> Maybe Integer
latency) (\s :: TestInvokeAuthorizerResponse
s@TestInvokeAuthorizerResponse' {} Maybe Integer
a -> TestInvokeAuthorizerResponse
s {$sel:latency:TestInvokeAuthorizerResponse' :: Maybe Integer
latency = Maybe Integer
a} :: TestInvokeAuthorizerResponse)

-- | The API Gateway execution log for the test authorizer request.
testInvokeAuthorizerResponse_log :: Lens.Lens' TestInvokeAuthorizerResponse (Prelude.Maybe Prelude.Text)
testInvokeAuthorizerResponse_log :: Lens' TestInvokeAuthorizerResponse (Maybe Text)
testInvokeAuthorizerResponse_log = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizerResponse' {Maybe Text
log :: Maybe Text
$sel:log:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Text
log} -> Maybe Text
log) (\s :: TestInvokeAuthorizerResponse
s@TestInvokeAuthorizerResponse' {} Maybe Text
a -> TestInvokeAuthorizerResponse
s {$sel:log:TestInvokeAuthorizerResponse' :: Maybe Text
log = Maybe Text
a} :: TestInvokeAuthorizerResponse)

-- | The JSON policy document returned by the Authorizer
testInvokeAuthorizerResponse_policy :: Lens.Lens' TestInvokeAuthorizerResponse (Prelude.Maybe Prelude.Text)
testInvokeAuthorizerResponse_policy :: Lens' TestInvokeAuthorizerResponse (Maybe Text)
testInvokeAuthorizerResponse_policy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizerResponse' {Maybe Text
policy :: Maybe Text
$sel:policy:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Text
policy} -> Maybe Text
policy) (\s :: TestInvokeAuthorizerResponse
s@TestInvokeAuthorizerResponse' {} Maybe Text
a -> TestInvokeAuthorizerResponse
s {$sel:policy:TestInvokeAuthorizerResponse' :: Maybe Text
policy = Maybe Text
a} :: TestInvokeAuthorizerResponse)

-- | The principal identity returned by the Authorizer
testInvokeAuthorizerResponse_principalId :: Lens.Lens' TestInvokeAuthorizerResponse (Prelude.Maybe Prelude.Text)
testInvokeAuthorizerResponse_principalId :: Lens' TestInvokeAuthorizerResponse (Maybe Text)
testInvokeAuthorizerResponse_principalId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizerResponse' {Maybe Text
principalId :: Maybe Text
$sel:principalId:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Text
principalId} -> Maybe Text
principalId) (\s :: TestInvokeAuthorizerResponse
s@TestInvokeAuthorizerResponse' {} Maybe Text
a -> TestInvokeAuthorizerResponse
s {$sel:principalId:TestInvokeAuthorizerResponse' :: Maybe Text
principalId = Maybe Text
a} :: TestInvokeAuthorizerResponse)

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

instance Prelude.NFData TestInvokeAuthorizerResponse where
  rnf :: TestInvokeAuthorizerResponse -> ()
rnf TestInvokeAuthorizerResponse' {Int
Maybe Int
Maybe Integer
Maybe Text
Maybe (HashMap Text [Text])
Maybe (HashMap Text Text)
httpStatus :: Int
principalId :: Maybe Text
policy :: Maybe Text
log :: Maybe Text
latency :: Maybe Integer
clientStatus :: Maybe Int
claims :: Maybe (HashMap Text Text)
authorization :: Maybe (HashMap Text [Text])
$sel:httpStatus:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Int
$sel:principalId:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Text
$sel:policy:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Text
$sel:log:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Text
$sel:latency:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Integer
$sel:clientStatus:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Int
$sel:claims:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe (HashMap Text Text)
$sel:authorization:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe (HashMap Text [Text])
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text [Text])
authorization
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
claims
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
clientStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
latency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
log
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
policy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
principalId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus