{-# 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.TestInvokeMethod
-- 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 invocation of a Method in your RestApi with headers,
-- parameters, and an incoming request body.
module Amazonka.APIGateway.TestInvokeMethod
  ( -- * Creating a Request
    TestInvokeMethod (..),
    newTestInvokeMethod,

    -- * Request Lenses
    testInvokeMethod_body,
    testInvokeMethod_clientCertificateId,
    testInvokeMethod_headers,
    testInvokeMethod_multiValueHeaders,
    testInvokeMethod_pathWithQueryString,
    testInvokeMethod_stageVariables,
    testInvokeMethod_restApiId,
    testInvokeMethod_resourceId,
    testInvokeMethod_httpMethod,

    -- * Destructuring the Response
    TestInvokeMethodResponse (..),
    newTestInvokeMethodResponse,

    -- * Response Lenses
    testInvokeMethodResponse_body,
    testInvokeMethodResponse_headers,
    testInvokeMethodResponse_latency,
    testInvokeMethodResponse_log,
    testInvokeMethodResponse_multiValueHeaders,
    testInvokeMethodResponse_status,
    testInvokeMethodResponse_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 a Method.
--
-- /See:/ 'newTestInvokeMethod' smart constructor.
data TestInvokeMethod = TestInvokeMethod'
  { -- | The simulated request body of an incoming invocation request.
    TestInvokeMethod -> Maybe Text
body :: Prelude.Maybe Prelude.Text,
    -- | A ClientCertificate identifier to use in the test invocation. API
    -- Gateway will use the certificate when making the HTTPS request to the
    -- defined back-end endpoint.
    TestInvokeMethod -> Maybe Text
clientCertificateId :: Prelude.Maybe Prelude.Text,
    -- | A key-value map of headers to simulate an incoming invocation request.
    TestInvokeMethod -> 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.
    TestInvokeMethod -> 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.
    TestInvokeMethod -> Maybe Text
pathWithQueryString :: Prelude.Maybe Prelude.Text,
    -- | A key-value map of stage variables to simulate an invocation on a
    -- deployed Stage.
    TestInvokeMethod -> Maybe (HashMap Text Text)
stageVariables :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The string identifier of the associated RestApi.
    TestInvokeMethod -> Text
restApiId :: Prelude.Text,
    -- | Specifies a test invoke method request\'s resource ID.
    TestInvokeMethod -> Text
resourceId :: Prelude.Text,
    -- | Specifies a test invoke method request\'s HTTP method.
    TestInvokeMethod -> Text
httpMethod :: Prelude.Text
  }
  deriving (TestInvokeMethod -> TestInvokeMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestInvokeMethod -> TestInvokeMethod -> Bool
$c/= :: TestInvokeMethod -> TestInvokeMethod -> Bool
== :: TestInvokeMethod -> TestInvokeMethod -> Bool
$c== :: TestInvokeMethod -> TestInvokeMethod -> Bool
Prelude.Eq, ReadPrec [TestInvokeMethod]
ReadPrec TestInvokeMethod
Int -> ReadS TestInvokeMethod
ReadS [TestInvokeMethod]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestInvokeMethod]
$creadListPrec :: ReadPrec [TestInvokeMethod]
readPrec :: ReadPrec TestInvokeMethod
$creadPrec :: ReadPrec TestInvokeMethod
readList :: ReadS [TestInvokeMethod]
$creadList :: ReadS [TestInvokeMethod]
readsPrec :: Int -> ReadS TestInvokeMethod
$creadsPrec :: Int -> ReadS TestInvokeMethod
Prelude.Read, Int -> TestInvokeMethod -> ShowS
[TestInvokeMethod] -> ShowS
TestInvokeMethod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestInvokeMethod] -> ShowS
$cshowList :: [TestInvokeMethod] -> ShowS
show :: TestInvokeMethod -> String
$cshow :: TestInvokeMethod -> String
showsPrec :: Int -> TestInvokeMethod -> ShowS
$cshowsPrec :: Int -> TestInvokeMethod -> ShowS
Prelude.Show, forall x. Rep TestInvokeMethod x -> TestInvokeMethod
forall x. TestInvokeMethod -> Rep TestInvokeMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestInvokeMethod x -> TestInvokeMethod
$cfrom :: forall x. TestInvokeMethod -> Rep TestInvokeMethod x
Prelude.Generic)

