{-# 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.GameLift.UpdateBuild
(
UpdateBuild (..),
newUpdateBuild,
updateBuild_name,
updateBuild_version,
updateBuild_buildId,
UpdateBuildResponse (..),
newUpdateBuildResponse,
updateBuildResponse_build,
updateBuildResponse_httpStatus,
)
where
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.GameLift.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
data UpdateBuild = UpdateBuild'
{
UpdateBuild -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
UpdateBuild -> Maybe Text
version :: Prelude.Maybe Prelude.Text,
UpdateBuild -> Text
buildId :: Prelude.Text
}
deriving (UpdateBuild -> UpdateBuild -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBuild -> UpdateBuild -> Bool
$c/= :: UpdateBuild -> UpdateBuild -> Bool
== :: UpdateBuild -> UpdateBuild -> Bool
$c== :: UpdateBuild -> UpdateBuild -> Bool
Prelude.Eq, ReadPrec [UpdateBuild]
ReadPrec UpdateBuild
Int -> ReadS UpdateBuild
ReadS [UpdateBuild]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateBuild]
$creadListPrec :: ReadPrec [UpdateBuild]
readPrec :: ReadPrec UpdateBuild
$creadPrec :: ReadPrec UpdateBuild
readList :: ReadS [UpdateBuild]
$creadList :: ReadS [UpdateBuild]
readsPrec :: Int -> ReadS UpdateBuild
$creadsPrec :: Int -> ReadS UpdateBuild
Prelude.Read, Int -> UpdateBuild -> ShowS
[UpdateBuild] -> ShowS
UpdateBuild -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBuild] -> ShowS
$cshowList :: [UpdateBuild] -> ShowS
show :: UpdateBuild -> String
$cshow :: UpdateBuild -> String
showsPrec :: Int -> UpdateBuild -> ShowS
$cshowsPrec :: Int -> UpdateBuild -> ShowS
Prelude.Show, forall x. Rep UpdateBuild x -> UpdateBuild
forall x. UpdateBuild -> Rep UpdateBuild x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBuild x -> UpdateBuild
$cfrom :: forall x. UpdateBuild -> Rep UpdateBuild x
Prelude.Generic)
newUpdateBuild ::
Prelude.Text ->
UpdateBuild
newUpdateBuild :: Text -> UpdateBuild
newUpdateBuild Text
pBuildId_ =
UpdateBuild'
{ $sel:name:UpdateBuild' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
$sel:version:UpdateBuild' :: Maybe Text
version = forall a. Maybe a
Prelude.Nothing,
$sel:buildId:UpdateBuild' :: Text
buildId = Text
pBuildId_
}
updateBuild_name :: Lens.Lens' UpdateBuild (Prelude.Maybe Prelude.Text)
updateBuild_name :: Lens' UpdateBuild (Maybe Text)
updateBuild_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBuild' {Maybe Text
name :: Maybe Text
$sel:name:UpdateBuild' :: UpdateBuild -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateBuild
s@UpdateBuild' {} Maybe Text
a -> UpdateBuild
s {$sel:name:UpdateBuild' :: Maybe Text
name = Maybe Text
a} :: UpdateBuild)
updateBuild_version :: Lens.Lens' UpdateBuild (Prelude.Maybe Prelude.Text)
updateBuild_version :: Lens' UpdateBuild (Maybe Text)
updateBuild_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBuild' {Maybe Text
version :: Maybe Text
$sel:version:UpdateBuild' :: UpdateBuild -> Maybe Text
version} -> Maybe Text
version) (\s :: UpdateBuild
s@UpdateBuild' {} Maybe Text
a -> UpdateBuild
s {$sel:version:UpdateBuild' :: Maybe Text
version = Maybe Text
a} :: UpdateBuild)
updateBuild_buildId :: Lens.Lens' UpdateBuild Prelude.Text
updateBuild_buildId :: Lens' UpdateBuild Text
updateBuild_buildId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBuild' {Text
buildId :: Text
$sel:buildId:UpdateBuild' :: UpdateBuild -> Text
buildId} -> Text
buildId) (\s :: UpdateBuild
s@UpdateBuild' {} Text
a -> UpdateBuild
s {$sel:buildId:UpdateBuild' :: Text
buildId = Text
a} :: UpdateBuild)
instance Core.AWSRequest UpdateBuild where
type AWSResponse UpdateBuild = UpdateBuildResponse
request :: (Service -> Service) -> UpdateBuild -> Request UpdateBuild
request Service -> Service
overrides =
forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateBuild
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateBuild)))
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 ->
Maybe Build -> Int -> UpdateBuildResponse
UpdateBuildResponse'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Build")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
)
instance Prelude.Hashable UpdateBuild where
hashWithSalt :: Int -> UpdateBuild -> Int
hashWithSalt Int
_salt UpdateBuild' {Maybe Text
Text
buildId :: Text
version :: Maybe Text
name :: Maybe Text
$sel:buildId:UpdateBuild' :: UpdateBuild -> Text
$sel:version:UpdateBuild' :: UpdateBuild -> Maybe Text
$sel:name:UpdateBuild' :: UpdateBuild -> Maybe Text
..} =
Int
_salt
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
version
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
buildId
instance Prelude.NFData UpdateBuild where
rnf :: UpdateBuild -> ()
rnf UpdateBuild' {Maybe Text
Text
buildId :: Text
version :: Maybe Text
name :: Maybe Text
$sel:buildId:UpdateBuild' :: UpdateBuild -> Text
$sel:version:UpdateBuild' :: UpdateBuild -> Maybe Text
$sel:name:UpdateBuild' :: UpdateBuild -> Maybe Text
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
version
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
buildId
instance Data.ToHeaders UpdateBuild where
toHeaders :: UpdateBuild -> ResponseHeaders
toHeaders =
forall a b. a -> b -> a
Prelude.const
( forall a. Monoid a => [a] -> a
Prelude.mconcat
[ HeaderName
"X-Amz-Target"
forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"GameLift.UpdateBuild" :: Prelude.ByteString),
HeaderName
"Content-Type"
forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
Prelude.ByteString
)
]
)
instance Data.ToJSON UpdateBuild where
toJSON :: UpdateBuild -> Value
toJSON UpdateBuild' {Maybe Text
Text
buildId :: Text
version :: Maybe Text
name :: Maybe Text
$sel:buildId:UpdateBuild' :: UpdateBuild -> Text
$sel:version:UpdateBuild' :: UpdateBuild -> Maybe Text
$sel:name:UpdateBuild' :: UpdateBuild -> Maybe Text
..} =
[Pair] -> Value
Data.object
( forall a. [Maybe a] -> [a]
Prelude.catMaybes
[ (Key
"Name" 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
name,
(Key
"Version" 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
version,
forall a. a -> Maybe a
Prelude.Just (Key
"BuildId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
buildId)
]
)
instance Data.ToPath UpdateBuild where
toPath :: UpdateBuild -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"
instance Data.ToQuery UpdateBuild where
toQuery :: UpdateBuild -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty
data UpdateBuildResponse = UpdateBuildResponse'
{
UpdateBuildResponse -> Maybe Build
build :: Prelude.Maybe Build,
UpdateBuildResponse -> Int
httpStatus :: Prelude.Int
}
deriving (UpdateBuildResponse -> UpdateBuildResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBuildResponse -> UpdateBuildResponse -> Bool
$c/= :: UpdateBuildResponse -> UpdateBuildResponse -> Bool
== :: UpdateBuildResponse -> UpdateBuildResponse -> Bool
$c== :: UpdateBuildResponse -> UpdateBuildResponse -> Bool
Prelude.Eq, ReadPrec [UpdateBuildResponse]
ReadPrec UpdateBuildResponse
Int -> ReadS UpdateBuildResponse
ReadS [UpdateBuildResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateBuildResponse]
$creadListPrec :: ReadPrec [UpdateBuildResponse]
readPrec :: ReadPrec UpdateBuildResponse
$creadPrec :: ReadPrec UpdateBuildResponse
readList :: ReadS [UpdateBuildResponse]
$creadList :: ReadS [UpdateBuildResponse]
readsPrec :: Int -> ReadS UpdateBuildResponse
$creadsPrec :: Int -> ReadS UpdateBuildResponse
Prelude.Read, Int -> UpdateBuildResponse -> ShowS
[UpdateBuildResponse] -> ShowS
UpdateBuildResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBuildResponse] -> ShowS
$cshowList :: [UpdateBuildResponse] -> ShowS
show :: UpdateBuildResponse -> String
$cshow :: UpdateBuildResponse -> String
showsPrec :: Int -> UpdateBuildResponse -> ShowS
$cshowsPrec :: Int -> UpdateBuildResponse -> ShowS
Prelude.Show, forall x. Rep UpdateBuildResponse x -> UpdateBuildResponse
forall x. UpdateBuildResponse -> Rep UpdateBuildResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBuildResponse x -> UpdateBuildResponse
$cfrom :: forall x. UpdateBuildResponse -> Rep UpdateBuildResponse x
Prelude.Generic)
newUpdateBuildResponse ::
Prelude.Int ->
UpdateBuildResponse
newUpdateBuildResponse :: Int -> UpdateBuildResponse
newUpdateBuildResponse Int
pHttpStatus_ =
UpdateBuildResponse'
{ $sel:build:UpdateBuildResponse' :: Maybe Build
build = forall a. Maybe a
Prelude.Nothing,
$sel:httpStatus:UpdateBuildResponse' :: Int
httpStatus = Int
pHttpStatus_
}
updateBuildResponse_build :: Lens.Lens' UpdateBuildResponse (Prelude.Maybe Build)
updateBuildResponse_build :: Lens' UpdateBuildResponse (Maybe Build)
updateBuildResponse_build = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBuildResponse' {Maybe Build
build :: Maybe Build
$sel:build:UpdateBuildResponse' :: UpdateBuildResponse -> Maybe Build
build} -> Maybe Build
build) (\s :: UpdateBuildResponse
s@UpdateBuildResponse' {} Maybe Build
a -> UpdateBuildResponse
s {$sel:build:UpdateBuildResponse' :: Maybe Build
build = Maybe Build
a} :: UpdateBuildResponse)
updateBuildResponse_httpStatus :: Lens.Lens' UpdateBuildResponse Prelude.Int
updateBuildResponse_httpStatus :: Lens' UpdateBuildResponse Int
updateBuildResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBuildResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateBuildResponse' :: UpdateBuildResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateBuildResponse
s@UpdateBuildResponse' {} Int
a -> UpdateBuildResponse
s {$sel:httpStatus:UpdateBuildResponse' :: Int
httpStatus = Int
a} :: UpdateBuildResponse)
instance Prelude.NFData UpdateBuildResponse where
rnf :: UpdateBuildResponse -> ()
rnf UpdateBuildResponse' {Int
Maybe Build
httpStatus :: Int
build :: Maybe Build
$sel:httpStatus:UpdateBuildResponse' :: UpdateBuildResponse -> Int
$sel:build:UpdateBuildResponse' :: UpdateBuildResponse -> Maybe Build
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe Build
build
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus