{-# 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.IoT.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)
--
-- Tests a custom authorization behavior by invoking a specified custom
-- authorizer. Use this to test and debug the custom authorization behavior
-- of devices that connect to the IoT device gateway.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions TestInvokeAuthorizer>
-- action.
module Amazonka.IoT.TestInvokeAuthorizer
  ( -- * Creating a Request
    TestInvokeAuthorizer (..),
    newTestInvokeAuthorizer,

    -- * Request Lenses
    testInvokeAuthorizer_httpContext,
    testInvokeAuthorizer_mqttContext,
    testInvokeAuthorizer_tlsContext,
    testInvokeAuthorizer_token,
    testInvokeAuthorizer_tokenSignature,
    testInvokeAuthorizer_authorizerName,

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

    -- * Response Lenses
    testInvokeAuthorizerResponse_disconnectAfterInSeconds,
    testInvokeAuthorizerResponse_isAuthenticated,
    testInvokeAuthorizerResponse_policyDocuments,
    testInvokeAuthorizerResponse_principalId,
    testInvokeAuthorizerResponse_refreshAfterInSeconds,
    testInvokeAuthorizerResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoT.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newTestInvokeAuthorizer' smart constructor.
data TestInvokeAuthorizer = TestInvokeAuthorizer'
  { -- | Specifies a test HTTP authorization request.
    TestInvokeAuthorizer -> Maybe HttpContext
httpContext :: Prelude.Maybe HttpContext,
    -- | Specifies a test MQTT authorization request.
    TestInvokeAuthorizer -> Maybe MqttContext
mqttContext :: Prelude.Maybe MqttContext,
    -- | Specifies a test TLS authorization request.
    TestInvokeAuthorizer -> Maybe TlsContext
tlsContext :: Prelude.Maybe TlsContext,
    -- | The token returned by your custom authentication service.
    TestInvokeAuthorizer -> Maybe Text
token :: Prelude.Maybe Prelude.Text,
    -- | The signature made with the token and your custom authentication
    -- service\'s private key. This value must be Base-64-encoded.
    TestInvokeAuthorizer -> Maybe Text
tokenSignature :: Prelude.Maybe Prelude.Text,
    -- | The custom authorizer name.
    TestInvokeAuthorizer -> Text
authorizerName :: 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:
--
-- 'httpContext', 'testInvokeAuthorizer_httpContext' - Specifies a test HTTP authorization request.
--
-- 'mqttContext', 'testInvokeAuthorizer_mqttContext' - Specifies a test MQTT authorization request.
--
-- 'tlsContext', 'testInvokeAuthorizer_tlsContext' - Specifies a test TLS authorization request.
--
-- 'token', 'testInvokeAuthorizer_token' - The token returned by your custom authentication service.
--
-- 'tokenSignature', 'testInvokeAuthorizer_tokenSignature' - The signature made with the token and your custom authentication
-- service\'s private key. This value must be Base-64-encoded.
--
-- 'authorizerName', 'testInvokeAuthorizer_authorizerName' - The custom authorizer name.
newTestInvokeAuthorizer ::
  -- | 'authorizerName'
  Prelude.Text ->
  TestInvokeAuthorizer
newTestInvokeAuthorizer :: Text -> TestInvokeAuthorizer
newTestInvokeAuthorizer Text
pAuthorizerName_ =
  TestInvokeAuthorizer'
    { $sel:httpContext:TestInvokeAuthorizer' :: Maybe HttpContext
httpContext =
        forall a. Maybe a
Prelude.Nothing,
      $sel:mqttContext:TestInvokeAuthorizer' :: Maybe MqttContext
mqttContext = forall a. Maybe a
Prelude.Nothing,
      $sel:tlsContext:TestInvokeAuthorizer' :: Maybe TlsContext
tlsContext = forall a. Maybe a
Prelude.Nothing,
      $sel:token:TestInvokeAuthorizer' :: Maybe Text
token = forall a. Maybe a
Prelude.Nothing,
      $sel:tokenSignature:TestInvokeAuthorizer' :: Maybe Text
tokenSignature = forall a. Maybe a
Prelude.Nothing,
      $sel:authorizerName:TestInvokeAuthorizer' :: Text
authorizerName = Text
pAuthorizerName_
    }

-- | Specifies a test HTTP authorization request.
testInvokeAuthorizer_httpContext :: Lens.Lens' TestInvokeAuthorizer (Prelude.Maybe HttpContext)
testInvokeAuthorizer_httpContext :: Lens' TestInvokeAuthorizer (Maybe HttpContext)
testInvokeAuthorizer_httpContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizer' {Maybe HttpContext
httpContext :: Maybe HttpContext
$sel:httpContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe HttpContext
httpContext} -> Maybe HttpContext
httpContext) (\s :: TestInvokeAuthorizer
s@TestInvokeAuthorizer' {} Maybe HttpContext
a -> TestInvokeAuthorizer
s {$sel:httpContext:TestInvokeAuthorizer' :: Maybe HttpContext
httpContext = Maybe HttpContext
a} :: TestInvokeAuthorizer)

-- | Specifies a test MQTT authorization request.
testInvokeAuthorizer_mqttContext :: Lens.Lens' TestInvokeAuthorizer (Prelude.Maybe MqttContext)
testInvokeAuthorizer_mqttContext :: Lens' TestInvokeAuthorizer (Maybe MqttContext)
testInvokeAuthorizer_mqttContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizer' {Maybe MqttContext
mqttContext :: Maybe MqttContext
$sel:mqttContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe MqttContext
mqttContext} -> Maybe MqttContext
mqttContext) (\s :: TestInvokeAuthorizer
s@TestInvokeAuthorizer' {} Maybe MqttContext
a -> TestInvokeAuthorizer
s {$sel:mqttContext:TestInvokeAuthorizer' :: Maybe MqttContext
mqttContext = Maybe MqttContext
a} :: TestInvokeAuthorizer)

-- | Specifies a test TLS authorization request.
testInvokeAuthorizer_tlsContext :: Lens.Lens' TestInvokeAuthorizer (Prelude.Maybe TlsContext)
testInvokeAuthorizer_tlsContext :: Lens' TestInvokeAuthorizer (Maybe TlsContext)
testInvokeAuthorizer_tlsContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizer' {Maybe TlsContext
tlsContext :: Maybe TlsContext
$sel:tlsContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe TlsContext
tlsContext} -> Maybe TlsContext
tlsContext) (\s :: TestInvokeAuthorizer
s@TestInvokeAuthorizer' {} Maybe TlsContext
a -> TestInvokeAuthorizer
s {$sel:tlsContext:TestInvokeAuthorizer' :: Maybe TlsContext
tlsContext = Maybe TlsContext
a} :: TestInvokeAuthorizer)

-- | The token returned by your custom authentication service.
testInvokeAuthorizer_token :: Lens.Lens' TestInvokeAuthorizer (Prelude.Maybe Prelude.Text)
testInvokeAuthorizer_token :: Lens' TestInvokeAuthorizer (Maybe Text)
testInvokeAuthorizer_token = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizer' {Maybe Text
token :: Maybe Text
$sel:token:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
token} -> Maybe Text
token) (\s :: TestInvokeAuthorizer
s@TestInvokeAuthorizer' {} Maybe Text
a -> TestInvokeAuthorizer
s {$sel:token:TestInvokeAuthorizer' :: Maybe Text
token = Maybe Text
a} :: TestInvokeAuthorizer)

-- | The signature made with the token and your custom authentication
-- service\'s private key. This value must be Base-64-encoded.
testInvokeAuthorizer_tokenSignature :: Lens.Lens' TestInvokeAuthorizer (Prelude.Maybe Prelude.Text)
testInvokeAuthorizer_tokenSignature :: Lens' TestInvokeAuthorizer (Maybe Text)
testInvokeAuthorizer_tokenSignature = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizer' {Maybe Text
tokenSignature :: Maybe Text
$sel:tokenSignature:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
tokenSignature} -> Maybe Text
tokenSignature) (\s :: TestInvokeAuthorizer
s@TestInvokeAuthorizer' {} Maybe Text
a -> TestInvokeAuthorizer
s {$sel:tokenSignature:TestInvokeAuthorizer' :: Maybe Text
tokenSignature = Maybe Text
a} :: TestInvokeAuthorizer)

-- | The custom authorizer name.
testInvokeAuthorizer_authorizerName :: Lens.Lens' TestInvokeAuthorizer Prelude.Text
testInvokeAuthorizer_authorizerName :: Lens' TestInvokeAuthorizer Text
testInvokeAuthorizer_authorizerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizer' {Text
authorizerName :: Text
$sel:authorizerName:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
authorizerName} -> Text
authorizerName) (\s :: TestInvokeAuthorizer
s@TestInvokeAuthorizer' {} Text
a -> TestInvokeAuthorizer
s {$sel:authorizerName:TestInvokeAuthorizer' :: Text
authorizerName = 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 Int
-> Maybe Bool
-> Maybe [Text]
-> Maybe Text
-> Maybe Int
-> 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
"disconnectAfterInSeconds")
            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
"isAuthenticated")
            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
"policyDocuments"
                            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
"principalId")
            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
"refreshAfterInSeconds")
            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 HttpContext
Maybe MqttContext
Maybe TlsContext
Text
authorizerName :: Text
tokenSignature :: Maybe Text
token :: Maybe Text
tlsContext :: Maybe TlsContext
mqttContext :: Maybe MqttContext
httpContext :: Maybe HttpContext
$sel:authorizerName:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
$sel:tokenSignature:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:token:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:tlsContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe TlsContext
$sel:mqttContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe MqttContext
$sel:httpContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe HttpContext
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HttpContext
httpContext
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MqttContext
mqttContext
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TlsContext
tlsContext
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
token
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
tokenSignature
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
authorizerName

instance Prelude.NFData TestInvokeAuthorizer where
  rnf :: TestInvokeAuthorizer -> ()
rnf TestInvokeAuthorizer' {Maybe Text
Maybe HttpContext
Maybe MqttContext
Maybe TlsContext
Text
authorizerName :: Text
tokenSignature :: Maybe Text
token :: Maybe Text
tlsContext :: Maybe TlsContext
mqttContext :: Maybe MqttContext
httpContext :: Maybe HttpContext
$sel:authorizerName:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
$sel:tokenSignature:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:token:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:tlsContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe TlsContext
$sel:mqttContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe MqttContext
$sel:httpContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe HttpContext
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe HttpContext
httpContext
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MqttContext
mqttContext
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TlsContext
tlsContext
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
token
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
tokenSignature
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
authorizerName

instance Data.ToHeaders TestInvokeAuthorizer where
  toHeaders :: TestInvokeAuthorizer -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON TestInvokeAuthorizer where
  toJSON :: TestInvokeAuthorizer -> Value
toJSON TestInvokeAuthorizer' {Maybe Text
Maybe HttpContext
Maybe MqttContext
Maybe TlsContext
Text
authorizerName :: Text
tokenSignature :: Maybe Text
token :: Maybe Text
tlsContext :: Maybe TlsContext
mqttContext :: Maybe MqttContext
httpContext :: Maybe HttpContext
$sel:authorizerName:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
$sel:tokenSignature:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:token:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:tlsContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe TlsContext
$sel:mqttContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe MqttContext
$sel:httpContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe HttpContext
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"httpContext" 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 HttpContext
httpContext,
            (Key
"mqttContext" 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 MqttContext
mqttContext,
            (Key
"tlsContext" 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 TlsContext
tlsContext,
            (Key
"token" 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
token,
            (Key
"tokenSignature" 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
tokenSignature
          ]
      )

instance Data.ToPath TestInvokeAuthorizer where
  toPath :: TestInvokeAuthorizer -> ByteString
toPath TestInvokeAuthorizer' {Maybe Text
Maybe HttpContext
Maybe MqttContext
Maybe TlsContext
Text
authorizerName :: Text
tokenSignature :: Maybe Text
token :: Maybe Text
tlsContext :: Maybe TlsContext
mqttContext :: Maybe MqttContext
httpContext :: Maybe HttpContext
$sel:authorizerName:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Text
$sel:tokenSignature:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:token:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe Text
$sel:tlsContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe TlsContext
$sel:mqttContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe MqttContext
$sel:httpContext:TestInvokeAuthorizer' :: TestInvokeAuthorizer -> Maybe HttpContext
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/authorizer/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
authorizerName, ByteString
"/test"]

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

-- | /See:/ 'newTestInvokeAuthorizerResponse' smart constructor.
data TestInvokeAuthorizerResponse = TestInvokeAuthorizerResponse'
  { -- | The number of seconds after which the connection is terminated.
    TestInvokeAuthorizerResponse -> Maybe Int
disconnectAfterInSeconds :: Prelude.Maybe Prelude.Int,
    -- | True if the token is authenticated, otherwise false.
    TestInvokeAuthorizerResponse -> Maybe Bool
isAuthenticated :: Prelude.Maybe Prelude.Bool,
    -- | IAM policy documents.
    TestInvokeAuthorizerResponse -> Maybe [Text]
policyDocuments :: Prelude.Maybe [Prelude.Text],
    -- | The principal ID.
    TestInvokeAuthorizerResponse -> Maybe Text
principalId :: Prelude.Maybe Prelude.Text,
    -- | The number of seconds after which the temporary credentials are
    -- refreshed.
    TestInvokeAuthorizerResponse -> Maybe Int
refreshAfterInSeconds :: Prelude.Maybe Prelude.Int,
    -- | 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:
--
-- 'disconnectAfterInSeconds', 'testInvokeAuthorizerResponse_disconnectAfterInSeconds' - The number of seconds after which the connection is terminated.
--
-- 'isAuthenticated', 'testInvokeAuthorizerResponse_isAuthenticated' - True if the token is authenticated, otherwise false.
--
-- 'policyDocuments', 'testInvokeAuthorizerResponse_policyDocuments' - IAM policy documents.
--
-- 'principalId', 'testInvokeAuthorizerResponse_principalId' - The principal ID.
--
-- 'refreshAfterInSeconds', 'testInvokeAuthorizerResponse_refreshAfterInSeconds' - The number of seconds after which the temporary credentials are
-- refreshed.
--
-- 'httpStatus', 'testInvokeAuthorizerResponse_httpStatus' - The response's http status code.
newTestInvokeAuthorizerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  TestInvokeAuthorizerResponse
newTestInvokeAuthorizerResponse :: Int -> TestInvokeAuthorizerResponse
newTestInvokeAuthorizerResponse Int
pHttpStatus_ =
  TestInvokeAuthorizerResponse'
    { $sel:disconnectAfterInSeconds:TestInvokeAuthorizerResponse' :: Maybe Int
disconnectAfterInSeconds =
        forall a. Maybe a
Prelude.Nothing,
      $sel:isAuthenticated:TestInvokeAuthorizerResponse' :: Maybe Bool
isAuthenticated = forall a. Maybe a
Prelude.Nothing,
      $sel:policyDocuments:TestInvokeAuthorizerResponse' :: Maybe [Text]
policyDocuments = forall a. Maybe a
Prelude.Nothing,
      $sel:principalId:TestInvokeAuthorizerResponse' :: Maybe Text
principalId = forall a. Maybe a
Prelude.Nothing,
      $sel:refreshAfterInSeconds:TestInvokeAuthorizerResponse' :: Maybe Int
refreshAfterInSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:TestInvokeAuthorizerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The number of seconds after which the connection is terminated.
testInvokeAuthorizerResponse_disconnectAfterInSeconds :: Lens.Lens' TestInvokeAuthorizerResponse (Prelude.Maybe Prelude.Int)
testInvokeAuthorizerResponse_disconnectAfterInSeconds :: Lens' TestInvokeAuthorizerResponse (Maybe Int)
testInvokeAuthorizerResponse_disconnectAfterInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizerResponse' {Maybe Int
disconnectAfterInSeconds :: Maybe Int
$sel:disconnectAfterInSeconds:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Int
disconnectAfterInSeconds} -> Maybe Int
disconnectAfterInSeconds) (\s :: TestInvokeAuthorizerResponse
s@TestInvokeAuthorizerResponse' {} Maybe Int
a -> TestInvokeAuthorizerResponse
s {$sel:disconnectAfterInSeconds:TestInvokeAuthorizerResponse' :: Maybe Int
disconnectAfterInSeconds = Maybe Int
a} :: TestInvokeAuthorizerResponse)

-- | True if the token is authenticated, otherwise false.
testInvokeAuthorizerResponse_isAuthenticated :: Lens.Lens' TestInvokeAuthorizerResponse (Prelude.Maybe Prelude.Bool)
testInvokeAuthorizerResponse_isAuthenticated :: Lens' TestInvokeAuthorizerResponse (Maybe Bool)
testInvokeAuthorizerResponse_isAuthenticated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizerResponse' {Maybe Bool
isAuthenticated :: Maybe Bool
$sel:isAuthenticated:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Bool
isAuthenticated} -> Maybe Bool
isAuthenticated) (\s :: TestInvokeAuthorizerResponse
s@TestInvokeAuthorizerResponse' {} Maybe Bool
a -> TestInvokeAuthorizerResponse
s {$sel:isAuthenticated:TestInvokeAuthorizerResponse' :: Maybe Bool
isAuthenticated = Maybe Bool
a} :: TestInvokeAuthorizerResponse)