-- |
-- Create a value of 'TestInvokeMethod' 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:
--
-- 'body', 'testInvokeMethod_body' - The simulated request body of an incoming invocation request.
--
-- 'clientCertificateId', 'testInvokeMethod_clientCertificateId' - A ClientCertificate identifier to use in the test invocation. API
-- Gateway will use the certificate when making the HTTPS request to the
-- defined back-end endpoint.
--
-- 'headers', 'testInvokeMethod_headers' - A key-value map of headers to simulate an incoming invocation request.
--
-- 'multiValueHeaders', 'testInvokeMethod_multiValueHeaders' - The headers as a map from string to list of values to simulate an
-- incoming invocation request.
--
-- 'pathWithQueryString', 'testInvokeMethod_pathWithQueryString' - The URI path, including query string, of the simulated invocation
-- request. Use this to specify path parameters and query string
-- parameters.
--
-- 'stageVariables', 'testInvokeMethod_stageVariables' - A key-value map of stage variables to simulate an invocation on a
-- deployed Stage.
--
-- 'restApiId', 'testInvokeMethod_restApiId' - The string identifier of the associated RestApi.
--
-- 'resourceId', 'testInvokeMethod_resourceId' - Specifies a test invoke method request\'s resource ID.
--
-- 'httpMethod', 'testInvokeMethod_httpMethod' - Specifies a test invoke method request\'s HTTP method.
newTestInvokeMethod ::
  -- | 'restApiId'
  Prelude.Text ->
  -- | 'resourceId'
  Prelude.Text ->
  -- | 'httpMethod'
  Prelude.Text ->
  TestInvokeMethod
newTestInvokeMethod :: Text -> Text -> Text -> TestInvokeMethod
newTestInvokeMethod
  Text
pRestApiId_
  Text
pResourceId_
  Text
pHttpMethod_ =
    TestInvokeMethod'
      { $sel:body:TestInvokeMethod' :: Maybe Text
body = forall a. Maybe a
Prelude.Nothing,
        $sel:clientCertificateId:TestInvokeMethod' :: Maybe Text
clientCertificateId = forall a. Maybe a
Prelude.Nothing,
        $sel:headers:TestInvokeMethod' :: Maybe (HashMap Text Text)
headers = forall a. Maybe a
Prelude.Nothing,
        $sel:multiValueHeaders:TestInvokeMethod' :: Maybe (HashMap Text [Text])
multiValueHeaders = forall a. Maybe a
Prelude.Nothing,
        $sel:pathWithQueryString:TestInvokeMethod' :: Maybe Text
pathWithQueryString = forall a. Maybe a
Prelude.Nothing,
        $sel:stageVariables:TestInvokeMethod' :: Maybe (HashMap Text Text)
stageVariables = forall a. Maybe a
Prelude.Nothing,
        $sel:restApiId:TestInvokeMethod' :: Text
restApiId = Text
pRestApiId_,
        $sel:resourceId:TestInvokeMethod' :: Text
resourceId = Text
pResourceId_,
        $sel:httpMethod:TestInvokeMethod' :: Text
httpMethod = Text
pHttpMethod_
      }

-- | The simulated request body of an incoming invocation request.
testInvokeMethod_body :: Lens.Lens' TestInvokeMethod (Prelude.Maybe Prelude.Text)
testInvokeMethod_body :: Lens' TestInvokeMethod (Maybe Text)
testInvokeMethod_body = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeMethod' {Maybe Text
body :: Maybe Text
$sel:body:TestInvokeMethod' :: TestInvokeMethod -> Maybe Text
body} -> Maybe Text
body) (\s :: TestInvokeMethod
s@TestInvokeMethod' {} Maybe Text
a -> TestInvokeMethod
s {$sel:body:TestInvokeMethod' :: Maybe Text
body = Maybe Text
a} :: TestInvokeMethod)

-- | A ClientCertificate identifier to use in the test invocation. API
-- Gateway will use the certificate when making the HTTPS request to the
-- defined back-end endpoint.
testInvokeMethod_clientCertificateId :: Lens.Lens' TestInvokeMethod (Prelude.Maybe Prelude.Text)
testInvokeMethod_clientCertificateId :: Lens' TestInvokeMethod (Maybe Text)
testInvokeMethod_clientCertificateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeMethod' {Maybe Text
clientCertificateId :: Maybe Text
$sel:clientCertificateId:TestInvokeMethod' :: TestInvokeMethod -> Maybe Text
clientCertificateId} -> Maybe Text
clientCertificateId) (\s :: TestInvokeMethod
s@TestInvokeMethod' {} Maybe Text
a -> TestInvokeMethod
s {$sel:clientCertificateId:TestInvokeMethod' :: Maybe Text
clientCertificateId = Maybe Text
a} :: TestInvokeMethod)

-- | A key-value map of headers to simulate an incoming invocation request.
testInvokeMethod_headers :: Lens.Lens' TestInvokeMethod (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
testInvokeMethod_headers :: Lens' TestInvokeMethod (Maybe (HashMap Text Text))
testInvokeMethod_headers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeMethod' {Maybe (HashMap Text Text)
headers :: Maybe (HashMap Text Text)
$sel:headers:TestInvokeMethod' :: TestInvokeMethod -> Maybe (HashMap Text Text)
headers} -> Maybe (HashMap Text Text)
headers) (\s :: TestInvokeMethod
s@TestInvokeMethod' {} Maybe (HashMap Text Text)
a -> TestInvokeMethod
s {$sel:headers:TestInvokeMethod' :: Maybe (HashMap Text Text)
headers = Maybe (HashMap Text Text)
a} :: TestInvokeMethod) 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.
testInvokeMethod_multiValueHeaders :: Lens.Lens' TestInvokeMethod (Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]))
testInvokeMethod_multiValueHeaders :: Lens' TestInvokeMethod (Maybe (HashMap Text [Text]))
testInvokeMethod_multiValueHeaders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeMethod' {Maybe (HashMap Text [Text])
multiValueHeaders :: Maybe (HashMap Text [Text])
$sel:multiValueHeaders:TestInvokeMethod' :: TestInvokeMethod -> Maybe (HashMap Text [Text])
multiValueHeaders} -> Maybe (HashMap Text [Text])
multiValueHeaders) (\s :: TestInvokeMethod
s@TestInvokeMethod' {} Maybe (HashMap Text [Text])
a -> TestInvokeMethod
s {$sel:multiValueHeaders:TestInvokeMethod' :: Maybe (HashMap Text [Text])
multiValueHeaders = Maybe (HashMap Text [Text])
a} :: TestInvokeMethod) 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.
testInvokeMethod_pathWithQueryString :: Lens.Lens' TestInvokeMethod (Prelude.Maybe Prelude.Text)
testInvokeMethod_pathWithQueryString :: Lens' TestInvokeMethod (Maybe Text)
testInvokeMethod_pathWithQueryString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeMethod' {Maybe Text
pathWithQueryString :: Maybe Text
$sel:pathWithQueryString:TestInvokeMethod' :: TestInvokeMethod -> Maybe Text
pathWithQueryString} -> Maybe Text
pathWithQueryString) (\s :: TestInvokeMethod
s@TestInvokeMethod' {} Maybe Text
a -> TestInvokeMethod
s {$sel:pathWithQueryString:TestInvokeMethod' :: Maybe Text
pathWithQueryString = Maybe Text
a} :: TestInvokeMethod)

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

-- | Specifies a test invoke method request\'s resource ID.
testInvokeMethod_resourceId :: Lens.Lens' TestInvokeMethod Prelude.Text
testInvokeMethod_resourceId :: Lens' TestInvokeMethod Text
testInvokeMethod_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeMethod' {Text
resourceId :: Text
$sel:resourceId:TestInvokeMethod' :: TestInvokeMethod -> Text
resourceId} -> Text
resourceId) (\s :: TestInvokeMethod
s@TestInvokeMethod' {} Text
a -> TestInvokeMethod
s {$sel:resourceId:TestInvokeMethod' :: Text
resourceId = Text
a} :: TestInvokeMethod)

-- | Specifies a test invoke method request\'s HTTP method.
testInvokeMethod_httpMethod :: Lens.Lens' TestInvokeMethod Prelude.Text
testInvokeMethod_httpMethod :: Lens' TestInvokeMethod Text
testInvokeMethod_httpMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeMethod' {Text
httpMethod :: Text
$sel:httpMethod:TestInvokeMethod' :: TestInvokeMethod -> Text
httpMethod} -> Text
httpMethod) (\s :: TestInvokeMethod
s@TestInvokeMethod' {} Text
a -> TestInvokeMethod
s {$sel:httpMethod:TestInvokeMethod' :: Text
httpMethod = Text
a} :: TestInvokeMethod)

instance Core.AWSRequest TestInvokeMethod where
  type
    AWSResponse TestInvokeMethod =
      TestInvokeMethodResponse
  request :: (Service -> Service)
-> TestInvokeMethod -> Request TestInvokeMethod
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 TestInvokeMethod
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse TestInvokeMethod)))
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 Text
-> Maybe (HashMap Text Text)
-> Maybe Integer
-> Maybe Text
-> Maybe (HashMap Text [Text])
-> Maybe Int
-> Int
-> TestInvokeMethodResponse
TestInvokeMethodResponse'
            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
"body")
            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
"headers" 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
"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
"multiValueHeaders"
                            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
"status")
            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 TestInvokeMethod where
  hashWithSalt :: Int -> TestInvokeMethod -> Int
hashWithSalt Int
_salt TestInvokeMethod' {Maybe Text
Maybe (HashMap Text [Text])
Maybe (HashMap Text Text)
Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
stageVariables :: Maybe (HashMap Text Text)
pathWithQueryString :: Maybe Text
multiValueHeaders :: Maybe (HashMap Text [Text])
headers :: Maybe (HashMap Text Text)
clientCertificateId :: Maybe Text
body :: Maybe Text
$sel:httpMethod:TestInvokeMethod' :: TestInvokeMethod -> Text
$sel:resourceId:TestInvokeMethod' :: TestInvokeMethod -> Text
$sel:restApiId:TestInvokeMethod' :: TestInvokeMethod -> Text
$sel:stageVariables:TestInvokeMethod' :: TestInvokeMethod -> Maybe (HashMap Text Text)
$sel:pathWithQueryString:TestInvokeMethod' :: TestInvokeMethod -> Maybe Text
$sel:multiValueHeaders:TestInvokeMethod' :: TestInvokeMethod -> Maybe (HashMap Text [Text])
$sel:headers:TestInvokeMethod' :: TestInvokeMethod -> Maybe (HashMap Text Text)
$sel:clientCertificateId:TestInvokeMethod' :: TestInvokeMethod -> Maybe Text
$sel:body:TestInvokeMethod' :: TestInvokeMethod -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
body
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientCertificateId
      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
resourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
httpMethod

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

instance Data.ToHeaders TestInvokeMethod where
  toHeaders :: TestInvokeMethod -> 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 TestInvokeMethod where
  toJSON :: TestInvokeMethod -> Value
toJSON TestInvokeMethod' {Maybe Text
Maybe (HashMap Text [Text])
Maybe (HashMap Text Text)
Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
stageVariables :: Maybe (HashMap Text Text)
pathWithQueryString :: Maybe Text
multiValueHeaders :: Maybe (HashMap Text [Text])
headers :: Maybe (HashMap Text Text)
clientCertificateId :: Maybe Text
body :: Maybe Text
$sel:httpMethod:TestInvokeMethod' :: TestInvokeMethod -> Text
$sel:resourceId:TestInvokeMethod' :: TestInvokeMethod -> Text
$sel:restApiId:TestInvokeMethod' :: TestInvokeMethod -> Text
$sel:stageVariables:TestInvokeMethod' :: TestInvokeMethod -> Maybe (HashMap Text Text)
$sel:pathWithQueryString:TestInvokeMethod' :: TestInvokeMethod -> Maybe Text
$sel:multiValueHeaders:TestInvokeMethod' :: TestInvokeMethod -> Maybe (HashMap Text [Text])
$sel:headers:TestInvokeMethod' :: TestInvokeMethod -> Maybe (HashMap Text Text)
$sel:clientCertificateId:TestInvokeMethod' :: TestInvokeMethod -> Maybe Text
$sel:body:TestInvokeMethod' :: TestInvokeMethod -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"clientCertificateId" 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
clientCertificateId,
            (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 TestInvokeMethod where
  toPath :: TestInvokeMethod -> ByteString
toPath TestInvokeMethod' {Maybe Text
Maybe (HashMap Text [Text])
Maybe (HashMap Text Text)
Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
stageVariables :: Maybe (HashMap Text Text)
pathWithQueryString :: Maybe Text
multiValueHeaders :: Maybe (HashMap Text [Text])
headers :: Maybe (HashMap Text Text)
clientCertificateId :: Maybe Text
body :: Maybe Text
$sel:httpMethod:TestInvokeMethod' :: TestInvokeMethod -> Text
$sel:resourceId:TestInvokeMethod' :: TestInvokeMethod -> Text
$sel:restApiId:TestInvokeMethod' :: TestInvokeMethod -> Text
$sel:stageVariables:TestInvokeMethod' :: TestInvokeMethod -> Maybe (HashMap Text Text)
$sel:pathWithQueryString:TestInvokeMethod' :: TestInvokeMethod -> Maybe Text
$sel:multiValueHeaders:TestInvokeMethod' :: TestInvokeMethod -> Maybe (HashMap Text [Text])
$sel:headers:TestInvokeMethod' :: TestInvokeMethod -> Maybe (HashMap Text Text)
$sel:clientCertificateId:TestInvokeMethod' :: TestInvokeMethod -> Maybe Text
$sel:body:TestInvokeMethod' :: TestInvokeMethod -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/restapis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
restApiId,
        ByteString
"/resources/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
resourceId,
        ByteString
"/methods/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
httpMethod
      ]

instance Data.ToQuery TestInvokeMethod where
  toQuery :: TestInvokeMethod -> 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 in the HTTP method.
--
-- /See:/ 'newTestInvokeMethodResponse' smart constructor.
data TestInvokeMethodResponse = TestInvokeMethodResponse'
  { -- | The body of the HTTP response.
    TestInvokeMethodResponse -> Maybe Text
body :: Prelude.Maybe Prelude.Text,
    -- | The headers of the HTTP response.
    TestInvokeMethodResponse -> Maybe (HashMap Text Text)
headers :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The execution latency of the test invoke request.
    TestInvokeMethodResponse -> Maybe Integer
latency :: Prelude.Maybe Prelude.Integer,
    -- | The API Gateway execution log for the test invoke request.
    TestInvokeMethodResponse -> Maybe Text
log :: Prelude.Maybe Prelude.Text,
    -- | The headers of the HTTP response as a map from string to list of values.
    TestInvokeMethodResponse -> Maybe (HashMap Text [Text])
multiValueHeaders :: Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]),
    -- | The HTTP status code.
    TestInvokeMethodResponse -> Maybe Int
status :: Prelude.Maybe Prelude.Int,
    -- | The response's http status code.
    TestInvokeMethodResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (TestInvokeMethodResponse -> TestInvokeMethodResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestInvokeMethodResponse -> TestInvokeMethodResponse -> Bool
$c/= :: TestInvokeMethodResponse -> TestInvokeMethodResponse -> Bool
== :: TestInvokeMethodResponse -> TestInvokeMethodResponse -> Bool
$c== :: TestInvokeMethodResponse -> TestInvokeMethodResponse -> Bool
Prelude.Eq, ReadPrec [TestInvokeMethodResponse]
ReadPrec TestInvokeMethodResponse
Int -> ReadS TestInvokeMethodResponse
ReadS [TestInvokeMethodResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestInvokeMethodResponse]
$creadListPrec :: ReadPrec [TestInvokeMethodResponse]
readPrec :: ReadPrec TestInvokeMethodResponse
$creadPrec :: ReadPrec TestInvokeMethodResponse
readList :: ReadS [TestInvokeMethodResponse]
$creadList :: ReadS [TestInvokeMethodResponse]
readsPrec :: Int -> ReadS TestInvokeMethodResponse
$creadsPrec :: Int -> ReadS TestInvokeMethodResponse
Prelude.Read, Int -> TestInvokeMethodResponse -> ShowS
[TestInvokeMethodResponse] -> ShowS
TestInvokeMethodResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestInvokeMethodResponse] -> ShowS
$cshowList :: [TestInvokeMethodResponse] -> ShowS
show :: TestInvokeMethodResponse -> String
$cshow :: TestInvokeMethodResponse -> String
showsPrec :: Int -> TestInvokeMethodResponse -> ShowS
$cshowsPrec :: Int -> TestInvokeMethodResponse -> ShowS
Prelude.Show, forall x.
Rep TestInvokeMethodResponse x -> TestInvokeMethodResponse
forall x.
TestInvokeMethodResponse -> Rep TestInvokeMethodResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep TestInvokeMethodResponse x -> TestInvokeMethodResponse
$cfrom :: forall x.
TestInvokeMethodResponse -> Rep TestInvokeMethodResponse x
Prelude.Generic)

-- |
-- Create a value of 'TestInvokeMethodResponse' 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:
--
-- 'body', 'testInvokeMethodResponse_body' - The body of the HTTP response.
--
-- 'headers', 'testInvokeMethodResponse_headers' - The headers of the HTTP response.
--
-- 'latency', 'testInvokeMethodResponse_latency' - The execution latency of the test invoke request.
--
-- 'log', 'testInvokeMethodResponse_log' - The API Gateway execution log for the test invoke request.
--
-- 'multiValueHeaders', 'testInvokeMethodResponse_multiValueHeaders' - The headers of the HTTP response as a map from string to list of values.
--
-- 'status', 'testInvokeMethodResponse_status' - The HTTP status code.
--
-- 'httpStatus', 'testInvokeMethodResponse_httpStatus' - The response's http status code.
newTestInvokeMethodResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  TestInvokeMethodResponse
newTestInvokeMethodResponse :: Int -> TestInvokeMethodResponse
newTestInvokeMethodResponse Int
pHttpStatus_ =
  TestInvokeMethodResponse'
    { $sel:body:TestInvokeMethodResponse' :: Maybe Text
body = forall a. Maybe a
Prelude.Nothing,
      $sel:headers:TestInvokeMethodResponse' :: Maybe (HashMap Text Text)
headers = forall a. Maybe a
Prelude.Nothing,
      $sel:latency:TestInvokeMethodResponse' :: Maybe Integer
latency = forall a. Maybe a
Prelude.Nothing,
      $sel:log:TestInvokeMethodResponse' :: Maybe Text
log = forall a. Maybe a
Prelude.Nothing,
      $sel:multiValueHeaders:TestInvokeMethodResponse' :: Maybe (HashMap Text [Text])
multiValueHeaders = forall a. Maybe a
Prelude.Nothing,
      $sel:status:TestInvokeMethodResponse' :: Maybe Int
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:TestInvokeMethodResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The body of the HTTP response.
testInvokeMethodResponse_body :: Lens.Lens' TestInvokeMethodResponse (Prelude.Maybe Prelude.Text)
testInvokeMethodResponse_body :: Lens' TestInvokeMethodResponse (Maybe Text)
testInvokeMethodResponse_body = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeMethodResponse' {Maybe Text
body :: Maybe Text
$sel:body:TestInvokeMethodResponse' :: TestInvokeMethodResponse -> Maybe Text
body} -> Maybe Text
body) (\s :: TestInvokeMethodResponse
s@TestInvokeMethodResponse' {} Maybe Text
a -> TestInvokeMethodResponse
s {$sel:body:TestInvokeMethodResponse' :: Maybe Text
body = Maybe Text
a} :: TestInvokeMethodResponse)

-- | The headers of the HTTP response.
testInvokeMethodResponse_headers :: Lens.Lens' TestInvokeMethodResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
testInvokeMethodResponse_headers :: Lens' TestInvokeMethodResponse (Maybe (HashMap Text Text))
testInvokeMethodResponse_headers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeMethodResponse' {Maybe (HashMap Text Text)
headers :: Maybe (HashMap Text Text)
$sel:headers:TestInvokeMethodResponse' :: TestInvokeMethodResponse -> Maybe (HashMap Text Text)
headers} -> Maybe (HashMap Text Text)
headers) (\s :: TestInvokeMethodResponse
s@TestInvokeMethodResponse' {} Maybe (HashMap Text Text)
a -> TestInvokeMethodResponse
s {$sel:headers:TestInvokeMethodResponse' :: Maybe (HashMap Text Text)
headers = Maybe (HashMap Text Text)
a} :: TestInvokeMethodResponse) 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 execution latency of the test invoke request.
testInvokeMethodResponse_latency :: Lens.Lens' TestInvokeMethodResponse (Prelude.Maybe Prelude.Integer)
testInvokeMethodResponse_latency :: Lens' TestInvokeMethodResponse (Maybe Integer)
testInvokeMethodResponse_latency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeMethodResponse' {Maybe Integer
latency :: Maybe Integer
$sel:latency:TestInvokeMethodResponse' :: TestInvokeMethodResponse -> Maybe Integer
latency} -> Maybe Integer
latency) (\s :: TestInvokeMethodResponse
s@TestInvokeMethodResponse' {} Maybe Integer
a -> TestInvokeMethodResponse
s {$sel:latency:TestInvokeMethodResponse' :: Maybe Integer
latency = Maybe Integer
a} :: TestInvokeMethodResponse)

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

-- | The headers of the HTTP response as a map from string to list of values.
testInvokeMethodResponse_multiValueHeaders :: Lens.Lens' TestInvokeMethodResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]))
testInvokeMethodResponse_multiValueHeaders :: Lens' TestInvokeMethodResponse (Maybe (HashMap Text [Text]))
testInvokeMethodResponse_multiValueHeaders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeMethodResponse' {Maybe (HashMap Text [Text])
multiValueHeaders :: Maybe (HashMap Text [Text])
$sel:multiValueHeaders:TestInvokeMethodResponse' :: TestInvokeMethodResponse -> Maybe (HashMap Text [Text])
multiValueHeaders} -> Maybe (HashMap Text [Text])
multiValueHeaders) (\s :: TestInvokeMethodResponse
s@TestInvokeMethodResponse' {} Maybe (HashMap Text [Text])
a -> TestInvokeMethodResponse
s {$sel:multiValueHeaders:TestInvokeMethodResponse' :: Maybe (HashMap Text [Text])
multiValueHeaders = Maybe (HashMap Text [Text])
a} :: TestInvokeMethodResponse) 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.
testInvokeMethodResponse_status :: Lens.Lens' TestInvokeMethodResponse (Prelude.Maybe Prelude.Int)
testInvokeMethodResponse_status :: Lens' TestInvokeMethodResponse (Maybe Int)
testInvokeMethodResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestInvokeMethodResponse' {Maybe Int
status :: Maybe Int
$sel:status:TestInvokeMethodResponse' :: TestInvokeMethodResponse -> Maybe Int
status} -> Maybe Int
status) (\s :: TestInvokeMethodResponse
s@TestInvokeMethodResponse' {} Maybe Int
a -> TestInvokeMethodResponse
s {$sel:status:TestInvokeMethodResponse' :: Maybe Int
status = Maybe Int
a} :: TestInvokeMethodResponse)

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

instance Prelude.NFData TestInvokeMethodResponse where
  rnf :: TestInvokeMethodResponse -> ()
rnf TestInvokeMethodResponse' {Int
Maybe Int
Maybe Integer
Maybe Text
Maybe (HashMap Text [Text])
Maybe (HashMap Text Text)
httpStatus :: Int
status :: Maybe Int
multiValueHeaders :: Maybe (HashMap Text [Text])
log :: Maybe Text
latency :: Maybe Integer
headers :: Maybe (HashMap Text Text)
body :: Maybe Text
$sel:httpStatus:TestInvokeMethodResponse' :: TestInvokeMethodResponse -> Int
$sel:status:TestInvokeMethodResponse' :: TestInvokeMethodResponse -> Maybe Int
$sel:multiValueHeaders:TestInvokeMethodResponse' :: TestInvokeMethodResponse -> Maybe (HashMap Text [Text])
$sel:log:TestInvokeMethodResponse' :: TestInvokeMethodResponse -> Maybe Text
$sel:latency:TestInvokeMethodResponse' :: TestInvokeMethodResponse -> Maybe Integer
$sel:headers:TestInvokeMethodResponse' :: TestInvokeMethodResponse -> Maybe (HashMap Text Text)
$sel:body:TestInvokeMethodResponse' :: TestInvokeMethodResponse -> Maybe Text
..} =
    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 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 (HashMap Text [Text])
multiValueHeaders
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus