{-# 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.PutGatewayResponse
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a customization of a GatewayResponse of a specified response
-- type and status code on the given RestApi.
module Amazonka.APIGateway.PutGatewayResponse
  ( -- * Creating a Request
    PutGatewayResponse (..),
    newPutGatewayResponse,

    -- * Request Lenses
    putGatewayResponse_responseParameters,
    putGatewayResponse_responseTemplates,
    putGatewayResponse_statusCode,
    putGatewayResponse_restApiId,
    putGatewayResponse_responseType,

    -- * Destructuring the Response
    GatewayResponse (..),
    newGatewayResponse,

    -- * Response Lenses
    gatewayResponse_defaultResponse,
    gatewayResponse_responseParameters,
    gatewayResponse_responseTemplates,
    gatewayResponse_responseType,
    gatewayResponse_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

-- | Creates a customization of a GatewayResponse of a specified response
-- type and status code on the given RestApi.
--
-- /See:/ 'newPutGatewayResponse' smart constructor.
data PutGatewayResponse = PutGatewayResponse'
  { -- | Response parameters (paths, query strings and headers) of the
    -- GatewayResponse as a string-to-string map of key-value pairs.
    PutGatewayResponse -> Maybe (HashMap Text Text)
responseParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Response templates of the GatewayResponse as a string-to-string map of
    -- key-value pairs.
    PutGatewayResponse -> Maybe (HashMap Text Text)
responseTemplates :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The HTTP status code of the GatewayResponse.
    PutGatewayResponse -> Maybe Text
statusCode :: Prelude.Maybe Prelude.Text,
    -- | The string identifier of the associated RestApi.
    PutGatewayResponse -> Text
restApiId :: Prelude.Text,
    -- | The response type of the associated GatewayResponse
    PutGatewayResponse -> GatewayResponseType
responseType :: GatewayResponseType
  }
  deriving (PutGatewayResponse -> PutGatewayResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutGatewayResponse -> PutGatewayResponse -> Bool
$c/= :: PutGatewayResponse -> PutGatewayResponse -> Bool
== :: PutGatewayResponse -> PutGatewayResponse -> Bool
$c== :: PutGatewayResponse -> PutGatewayResponse -> Bool
Prelude.Eq, ReadPrec [PutGatewayResponse]
ReadPrec PutGatewayResponse
Int -> ReadS PutGatewayResponse
ReadS [PutGatewayResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutGatewayResponse]
$creadListPrec :: ReadPrec [PutGatewayResponse]
readPrec :: ReadPrec PutGatewayResponse
$creadPrec :: ReadPrec PutGatewayResponse
readList :: ReadS [PutGatewayResponse]
$creadList :: ReadS [PutGatewayResponse]
readsPrec :: Int -> ReadS PutGatewayResponse
$creadsPrec :: Int -> ReadS PutGatewayResponse
Prelude.Read, Int -> PutGatewayResponse -> ShowS
[PutGatewayResponse] -> ShowS
PutGatewayResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutGatewayResponse] -> ShowS
$cshowList :: [PutGatewayResponse] -> ShowS
show :: PutGatewayResponse -> String
$cshow :: PutGatewayResponse -> String
showsPrec :: Int -> PutGatewayResponse -> ShowS
$cshowsPrec :: Int -> PutGatewayResponse -> ShowS
Prelude.Show, forall x. Rep PutGatewayResponse x -> PutGatewayResponse
forall x. PutGatewayResponse -> Rep PutGatewayResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutGatewayResponse x -> PutGatewayResponse
$cfrom :: forall x. PutGatewayResponse -> Rep PutGatewayResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutGatewayResponse' 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:
--
-- 'responseParameters', 'putGatewayResponse_responseParameters' - Response parameters (paths, query strings and headers) of the
-- GatewayResponse as a string-to-string map of key-value pairs.
--
-- 'responseTemplates', 'putGatewayResponse_responseTemplates' - Response templates of the GatewayResponse as a string-to-string map of
-- key-value pairs.
--
-- 'statusCode', 'putGatewayResponse_statusCode' - The HTTP status code of the GatewayResponse.
--
-- 'restApiId', 'putGatewayResponse_restApiId' - The string identifier of the associated RestApi.
--
-- 'responseType', 'putGatewayResponse_responseType' - The response type of the associated GatewayResponse
newPutGatewayResponse ::
  -- | 'restApiId'
  Prelude.Text ->
  -- | 'responseType'
  GatewayResponseType ->
  PutGatewayResponse
newPutGatewayResponse :: Text -> GatewayResponseType -> PutGatewayResponse
newPutGatewayResponse Text
pRestApiId_ GatewayResponseType
pResponseType_ =
  PutGatewayResponse'
    { $sel:responseParameters:PutGatewayResponse' :: Maybe (HashMap Text Text)
responseParameters =
        forall a. Maybe a
Prelude.Nothing,
      $sel:responseTemplates:PutGatewayResponse' :: Maybe (HashMap Text Text)
responseTemplates = forall a. Maybe a
Prelude.Nothing,
      $sel:statusCode:PutGatewayResponse' :: Maybe Text
statusCode = forall a. Maybe a
Prelude.Nothing,
      $sel:restApiId:PutGatewayResponse' :: Text
restApiId = Text
pRestApiId_,
      $sel:responseType:PutGatewayResponse' :: GatewayResponseType
responseType = GatewayResponseType
pResponseType_
    }

-- | Response parameters (paths, query strings and headers) of the
-- GatewayResponse as a string-to-string map of key-value pairs.
putGatewayResponse_responseParameters :: Lens.Lens' PutGatewayResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putGatewayResponse_responseParameters :: Lens' PutGatewayResponse (Maybe (HashMap Text Text))
putGatewayResponse_responseParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutGatewayResponse' {Maybe (HashMap Text Text)
responseParameters :: Maybe (HashMap Text Text)
$sel:responseParameters:PutGatewayResponse' :: PutGatewayResponse -> Maybe (HashMap Text Text)
responseParameters} -> Maybe (HashMap Text Text)
responseParameters) (\s :: PutGatewayResponse
s@PutGatewayResponse' {} Maybe (HashMap Text Text)
a -> PutGatewayResponse
s {$sel:responseParameters:PutGatewayResponse' :: Maybe (HashMap Text Text)
responseParameters = Maybe (HashMap Text Text)
a} :: PutGatewayResponse) 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

-- | Response templates of the GatewayResponse as a string-to-string map of
-- key-value pairs.
putGatewayResponse_responseTemplates :: Lens.Lens' PutGatewayResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putGatewayResponse_responseTemplates :: Lens' PutGatewayResponse (Maybe (HashMap Text Text))
putGatewayResponse_responseTemplates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutGatewayResponse' {Maybe (HashMap Text Text)
responseTemplates :: Maybe (HashMap Text Text)
$sel:responseTemplates:PutGatewayResponse' :: PutGatewayResponse -> Maybe (HashMap Text Text)
responseTemplates} -> Maybe (HashMap Text Text)
responseTemplates) (\s :: PutGatewayResponse
s@PutGatewayResponse' {} Maybe (HashMap Text Text)
a -> PutGatewayResponse
s {$sel:responseTemplates:PutGatewayResponse' :: Maybe (HashMap Text Text)
responseTemplates = Maybe (HashMap Text Text)
a} :: PutGatewayResponse) 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 of the GatewayResponse.
putGatewayResponse_statusCode :: Lens.Lens' PutGatewayResponse (Prelude.Maybe Prelude.Text)
putGatewayResponse_statusCode :: Lens' PutGatewayResponse (Maybe Text)
putGatewayResponse_statusCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutGatewayResponse' {Maybe Text
statusCode :: Maybe Text
$sel:statusCode:PutGatewayResponse' :: PutGatewayResponse -> Maybe Text
statusCode} -> Maybe Text
statusCode) (\s :: PutGatewayResponse
s@PutGatewayResponse' {} Maybe Text
a -> PutGatewayResponse
s {$sel:statusCode:PutGatewayResponse' :: Maybe Text
statusCode = Maybe Text
a} :: PutGatewayResponse)

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

-- | The response type of the associated GatewayResponse
putGatewayResponse_responseType :: Lens.Lens' PutGatewayResponse GatewayResponseType
putGatewayResponse_responseType :: Lens' PutGatewayResponse GatewayResponseType
putGatewayResponse_responseType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutGatewayResponse' {GatewayResponseType
responseType :: GatewayResponseType
$sel:responseType:PutGatewayResponse' :: PutGatewayResponse -> GatewayResponseType
responseType} -> GatewayResponseType
responseType) (\s :: PutGatewayResponse
s@PutGatewayResponse' {} GatewayResponseType
a -> PutGatewayResponse
s {$sel:responseType:PutGatewayResponse' :: GatewayResponseType
responseType = GatewayResponseType
a} :: PutGatewayResponse)