-- | IAM policy documents.
testInvokeAuthorizerResponse_policyDocuments :: Lens.Lens' TestInvokeAuthorizerResponse (Prelude.Maybe [Prelude.Text])
testInvokeAuthorizerResponse_policyDocuments :: Lens' TestInvokeAuthorizerResponse (Maybe [Text])
testInvokeAuthorizerResponse_policyDocuments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizerResponse' {Maybe [Text]
policyDocuments :: Maybe [Text]
$sel:policyDocuments:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe [Text]
policyDocuments} -> Maybe [Text]
policyDocuments) (\s :: TestInvokeAuthorizerResponse
s@TestInvokeAuthorizerResponse' {} Maybe [Text]
a -> TestInvokeAuthorizerResponse
s {$sel:policyDocuments:TestInvokeAuthorizerResponse' :: Maybe [Text]
policyDocuments = Maybe [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 principal ID.
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 number of seconds after which the temporary credentials are
-- refreshed.
testInvokeAuthorizerResponse_refreshAfterInSeconds :: Lens.Lens' TestInvokeAuthorizerResponse (Prelude.Maybe Prelude.Int)
testInvokeAuthorizerResponse_refreshAfterInSeconds :: Lens' TestInvokeAuthorizerResponse (Maybe Int)
testInvokeAuthorizerResponse_refreshAfterInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeAuthorizerResponse' {Maybe Int
refreshAfterInSeconds :: Maybe Int
$sel:refreshAfterInSeconds:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Int
refreshAfterInSeconds} -> Maybe Int
refreshAfterInSeconds) (\s :: TestInvokeAuthorizerResponse
s@TestInvokeAuthorizerResponse' {} Maybe Int
a -> TestInvokeAuthorizerResponse
s {$sel:refreshAfterInSeconds:TestInvokeAuthorizerResponse' :: Maybe Int
refreshAfterInSeconds = Maybe Int
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 Bool
Maybe Int
Maybe [Text]
Maybe Text
httpStatus :: Int
refreshAfterInSeconds :: Maybe Int
principalId :: Maybe Text
policyDocuments :: Maybe [Text]
isAuthenticated :: Maybe Bool
disconnectAfterInSeconds :: Maybe Int
$sel:httpStatus:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Int
$sel:refreshAfterInSeconds:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Int
$sel:principalId:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Text
$sel:policyDocuments:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe [Text]
$sel:isAuthenticated:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Bool
$sel:disconnectAfterInSeconds:TestInvokeAuthorizerResponse' :: TestInvokeAuthorizerResponse -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
disconnectAfterInSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isAuthenticated
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
policyDocuments
      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 Maybe Int
refreshAfterInSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus