{-# 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 #-}
module Amazonka.APIGateway.PutGatewayResponse
(
PutGatewayResponse (..),
newPutGatewayResponse,
putGatewayResponse_responseParameters,
putGatewayResponse_responseTemplates,
putGatewayResponse_statusCode,
putGatewayResponse_restApiId,
putGatewayResponse_responseType,
GatewayResponse (..),
newGatewayResponse,
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
data PutGatewayResponse = PutGatewayResponse'
{
PutGatewayResponse -> Maybe (HashMap Text Text)
responseParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
PutGatewayResponse -> Maybe (HashMap Text Text)
responseTemplates :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
PutGatewayResponse -> Maybe Text
statusCode :: Prelude.Maybe Prelude.Text,
PutGatewayResponse -> Text
restApiId :: Prelude.Text,
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)
newPutGatewayResponse ::
Prelude.Text ->
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_
}
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
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
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)
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)
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