{-# 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.PutMethodResponse
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds a MethodResponse to an existing Method resource.
module Amazonka.APIGateway.PutMethodResponse
  ( -- * Creating a Request
    PutMethodResponse (..),
    newPutMethodResponse,

    -- * Request Lenses
    putMethodResponse_responseModels,
    putMethodResponse_responseParameters,
    putMethodResponse_restApiId,
    putMethodResponse_resourceId,
    putMethodResponse_httpMethod,
    putMethodResponse_statusCode,

    -- * Destructuring the Response
    MethodResponse (..),
    newMethodResponse,

    -- * Response Lenses
    methodResponse_responseModels,
    methodResponse_responseParameters,
    methodResponse_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

-- | Request to add a MethodResponse to an existing Method resource.
--
-- /See:/ 'newPutMethodResponse' smart constructor.
data PutMethodResponse = PutMethodResponse'
  { -- | Specifies the Model resources used for the response\'s content type.
    -- Response models are represented as a key\/value map, with a content type
    -- as the key and a Model name as the value.
    PutMethodResponse -> Maybe (HashMap Text Text)
responseModels :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A key-value map specifying required or optional response parameters that
    -- API Gateway can send back to the caller. A key defines a method response
    -- header name and the associated value is a Boolean flag indicating
    -- whether the method response parameter is required or not. The method
    -- response header names must match the pattern of
    -- @method.response.header.{name}@, where @name@ is a valid and unique
    -- header name. The response parameter names defined here are available in
    -- the integration response to be mapped from an integration response
    -- header expressed in @integration.response.header.{name}@, a static value
    -- enclosed within a pair of single quotes (e.g., @\'application\/json\'@),
    -- or a JSON expression from the back-end response payload in the form of
    -- @integration.response.body.{JSON-expression}@, where @JSON-expression@
    -- is a valid JSON expression without the @$@ prefix.)
    PutMethodResponse -> Maybe (HashMap Text Bool)
responseParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Bool),
    -- | The string identifier of the associated RestApi.
    PutMethodResponse -> Text
restApiId :: Prelude.Text,
    -- | The Resource identifier for the Method resource.
    PutMethodResponse -> Text
resourceId :: Prelude.Text,
    -- | The HTTP verb of the Method resource.
    PutMethodResponse -> Text
httpMethod :: Prelude.Text,
    -- | The method response\'s status code.
    PutMethodResponse -> Text
statusCode :: Prelude.Text
  }
  deriving (PutMethodResponse -> PutMethodResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutMethodResponse -> PutMethodResponse -> Bool
$c/= :: PutMethodResponse -> PutMethodResponse -> Bool
== :: PutMethodResponse -> PutMethodResponse -> Bool
$c== :: PutMethodResponse -> PutMethodResponse -> Bool
Prelude.Eq, ReadPrec [PutMethodResponse]
ReadPrec PutMethodResponse
Int -> ReadS PutMethodResponse
ReadS [PutMethodResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutMethodResponse]
$creadListPrec :: ReadPrec [PutMethodResponse]
readPrec :: ReadPrec PutMethodResponse
$creadPrec :: ReadPrec PutMethodResponse
readList :: ReadS [PutMethodResponse]
$creadList :: ReadS [PutMethodResponse]
readsPrec :: Int -> ReadS PutMethodResponse
$creadsPrec :: Int -> ReadS PutMethodResponse
Prelude.Read, Int -> PutMethodResponse -> ShowS
[PutMethodResponse] -> ShowS
PutMethodResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutMethodResponse] -> ShowS
$cshowList :: [PutMethodResponse] -> ShowS
show :: PutMethodResponse -> String
$cshow :: PutMethodResponse -> String
showsPrec :: Int -> PutMethodResponse -> ShowS
$cshowsPrec :: Int -> PutMethodResponse -> ShowS
Prelude.Show, forall x. Rep PutMethodResponse x -> PutMethodResponse
forall x. PutMethodResponse -> Rep PutMethodResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutMethodResponse x -> PutMethodResponse
$cfrom :: forall x. PutMethodResponse -> Rep PutMethodResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutMethodResponse' 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:
--
-- 'responseModels', 'putMethodResponse_responseModels' - Specifies the Model resources used for the response\'s content type.
-- Response models are represented as a key\/value map, with a content type
-- as the key and a Model name as the value.
--
-- 'responseParameters', 'putMethodResponse_responseParameters' - A key-value map specifying required or optional response parameters that
-- API Gateway can send back to the caller. A key defines a method response
-- header name and the associated value is a Boolean flag indicating
-- whether the method response parameter is required or not. The method
-- response header names must match the pattern of
-- @method.response.header.{name}@, where @name@ is a valid and unique
-- header name. The response parameter names defined here are available in
-- the integration response to be mapped from an integration response
-- header expressed in @integration.response.header.{name}@, a static value
-- enclosed within a pair of single quotes (e.g., @\'application\/json\'@),
-- or a JSON expression from the back-end response payload in the form of
-- @integration.response.body.{JSON-expression}@, where @JSON-expression@
-- is a valid JSON expression without the @$@ prefix.)
--
-- 'restApiId', 'putMethodResponse_restApiId' - The string identifier of the associated RestApi.
--
-- 'resourceId', 'putMethodResponse_resourceId' - The Resource identifier for the Method resource.
--
-- 'httpMethod', 'putMethodResponse_httpMethod' - The HTTP verb of the Method resource.
--
-- 'statusCode', 'putMethodResponse_statusCode' - The method response\'s status code.
newPutMethodResponse ::
  -- | 'restApiId'
  Prelude.Text ->
  -- | 'resourceId'
  Prelude.Text ->
  -- | 'httpMethod'
  Prelude.Text ->
  -- | 'statusCode'
  Prelude.Text ->
  PutMethodResponse
newPutMethodResponse :: Text -> Text -> Text -> Text -> PutMethodResponse
newPutMethodResponse
  Text
pRestApiId_
  Text
pResourceId_
  Text
pHttpMethod_
  Text
pStatusCode_ =
    PutMethodResponse'
      { $sel:responseModels:PutMethodResponse' :: Maybe (HashMap Text Text)
responseModels =
          forall a. Maybe a
Prelude.Nothing,
        $sel:responseParameters:PutMethodResponse' :: Maybe (HashMap Text Bool)
responseParameters = forall a. Maybe a
Prelude.Nothing,
        $sel:restApiId:PutMethodResponse' :: Text
restApiId = Text
pRestApiId_,
        $sel:resourceId:PutMethodResponse' :: Text
resourceId = Text
pResourceId_,
        $sel:httpMethod:PutMethodResponse' :: Text
httpMethod = Text
pHttpMethod_,
        $sel:statusCode:PutMethodResponse' :: Text
statusCode = Text
pStatusCode_
      }

-- | Specifies the Model resources used for the response\'s content type.
-- Response models are represented as a key\/value map, with a content type
-- as the key and a Model name as the value.
putMethodResponse_responseModels :: Lens.Lens' PutMethodResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putMethodResponse_responseModels :: Lens' PutMethodResponse (Maybe (HashMap Text Text))
putMethodResponse_responseModels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMethodResponse' {Maybe (HashMap Text Text)
responseModels :: Maybe (HashMap Text Text)
$sel:responseModels:PutMethodResponse' :: PutMethodResponse -> Maybe (HashMap Text Text)
responseModels} -> Maybe (HashMap Text Text)
responseModels) (\s :: PutMethodResponse
s@PutMethodResponse' {} Maybe (HashMap Text Text)
a -> PutMethodResponse
s {$sel:responseModels:PutMethodResponse' :: Maybe (HashMap Text Text)
responseModels = Maybe (HashMap Text Text)
a} :: PutMethodResponse) 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

-- | A key-value map specifying required or optional response parameters that
-- API Gateway can send back to the caller. A key defines a method response
-- header name and the associated value is a Boolean flag indicating
-- whether the method response parameter is required or not. The method
-- response header names must match the pattern of
-- @method.response.header.{name}@, where @name@ is a valid and unique
-- header name. The response parameter names defined here are available in
-- the integration response to be mapped from an integration response
-- header expressed in @integration.response.header.{name}@, a static value
-- enclosed within a pair of single quotes (e.g., @\'application\/json\'@),
-- or a JSON expression from the back-end response payload in the form of
-- @integration.response.body.{JSON-expression}@, where @JSON-expression@
-- is a valid JSON expression without the @$@ prefix.)
putMethodResponse_responseParameters :: Lens.Lens' PutMethodResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Bool))
putMethodResponse_responseParameters :: Lens' PutMethodResponse (Maybe (HashMap Text Bool))
putMethodResponse_responseParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMethodResponse' {Maybe (HashMap Text Bool)
responseParameters :: Maybe (HashMap Text Bool)
$sel:responseParameters:PutMethodResponse' :: PutMethodResponse -> Maybe (HashMap Text Bool)
responseParameters} -> Maybe (HashMap Text Bool)
responseParameters) (\s :: PutMethodResponse
s@PutMethodResponse' {} Maybe (HashMap Text Bool)
a -> PutMethodResponse
s {$sel:responseParameters:PutMethodResponse' :: Maybe (HashMap Text Bool)
responseParameters = Maybe (HashMap Text Bool)
a} :: PutMethodResponse) 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.
putMethodResponse_restApiId :: Lens.Lens' PutMethodResponse Prelude.Text
putMethodResponse_restApiId :: Lens' PutMethodResponse Text
putMethodResponse_restApiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMethodResponse' {Text
restApiId :: Text
$sel:restApiId:PutMethodResponse' :: PutMethodResponse -> Text
restApiId} -> Text
restApiId) (\s :: PutMethodResponse
s@PutMethodResponse' {} Text
a -> PutMethodResponse
s {$sel:restApiId:PutMethodResponse' :: Text
restApiId = Text
a} :: PutMethodResponse)

-- | The Resource identifier for the Method resource.
putMethodResponse_resourceId :: Lens.Lens' PutMethodResponse Prelude.Text
putMethodResponse_resourceId :: Lens' PutMethodResponse Text
putMethodResponse_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMethodResponse' {Text
resourceId :: Text
$sel:resourceId:PutMethodResponse' :: PutMethodResponse -> Text
resourceId} -> Text
resourceId) (\s :: PutMethodResponse
s@PutMethodResponse' {} Text
a -> PutMethodResponse
s {$sel:resourceId:PutMethodResponse' :: Text
resourceId = Text
a} :: PutMethodResponse)

-- | The HTTP verb of the Method resource.
putMethodResponse_httpMethod :: Lens.Lens' PutMethodResponse Prelude.Text
putMethodResponse_httpMethod :: Lens' PutMethodResponse Text
putMethodResponse_httpMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMethodResponse' {Text
httpMethod :: Text
$sel:httpMethod:PutMethodResponse' :: PutMethodResponse -> Text
httpMethod} -> Text
httpMethod) (\s :: PutMethodResponse
s@PutMethodResponse' {} Text
a -> PutMethodResponse
s {$sel:httpMethod:PutMethodResponse' :: Text
httpMethod = Text
a} :: PutMethodResponse)

-- | The method response\'s status code.
putMethodResponse_statusCode :: Lens.Lens' PutMethodResponse Prelude.Text
putMethodResponse_statusCode :: Lens' PutMethodResponse Text
putMethodResponse_statusCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutMethodResponse' {Text
statusCode :: Text
$sel:statusCode:PutMethodResponse' :: PutMethodResponse -> Text
statusCode} -> Text
statusCode) (\s :: PutMethodResponse
s@PutMethodResponse' {} Text
a -> PutMethodResponse
s {$sel:statusCode:PutMethodResponse' :: Text
statusCode = Text
a} :: PutMethodResponse)

instance Core.AWSRequest PutMethodResponse where
  type AWSResponse PutMethodResponse = MethodResponse
  request :: (Service -> Service)
-> PutMethodResponse -> Request PutMethodResponse
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 PutMethodResponse
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutMethodResponse)))
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 PutMethodResponse where
  hashWithSalt :: Int -> PutMethodResponse -> Int
hashWithSalt Int
_salt PutMethodResponse' {Maybe (HashMap Text Bool)
Maybe (HashMap Text Text)
Text
statusCode :: Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
responseParameters :: Maybe (HashMap Text Bool)
responseModels :: Maybe (HashMap Text Text)
$sel:statusCode:PutMethodResponse' :: PutMethodResponse -> Text
$sel:httpMethod:PutMethodResponse' :: PutMethodResponse -> Text
$sel:resourceId:PutMethodResponse' :: PutMethodResponse -> Text
$sel:restApiId:PutMethodResponse' :: PutMethodResponse -> Text
$sel:responseParameters:PutMethodResponse' :: PutMethodResponse -> Maybe (HashMap Text Bool)
$sel:responseModels:PutMethodResponse' :: PutMethodResponse -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
responseModels
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Bool)
responseParameters
      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 PutMethodResponse where
  rnf :: PutMethodResponse -> ()
rnf PutMethodResponse' {Maybe (HashMap Text Bool)
Maybe (HashMap Text Text)
Text
statusCode :: Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
responseParameters :: Maybe (HashMap Text Bool)
responseModels :: Maybe (HashMap Text Text)
$sel:statusCode:PutMethodResponse' :: PutMethodResponse -> Text
$sel:httpMethod:PutMethodResponse' :: PutMethodResponse -> Text
$sel:resourceId:PutMethodResponse' :: PutMethodResponse -> Text
$sel:restApiId:PutMethodResponse' :: PutMethodResponse -> Text
$sel:responseParameters:PutMethodResponse' :: PutMethodResponse -> Maybe (HashMap Text Bool)
$sel:responseModels:PutMethodResponse' :: PutMethodResponse -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
responseModels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Bool)
responseParameters
      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 PutMethodResponse where
  toHeaders :: PutMethodResponse -> 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 PutMethodResponse where
  toJSON :: PutMethodResponse -> Value
toJSON PutMethodResponse' {Maybe (HashMap Text Bool)
Maybe (HashMap Text Text)
Text
statusCode :: Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
responseParameters :: Maybe (HashMap Text Bool)
responseModels :: Maybe (HashMap Text Text)
$sel:statusCode:PutMethodResponse' :: PutMethodResponse -> Text
$sel:httpMethod:PutMethodResponse' :: PutMethodResponse -> Text
$sel:resourceId:PutMethodResponse' :: PutMethodResponse -> Text
$sel:restApiId:PutMethodResponse' :: PutMethodResponse -> Text
$sel:responseParameters:PutMethodResponse' :: PutMethodResponse -> Maybe (HashMap Text Bool)
$sel:responseModels:PutMethodResponse' :: PutMethodResponse -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"responseModels" 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)
responseModels,
            (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 Bool)
responseParameters
          ]
      )

instance Data.ToPath PutMethodResponse where
  toPath :: PutMethodResponse -> ByteString
toPath PutMethodResponse' {Maybe (HashMap Text Bool)
Maybe (HashMap Text Text)
Text
statusCode :: Text
httpMethod :: Text
resourceId :: Text
restApiId :: Text
responseParameters :: Maybe (HashMap Text Bool)
responseModels :: Maybe (HashMap Text Text)
$sel:statusCode:PutMethodResponse' :: PutMethodResponse -> Text
$sel:httpMethod:PutMethodResponse' :: PutMethodResponse -> Text
$sel:resourceId:PutMethodResponse' :: PutMethodResponse -> Text
$sel:restApiId:PutMethodResponse' :: PutMethodResponse -> Text
$sel:responseParameters:PutMethodResponse' :: PutMethodResponse -> Maybe (HashMap Text Bool)
$sel:responseModels:PutMethodResponse' :: PutMethodResponse -> 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
"/resources/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
resourceId,
        ByteString
"/methods/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
httpMethod,
        ByteString
"/responses/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
statusCode
      ]

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