{-# 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.UpdateBasePathMapping
(
UpdateBasePathMapping (..),
newUpdateBasePathMapping,
updateBasePathMapping_patchOperations,
updateBasePathMapping_domainName,
updateBasePathMapping_basePath,
BasePathMapping (..),
newBasePathMapping,
basePathMapping_basePath,
basePathMapping_restApiId,
basePathMapping_stage,
)
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 UpdateBasePathMapping = UpdateBasePathMapping'
{
UpdateBasePathMapping -> Maybe [PatchOperation]
patchOperations :: Prelude.Maybe [PatchOperation],
UpdateBasePathMapping -> Text
domainName :: Prelude.Text,
UpdateBasePathMapping -> Text
basePath :: Prelude.Text
}
deriving (UpdateBasePathMapping -> UpdateBasePathMapping -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBasePathMapping -> UpdateBasePathMapping -> Bool
$c/= :: UpdateBasePathMapping -> UpdateBasePathMapping -> Bool
== :: UpdateBasePathMapping -> UpdateBasePathMapping -> Bool
$c== :: UpdateBasePathMapping -> UpdateBasePathMapping -> Bool
Prelude.Eq, ReadPrec [UpdateBasePathMapping]
ReadPrec UpdateBasePathMapping
Int -> ReadS UpdateBasePathMapping
ReadS [UpdateBasePathMapping]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateBasePathMapping]
$creadListPrec :: ReadPrec [UpdateBasePathMapping]
readPrec :: ReadPrec UpdateBasePathMapping
$creadPrec :: ReadPrec UpdateBasePathMapping
readList :: ReadS [UpdateBasePathMapping]
$creadList :: ReadS [UpdateBasePathMapping]
readsPrec :: Int -> ReadS UpdateBasePathMapping
$creadsPrec :: Int -> ReadS UpdateBasePathMapping
Prelude.Read, Int -> UpdateBasePathMapping -> ShowS
[UpdateBasePathMapping] -> ShowS
UpdateBasePathMapping -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBasePathMapping] -> ShowS
$cshowList :: [UpdateBasePathMapping] -> ShowS
show :: UpdateBasePathMapping -> String
$cshow :: UpdateBasePathMapping -> String
showsPrec :: Int -> UpdateBasePathMapping -> ShowS
$cshowsPrec :: Int -> UpdateBasePathMapping -> ShowS
Prelude.Show, forall x. Rep UpdateBasePathMapping x -> UpdateBasePathMapping
forall x. UpdateBasePathMapping -> Rep UpdateBasePathMapping x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBasePathMapping x -> UpdateBasePathMapping
$cfrom :: forall x. UpdateBasePathMapping -> Rep UpdateBasePathMapping x
Prelude.Generic)
newUpdateBasePathMapping ::
Prelude.Text ->
Prelude.Text ->
UpdateBasePathMapping
newUpdateBasePathMapping :: Text -> Text -> UpdateBasePathMapping
newUpdateBasePathMapping Text
pDomainName_ Text
pBasePath_ =
UpdateBasePathMapping'
{ $sel:patchOperations:UpdateBasePathMapping' :: Maybe [PatchOperation]
patchOperations =
forall a. Maybe a
Prelude.Nothing,
$sel:domainName:UpdateBasePathMapping' :: Text
domainName = Text
pDomainName_,
$sel:basePath:UpdateBasePathMapping' :: Text
basePath = Text
pBasePath_
}
updateBasePathMapping_patchOperations :: Lens.Lens' UpdateBasePathMapping (Prelude.Maybe [PatchOperation])
updateBasePathMapping_patchOperations :: Lens' UpdateBasePathMapping (Maybe [PatchOperation])
updateBasePathMapping_patchOperations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBasePathMapping' {Maybe [PatchOperation]
patchOperations :: Maybe [PatchOperation]
$sel:patchOperations:UpdateBasePathMapping' :: UpdateBasePathMapping -> Maybe [PatchOperation]
patchOperations} -> Maybe [PatchOperation]
patchOperations) (\s :: UpdateBasePathMapping
s@UpdateBasePathMapping' {} Maybe [PatchOperation]
a -> UpdateBasePathMapping
s {$sel:patchOperations:UpdateBasePathMapping' :: Maybe [PatchOperation]
patchOperations = Maybe [PatchOperation]
a} :: UpdateBasePathMapping) 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
updateBasePathMapping_domainName :: Lens.Lens' UpdateBasePathMapping Prelude.Text
updateBasePathMapping_domainName :: Lens' UpdateBasePathMapping Text
updateBasePathMapping_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBasePathMapping' {Text
domainName :: Text
$sel:domainName:UpdateBasePathMapping' :: UpdateBasePathMapping -> Text
domainName} -> Text
domainName) (\s :: UpdateBasePathMapping
s@UpdateBasePathMapping' {} Text
a -> UpdateBasePathMapping
s {$sel:domainName:UpdateBasePathMapping' :: Text
domainName = Text
a} :: UpdateBasePathMapping)
updateBasePathMapping_basePath :: Lens.Lens' UpdateBasePathMapping Prelude.Text
updateBasePathMapping_basePath :: Lens' UpdateBasePathMapping Text
updateBasePathMapping_basePath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBasePathMapping' {Text
basePath :: Text
$sel:basePath:UpdateBasePathMapping' :: UpdateBasePathMapping -> Text
basePath} -> Text
basePath) (\s :: UpdateBasePathMapping
s@UpdateBasePathMapping' {} Text
a -> UpdateBasePathMapping
s {$sel:basePath:UpdateBasePathMapping' :: Text
basePath = Text
a} :: UpdateBasePathMapping)
instance Core.AWSRequest UpdateBasePathMapping where
type
AWSResponse UpdateBasePathMapping =
BasePathMapping
request :: (Service -> Service)
-> UpdateBasePathMapping -> Request UpdateBasePathMapping
request Service -> Service
overrides =
forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateBasePathMapping
-> ClientResponse ClientBody
-> m (Either
Error (ClientResponse (AWSResponse UpdateBasePathMapping)))
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 UpdateBasePathMapping where
hashWithSalt :: Int -> UpdateBasePathMapping -> Int
hashWithSalt Int
_salt UpdateBasePathMapping' {Maybe [PatchOperation]
Text
basePath :: Text
domainName :: Text
patchOperations :: Maybe [PatchOperation]
$sel:basePath:UpdateBasePathMapping' :: UpdateBasePathMapping -> Text
$sel:domainName:UpdateBasePathMapping' :: UpdateBasePathMapping -> Text
$sel:patchOperations:UpdateBasePathMapping' :: UpdateBasePathMapping -> Maybe [PatchOperation]
..} =
Int
_salt
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PatchOperation]
patchOperations
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
basePath
instance Prelude.NFData UpdateBasePathMapping where
rnf :: UpdateBasePathMapping -> ()
rnf UpdateBasePathMapping' {Maybe [PatchOperation]
Text
basePath :: Text
domainName :: Text
patchOperations :: Maybe [PatchOperation]
$sel:basePath:UpdateBasePathMapping' :: UpdateBasePathMapping -> Text
$sel:domainName:UpdateBasePathMapping' :: UpdateBasePathMapping -> Text
$sel:patchOperations:UpdateBasePathMapping' :: UpdateBasePathMapping -> Maybe [PatchOperation]
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe [PatchOperation]
patchOperations
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
basePath
instance Data.ToHeaders UpdateBasePathMapping where
toHeaders :: UpdateBasePathMapping -> 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 UpdateBasePathMapping where
toJSON :: UpdateBasePathMapping -> Value
toJSON UpdateBasePathMapping' {Maybe [PatchOperation]
Text
basePath :: Text
domainName :: Text
patchOperations :: Maybe [PatchOperation]
$sel:basePath:UpdateBasePathMapping' :: UpdateBasePathMapping -> Text
$sel:domainName:UpdateBasePathMapping' :: UpdateBasePathMapping -> Text
$sel:patchOperations:UpdateBasePathMapping' :: UpdateBasePathMapping -> Maybe [PatchOperation]
..} =
[Pair] -> Value
Data.object
( forall a. [Maybe a] -> [a]
Prelude.catMaybes
[ (Key
"patchOperations" 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 [PatchOperation]
patchOperations
]
)
instance Data.ToPath UpdateBasePathMapping where
toPath :: UpdateBasePathMapping -> ByteString
toPath UpdateBasePathMapping' {Maybe [PatchOperation]
Text
basePath :: Text
domainName :: Text
patchOperations :: Maybe [PatchOperation]
$sel:basePath:UpdateBasePathMapping' :: UpdateBasePathMapping -> Text
$sel:domainName:UpdateBasePathMapping' :: UpdateBasePathMapping -> Text
$sel:patchOperations:UpdateBasePathMapping' :: UpdateBasePathMapping -> Maybe [PatchOperation]
..} =
forall a. Monoid a => [a] -> a
Prelude.mconcat
[ ByteString
"/domainnames/",
forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName,
ByteString
"/basepathmappings/",
forall a. ToByteString a => a -> ByteString
Data.toBS Text
basePath
]
instance Data.ToQuery UpdateBasePathMapping where
toQuery :: UpdateBasePathMapping -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty