{-# 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.PutIntegrationResponse
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Represents a put integration.
module Amazonka.APIGateway.PutIntegrationResponse
  ( -- * Creating a Request
    PutIntegrationResponse (..),
    newPutIntegrationResponse,

    -- * Request Lenses
    putIntegrationResponse_contentHandling,
    putIntegrationResponse_responseParameters,
    putIntegrationResponse_responseTemplates,
    putIntegrationResponse_selectionPattern,
    putIntegrationResponse_restApiId,
    putIntegrationResponse_resourceId,
    putIntegrationResponse_httpMethod,
    putIntegrationResponse_statusCode,

    -- * Destructuring the Response
    IntegrationResponse (..),
    newIntegrationResponse,

    -- * Response Lenses
    integrationResponse_contentHandling,
    integrationResponse_responseParameters,
    integrationResponse_responseTemplates,
    integrationResponse_selectionPattern,
    integrationResponse_statusCode,
  )
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

-- | Represents a put integration response request.
--
-- /See:/ 'newPutIntegrationResponse' smart constructor.
data PutIntegrationResponse = PutIntegrationResponse'
  { -- | Specifies how to handle response payload content type conversions.
    -- Supported values are @CONVERT_TO_BINARY@ and @CONVERT_TO_TEXT@, with the
    -- following behaviors:
    --
    -- If this property is not defined, the response payload will be passed
    -- through from the integration response to the method response without
    -- modification.
    PutIntegrationResponse -> Maybe ContentHandlingStrategy
contentHandling :: Prelude.Maybe ContentHandlingStrategy,
    -- | A key-value map specifying response parameters that are passed to the
    -- method response from the back end. The key is a method response header
    -- parameter name and the mapped value is an integration response header
    -- value, a static value enclosed within a pair of single quotes, or a JSON
    -- expression from the integration response body. The mapping key must
    -- match the pattern of @method.response.header.{name}@, where @name@ is a
    -- valid and unique header name. The mapped non-static value must match the
    -- pattern of @integration.response.header.{name}@ or
    -- @integration.response.body.{JSON-expression}@, where @name@ must be a
    -- valid and unique response header name and @JSON-expression@ a valid JSON
    -- expression without the @$@ prefix.
    PutIntegrationResponse -> Maybe (HashMap Text Text)
responseParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Specifies a put integration response\'s templates.
    PutIntegrationResponse -> Maybe (HashMap Text Text)
responseTemplates :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Specifies the selection pattern of a put integration response.
    PutIntegrationResponse -> Maybe Text
selectionPattern :: Prelude.Maybe Prelude.Text,
    -- | The string identifier of the associated RestApi.
    PutIntegrationResponse -> Text
restApiId :: Prelude.Text,
    -- | Specifies a put integration response request\'s resource identifier.
    PutIntegrationResponse -> Text
resourceId :: Prelude.Text,
    -- | Specifies a put integration response request\'s HTTP method.
    PutIntegrationResponse -> Text
httpMethod :: Prelude.Text,
    -- | Specifies the status code that is used to map the integration response
    -- to an existing MethodResponse.
    PutIntegrationResponse -> Text
statusCode :: Prelude.Text
  }
  deriving (PutIntegrationResponse -> PutIntegrationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutIntegrationResponse -> PutIntegrationResponse -> Bool
$c/= :: PutIntegrationResponse -> PutIntegrationResponse -> Bool
== :: PutIntegrationResponse -> PutIntegrationResponse -> Bool
$c== :: PutIntegrationResponse -> PutIntegrationResponse -> Bool
Prelude.Eq, ReadPrec [PutIntegrationResponse]
ReadPrec PutIntegrationResponse
Int -> ReadS PutIntegrationResponse
ReadS [PutIntegrationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutIntegrationResponse]
$creadListPrec :: ReadPrec [PutIntegrationResponse]
readPrec :: ReadPrec PutIntegrationResponse
$creadPrec :: ReadPrec PutIntegrationResponse
readList :: ReadS [PutIntegrationResponse]
$creadList :: ReadS [PutIntegrationResponse]
readsPrec :: Int -> ReadS PutIntegrationResponse
$creadsPrec :: Int -> ReadS PutIntegrationResponse
Prelude.Read, Int -> PutIntegrationResponse -> ShowS
[PutIntegrationResponse] -> ShowS
PutIntegrationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutIntegrationResponse] -> ShowS
$cshowList :: [PutIntegrationResponse] -> ShowS
show :: PutIntegrationResponse -> String
$cshow :: PutIntegrationResponse -> String
showsPrec :: Int -> PutIntegrationResponse -> ShowS
$cshowsPrec :: Int -> PutIntegrationResponse -> ShowS
Prelude.Show, forall x. Rep PutIntegrationResponse x -> PutIntegrationResponse
forall x. PutIntegrationResponse -> Rep PutIntegrationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutIntegrationResponse x -> PutIntegrationResponse
$cfrom :: forall x. PutIntegrationResponse -> Rep PutIntegrationResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutIntegrationResponse' 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:
--
-- 'contentHandling', 'putIntegrationResponse_contentHandling' - Specifies how to handle response payload content type conversions.
-- Supported values are @CONVERT_TO_BINARY@ and @CONVERT_TO_TEXT@, with the
-- following behaviors:
--
-- If this property is not defined, the response payload will be passed
-- through from the integration response to the method response without
-- modification.
--
-- 'responseParameters', 'putIntegrationResponse_responseParameters' - A key-value map specifying response parameters that are passed to the
-- method response from the back end. The key is a method response header
-- parameter name and the mapped value is an integration response header
-- value, a static value enclosed within a pair of single quotes, or a JSON
-- expression from the integration response body. The mapping key must
-- match the pattern of @method.response.header.{name}@, where @name@ is a
-- valid and unique header name. The mapped non-static value must match the
-- pattern of @integration.response.header.{name}@ or
-- @integration.response.body.{JSON-expression}@, where @name@ must be a
-- valid and unique response header name and @JSON-expression@ a valid JSON
-- expression without the @$@ prefix.
--
-- 'responseTemplates', 'putIntegrationResponse_responseTemplates' - Specifies a put integration response\'s templates.
--
-- 'selectionPattern', 'putIntegrationResponse_selectionPattern' - Specifies the selection pattern of a put integration response.
--
-- 'restApiId', 'putIntegrationResponse_restApiId' - The string identifier of the associated RestApi.
--
-- 'resourceId', 'putIntegrationResponse_resourceId' - Specifies a put integration response request\'s resource identifier.
--
-- 'httpMethod', 'putIntegrationResponse_httpMethod' - Specifies a put integration response request\'s HTTP method.
--
-- 'statusCode', 'putIntegrationResponse_statusCode' - Specifies the status code that is used to map the integration response
-- to an existing MethodResponse.
newPutIntegrationResponse ::
  -- | 'restApiId'
  Prelude.Text ->
  -- | 'resourceId'
  Prelude.Text ->
  -- | 'httpMethod'
  Prelude.Text ->
  -- | 'statusCode'
  Prelude.Text ->
  PutIntegrationResponse
newPutIntegrationResponse :: Text -> Text -> Text -> Text -> PutIntegrationResponse
newPutIntegrationResponse
  Text
pRestApiId_
  Text
pResourceId_
  Text
pHttpMethod_
  Text
pStatusCode_ =
    PutIntegrationResponse'
      { $sel:contentHandling:PutIntegrationResponse' :: Maybe ContentHandlingStrategy
contentHandling =
          forall a. Maybe a
Prelude.Nothing,
        $sel:responseParameters:PutIntegrationResponse' :: Maybe (HashMap Text Text)
responseParameters = forall a. Maybe a
Prelude.Nothing,
        $sel:responseTemplates:PutIntegrationResponse' :: Maybe (HashMap Text Text)
responseTemplates = forall a. Maybe a
Prelude.Nothing,
        $sel:selectionPattern:PutIntegrationResponse' :: Maybe Text
selectionPattern = forall a. Maybe a
Prelude.Nothing,
        $sel:restApiId:PutIntegrationResponse' :: Text
restApiId = Text
pRestApiId_,
        $sel:resourceId:PutIntegrationResponse' :: Text
resourceId = Text
pResourceId_,
        $sel:httpMethod:PutIntegrationResponse' :: Text
httpMethod = Text
pHttpMethod_,
        $sel:statusCode:PutIntegrationResponse' :: Text
statusCode = Text
pStatusCode_
      }

-- | Specifies how to handle response payload content type conversions.
-- Supported values are @CONVERT_TO_BINARY@ and @CONVERT_TO_TEXT@, with the
-- following behaviors:
--
-- If this property is not defined, the response payload will be passed
-- through from the integration response to the method response without
-- modification.
putIntegrationResponse_contentHandling :: Lens.Lens' PutIntegrationResponse (Prelude.Maybe ContentHandlingStrategy)
putIntegrationResponse_contentHandling :: Lens' PutIntegrationResponse (Maybe ContentHandlingStrategy)
putIntegrationResponse_contentHandling = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {Maybe ContentHandlingStrategy
contentHandling :: Maybe ContentHandlingStrategy
$sel:contentHandling:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe ContentHandlingStrategy
contentHandling} -> Maybe ContentHandlingStrategy
contentHandling) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} Maybe ContentHandlingStrategy
a -> PutIntegrationResponse
s {$sel:contentHandling:PutIntegrationResponse' :: Maybe ContentHandlingStrategy
contentHandling = Maybe ContentHandlingStrategy
a} :: PutIntegrationResponse)

-- | A key-value map specifying response parameters that are passed to the
-- method response from the back end. The key is a method response header
-- parameter name and the mapped value is an integration response header
-- value, a static value enclosed within a pair of single quotes, or a JSON
-- expression from the integration response body. The mapping key must
-- match the pattern of @method.response.header.{name}@, where @name@ is a
-- valid and unique header name. The mapped non-static value must match the
-- pattern of @integration.response.header.{name}@ or
-- @integration.response.body.{JSON-expression}@, where @name@ must be a
-- valid and unique response header name and @JSON-expression@ a valid JSON
-- expression without the @$@ prefix.
putIntegrationResponse_responseParameters :: Lens.Lens' PutIntegrationResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putIntegrationResponse_responseParameters :: Lens' PutIntegrationResponse (Maybe (HashMap Text Text))
putIntegrationResponse_responseParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {Maybe (HashMap Text Text)
responseParameters :: Maybe (HashMap Text Text)
$sel:responseParameters:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe (HashMap Text Text)
responseParameters} -> Maybe (HashMap Text Text)
responseParameters) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} Maybe (HashMap Text Text)
a -> PutIntegrationResponse
s {$sel:responseParameters:PutIntegrationResponse' :: Maybe (HashMap Text Text)
responseParameters = Maybe (HashMap Text Text)
a} :: PutIntegrationResponse) 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

-- | Specifies a put integration response\'s templates.
putIntegrationResponse_responseTemplates :: Lens.Lens' PutIntegrationResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putIntegrationResponse_responseTemplates :: Lens' PutIntegrationResponse (Maybe (HashMap Text Text))
putIntegrationResponse_responseTemplates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {Maybe (HashMap Text Text)
responseTemplates :: Maybe (HashMap Text Text)
$sel:responseTemplates:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe (HashMap Text Text)
responseTemplates} -> Maybe (HashMap Text Text)
responseTemplates) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} Maybe (HashMap Text Text)
a -> PutIntegrationResponse
s {$sel:responseTemplates:PutIntegrationResponse' :: Maybe (HashMap Text Text)
responseTemplates = Maybe (HashMap Text Text)
a} :: PutIntegrationResponse) 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

-- | Specifies the selection pattern of a put integration response.
putIntegrationResponse_selectionPattern :: Lens.Lens' PutIntegrationResponse (Prelude.Maybe Prelude.Text)
putIntegrationResponse_selectionPattern :: Lens' PutIntegrationResponse (Maybe Text)
putIntegrationResponse_selectionPattern = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {Maybe Text
selectionPattern :: Maybe Text
$sel:selectionPattern:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe Text
selectionPattern} -> Maybe Text
selectionPattern) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} Maybe Text
a -> PutIntegrationResponse
s {$sel:selectionPattern:PutIntegrationResponse' :: Maybe Text
selectionPattern = Maybe Text
a} :: PutIntegrationResponse)

-- | The string identifier of the associated RestApi.
putIntegrationResponse_restApiId :: Lens.Lens' PutIntegrationResponse Prelude.Text
putIntegrationResponse_restApiId :: Lens' PutIntegrationResponse Text
putIntegrationResponse_restApiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {Text
restApiId :: Text
$sel:restApiId:PutIntegrationResponse' :: PutIntegrationResponse -> Text
restApiId} -> Text
restApiId) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} Text
a -> PutIntegrationResponse
s {$sel:restApiId:PutIntegrationResponse' :: Text
restApiId = Text
a} :: PutIntegrationResponse)

-- | Specifies a put integration response request\'s resource identifier.
putIntegrationResponse_resourceId :: Lens.Lens' PutIntegrationResponse Prelude.Text
putIntegrationResponse_resourceId :: Lens' PutIntegrationResponse Text
putIntegrationResponse_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {Text
resourceId :: Text
$sel:resourceId:PutIntegrationResponse' :: PutIntegrationResponse -> Text
resourceId} -> Text
resourceId) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} Text
a -> PutIntegrationResponse
s {$sel:resourceId:PutIntegrationResponse' :: Text
resourceId = Text
a} :: PutIntegrationResponse)

-- | Specifies a put integration response request\'s HTTP method.
putIntegrationResponse_httpMethod :: Lens.Lens' PutIntegrationResponse Prelude.Text
putIntegrationResponse_httpMethod :: Lens' PutIntegrationResponse Text
putIntegrationResponse_httpMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {Text
httpMethod :: Text
$sel:httpMethod:PutIntegrationResponse' :: PutIntegrationResponse -> Text
httpMethod} -> Text
httpMethod) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} Text
a -> PutIntegrationResponse
s {$sel:httpMethod:PutIntegrationResponse' :: Text
httpMethod = Text
a} :: PutIntegrationResponse)

-- | Specifies the status code that is used to map the integration response
-- to an existing MethodResponse.
putIntegrationResponse_statusCode :: Lens.Lens' PutIntegrationResponse Prelude.Text
putIntegrationResponse_statusCode :: Lens' PutIntegrationResponse Text
putIntegrationResponse_statusCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutIntegrationResponse' {Text
statusCode :: Text
$sel:statusCode:PutIntegrationResponse' :: PutIntegrationResponse -> Text
statusCode} -> Text
statusCode) (\s :: PutIntegrationResponse
s@PutIntegrationResponse' {} Text
a -> PutIntegrationResponse
s {$sel:statusCode:PutIntegrationResponse' :: Text
statusCode = Text
a} :: PutIntegrationResponse)

instance Core.AWSRequest PutIntegrationResponse where
  type
    AWSResponse PutIntegrationResponse =
      IntegrationResponse
  request :: (Service -> Service)
-> PutIntegrationResponse -> Request PutIntegrationResponse
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutIntegrationResponse
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutIntegrationResponse)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      (\Int
s ResponseHeaders
h Object
x -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable PutIntegrationResponse where
  hashWithSalt :: Int -> PutIntegrationResponse -> Int
hashWithSalt Int
_salt PutIntegrationResponse' {Maybe Text
Maybe (HashMap Text Text)
Maybe ContentHandlingStrategy
Text
statusCode :: Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
selectionPattern :: Maybe Text
responseTemplates :: Maybe (HashMap Text Text)
responseParameters :: Maybe (HashMap Text Text)
contentHandling :: Maybe ContentHandlingStrategy
$sel:statusCode:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:httpMethod:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:resourceId:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:restApiId:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:selectionPattern:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe Text
$sel:responseTemplates:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe (HashMap Text Text)
$sel:responseParameters:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe (HashMap Text Text)
$sel:contentHandling:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe ContentHandlingStrategy
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContentHandlingStrategy
contentHandling
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
responseParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
responseTemplates
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
selectionPattern
      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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
statusCode

instance Prelude.NFData PutIntegrationResponse where
  rnf :: PutIntegrationResponse -> ()
rnf PutIntegrationResponse' {Maybe Text
Maybe (HashMap Text Text)
Maybe ContentHandlingStrategy
Text
statusCode :: Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
selectionPattern :: Maybe Text
responseTemplates :: Maybe (HashMap Text Text)
responseParameters :: Maybe (HashMap Text Text)
contentHandling :: Maybe ContentHandlingStrategy
$sel:statusCode:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:httpMethod:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:resourceId:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:restApiId:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:selectionPattern:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe Text
$sel:responseTemplates:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe (HashMap Text Text)
$sel:responseParameters:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe (HashMap Text Text)
$sel:contentHandling:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe ContentHandlingStrategy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ContentHandlingStrategy
contentHandling
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
responseParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
responseTemplates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
selectionPattern
      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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
statusCode

instance Data.ToHeaders PutIntegrationResponse where
  toHeaders :: PutIntegrationResponse -> 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 PutIntegrationResponse where
  toJSON :: PutIntegrationResponse -> Value
toJSON PutIntegrationResponse' {Maybe Text
Maybe (HashMap Text Text)
Maybe ContentHandlingStrategy
Text
statusCode :: Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
selectionPattern :: Maybe Text
responseTemplates :: Maybe (HashMap Text Text)
responseParameters :: Maybe (HashMap Text Text)
contentHandling :: Maybe ContentHandlingStrategy
$sel:statusCode:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:httpMethod:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:resourceId:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:restApiId:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:selectionPattern:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe Text
$sel:responseTemplates:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe (HashMap Text Text)
$sel:responseParameters:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe (HashMap Text Text)
$sel:contentHandling:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe ContentHandlingStrategy
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"contentHandling" 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 ContentHandlingStrategy
contentHandling,
            (Key
"responseParameters" 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)
responseParameters,
            (Key
"responseTemplates" 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)
responseTemplates,
            (Key
"selectionPattern" 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
selectionPattern
          ]
      )

instance Data.ToPath PutIntegrationResponse where
  toPath :: PutIntegrationResponse -> ByteString
toPath PutIntegrationResponse' {Maybe Text
Maybe (HashMap Text Text)
Maybe ContentHandlingStrategy
Text
statusCode :: Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
selectionPattern :: Maybe Text
responseTemplates :: Maybe (HashMap Text Text)
responseParameters :: Maybe (HashMap Text Text)
contentHandling :: Maybe ContentHandlingStrategy
$sel:statusCode:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:httpMethod:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:resourceId:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:restApiId:PutIntegrationResponse' :: PutIntegrationResponse -> Text
$sel:selectionPattern:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe Text
$sel:responseTemplates:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe (HashMap Text Text)
$sel:responseParameters:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe (HashMap Text Text)
$sel:contentHandling:PutIntegrationResponse' :: PutIntegrationResponse -> Maybe ContentHandlingStrategy
..} =
    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,
        ByteString
"/integration/responses/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
statusCode
      ]

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