instance Core.AWSRequest PutGatewayResponse where
  type AWSResponse PutGatewayResponse = GatewayResponse
  request :: (Service -> Service)
-> PutGatewayResponse -> Request PutGatewayResponse
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 PutGatewayResponse
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutGatewayResponse)))
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 PutGatewayResponse where
  hashWithSalt :: Int -> PutGatewayResponse -> Int
hashWithSalt Int
_salt PutGatewayResponse' {Maybe Text
Maybe (HashMap Text Text)
Text
GatewayResponseType
responseType :: GatewayResponseType
restApiId :: Text
statusCode :: Maybe Text
responseTemplates :: Maybe (HashMap Text Text)
responseParameters :: Maybe (HashMap Text Text)
$sel:responseType:PutGatewayResponse' :: PutGatewayResponse -> GatewayResponseType
$sel:restApiId:PutGatewayResponse' :: PutGatewayResponse -> Text
$sel:statusCode:PutGatewayResponse' :: PutGatewayResponse -> Maybe Text
$sel:responseTemplates:PutGatewayResponse' :: PutGatewayResponse -> Maybe (HashMap Text Text)
$sel:responseParameters:PutGatewayResponse' :: PutGatewayResponse -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      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
statusCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
restApiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` GatewayResponseType
responseType

instance Prelude.NFData PutGatewayResponse where
  rnf :: PutGatewayResponse -> ()
rnf PutGatewayResponse' {Maybe Text
Maybe (HashMap Text Text)
Text
GatewayResponseType
responseType :: GatewayResponseType
restApiId :: Text
statusCode :: Maybe Text
responseTemplates :: Maybe (HashMap Text Text)
responseParameters :: Maybe (HashMap Text Text)
$sel:responseType:PutGatewayResponse' :: PutGatewayResponse -> GatewayResponseType
$sel:restApiId:PutGatewayResponse' :: PutGatewayResponse -> Text
$sel:statusCode:PutGatewayResponse' :: PutGatewayResponse -> Maybe Text
$sel:responseTemplates:PutGatewayResponse' :: PutGatewayResponse -> Maybe (HashMap Text Text)
$sel:responseParameters:PutGatewayResponse' :: PutGatewayResponse -> Maybe (HashMap Text Text)
..} =
    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
statusCode
      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 GatewayResponseType
responseType

instance Data.ToHeaders PutGatewayResponse where
  toHeaders :: PutGatewayResponse -> 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 PutGatewayResponse where
  toJSON :: PutGatewayResponse -> Value
toJSON PutGatewayResponse' {Maybe Text
Maybe (HashMap Text Text)
Text
GatewayResponseType
responseType :: GatewayResponseType
restApiId :: Text
statusCode :: Maybe Text
responseTemplates :: Maybe (HashMap Text Text)
responseParameters :: Maybe (HashMap Text Text)
$sel:responseType:PutGatewayResponse' :: PutGatewayResponse -> GatewayResponseType
$sel:restApiId:PutGatewayResponse' :: PutGatewayResponse -> Text
$sel:statusCode:PutGatewayResponse' :: PutGatewayResponse -> Maybe Text
$sel:responseTemplates:PutGatewayResponse' :: PutGatewayResponse -> Maybe (HashMap Text Text)
$sel:responseParameters:PutGatewayResponse' :: PutGatewayResponse -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"statusCode" 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
statusCode
          ]
      )

instance Data.ToPath PutGatewayResponse where
  toPath :: PutGatewayResponse -> ByteString
toPath PutGatewayResponse' {Maybe Text
Maybe (HashMap Text Text)
Text
GatewayResponseType
responseType :: GatewayResponseType
restApiId :: Text
statusCode :: Maybe Text
responseTemplates :: Maybe (HashMap Text Text)
responseParameters :: Maybe (HashMap Text Text)
$sel:responseType:PutGatewayResponse' :: PutGatewayResponse -> GatewayResponseType
$sel:restApiId:PutGatewayResponse' :: PutGatewayResponse -> Text
$sel:statusCode:PutGatewayResponse' :: PutGatewayResponse -> Maybe Text
$sel:responseTemplates:PutGatewayResponse' :: PutGatewayResponse -> Maybe (HashMap Text Text)
$sel:responseParameters:PutGatewayResponse' :: PutGatewayResponse -> Maybe (HashMap Text Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/restapis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
restApiId,
        ByteString
"/gatewayresponses/",
        forall a. ToByteString a => a -> ByteString
Data.toBS GatewayResponseType
responseType
      ]

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