{-# 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.UpdateScript
(
UpdateScript (..),
newUpdateScript,
updateScript_name,
updateScript_storageLocation,
updateScript_version,
updateScript_zipFile,
updateScript_scriptId,
UpdateScriptResponse (..),
newUpdateScriptResponse,
updateScriptResponse_script,
updateScriptResponse_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 UpdateScript = UpdateScript'
{
UpdateScript -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
UpdateScript -> Maybe S3Location
storageLocation :: Prelude.Maybe S3Location,
UpdateScript -> Maybe Text
version :: Prelude.Maybe Prelude.Text,
UpdateScript -> Maybe Base64
zipFile :: Prelude.Maybe Data.Base64,
UpdateScript -> Text
scriptId :: Prelude.Text
}
deriving (UpdateScript -> UpdateScript -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateScript -> UpdateScript -> Bool
$c/= :: UpdateScript -> UpdateScript -> Bool
== :: UpdateScript -> UpdateScript -> Bool
$c== :: UpdateScript -> UpdateScript -> Bool
Prelude.Eq, ReadPrec [UpdateScript]
ReadPrec UpdateScript
Int -> ReadS UpdateScript
ReadS [UpdateScript]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateScript]
$creadListPrec :: ReadPrec [UpdateScript]
readPrec :: ReadPrec UpdateScript
$creadPrec :: ReadPrec UpdateScript
readList :: ReadS [UpdateScript]
$creadList :: ReadS [UpdateScript]
readsPrec :: Int -> ReadS UpdateScript
$creadsPrec :: Int -> ReadS UpdateScript
Prelude.Read, Int -> UpdateScript -> ShowS
[UpdateScript] -> ShowS
UpdateScript -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateScript] -> ShowS
$cshowList :: [UpdateScript] -> ShowS
show :: UpdateScript -> String
$cshow :: UpdateScript -> String
showsPrec :: Int -> UpdateScript -> ShowS
$cshowsPrec :: Int -> UpdateScript -> ShowS
Prelude.Show, forall x. Rep UpdateScript x -> UpdateScript
forall x. UpdateScript -> Rep UpdateScript x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateScript x -> UpdateScript
$cfrom :: forall x. UpdateScript -> Rep UpdateScript x
Prelude.Generic)
newUpdateScript ::
Prelude.Text ->
UpdateScript
newUpdateScript :: Text -> UpdateScript
newUpdateScript Text
pScriptId_ =
UpdateScript'
{ $sel:name:UpdateScript' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
$sel:storageLocation:UpdateScript' :: Maybe S3Location
storageLocation = forall a. Maybe a
Prelude.Nothing,
$sel:version:UpdateScript' :: Maybe Text
version = forall a. Maybe a
Prelude.Nothing,
$sel:zipFile:UpdateScript' :: Maybe Base64
zipFile = forall a. Maybe a
Prelude.Nothing,
$sel:scriptId:UpdateScript' :: Text
scriptId = Text
pScriptId_
}
updateScript_name :: Lens.Lens' UpdateScript (Prelude.Maybe Prelude.Text)
updateScript_name :: Lens' UpdateScript (Maybe Text)
updateScript_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateScript' {Maybe Text
name :: Maybe Text
$sel:name:UpdateScript' :: UpdateScript -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateScript
s@UpdateScript' {} Maybe Text
a -> UpdateScript
s {$sel:name:UpdateScript' :: Maybe Text
name = Maybe Text
a} :: UpdateScript)
updateScript_storageLocation :: Lens.Lens' UpdateScript (Prelude.Maybe S3Location)
updateScript_storageLocation :: Lens' UpdateScript (Maybe S3Location)
updateScript_storageLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateScript' {Maybe S3Location
storageLocation :: Maybe S3Location
$sel:storageLocation:UpdateScript' :: UpdateScript -> Maybe S3Location
storageLocation} -> Maybe S3Location
storageLocation) (\s :: UpdateScript
s@UpdateScript' {} Maybe S3Location
a -> UpdateScript
s {$sel:storageLocation:UpdateScript' :: Maybe S3Location
storageLocation = Maybe S3Location
a} :: UpdateScript)
updateScript_version :: Lens.Lens' UpdateScript (Prelude.Maybe Prelude.Text)
updateScript_version :: Lens' UpdateScript (Maybe Text)
updateScript_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateScript' {Maybe Text
version :: Maybe Text
$sel:version:UpdateScript' :: UpdateScript -> Maybe Text
version} -> Maybe Text
version) (\s :: UpdateScript
s@UpdateScript' {} Maybe Text
a -> UpdateScript
s {$sel:version:UpdateScript' :: Maybe Text
version = Maybe Text
a} :: UpdateScript)
updateScript_zipFile :: Lens.Lens' UpdateScript (Prelude.Maybe Prelude.ByteString)
updateScript_zipFile :: Lens' UpdateScript (Maybe ByteString)
updateScript_zipFile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateScript' {Maybe Base64
zipFile :: Maybe Base64
$sel:zipFile:UpdateScript' :: UpdateScript -> Maybe Base64
zipFile} -> Maybe Base64
zipFile) (\s :: UpdateScript
s@UpdateScript' {} Maybe Base64
a -> UpdateScript
s {$sel:zipFile:UpdateScript' :: Maybe Base64
zipFile = Maybe Base64
a} :: UpdateScript) 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 Iso' Base64 ByteString
Data._Base64
updateScript_scriptId :: Lens.Lens' UpdateScript Prelude.Text
updateScript_scriptId :: Lens' UpdateScript Text
updateScript_scriptId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateScript' {Text
scriptId :: Text
$sel:scriptId:UpdateScript' :: UpdateScript -> Text
scriptId} -> Text
scriptId) (\s :: UpdateScript
s@UpdateScript' {} Text
a -> UpdateScript
s {$sel:scriptId:UpdateScript' :: Text
scriptId = Text
a} :: UpdateScript)
instance Core.AWSRequest UpdateScript where
type AWSResponse UpdateScript = UpdateScriptResponse
request :: (Service -> Service) -> UpdateScript -> Request UpdateScript
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 UpdateScript
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateScript)))
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 Script -> Int -> UpdateScriptResponse
UpdateScriptResponse'
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
"Script")
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 UpdateScript where
hashWithSalt :: Int -> UpdateScript -> Int
hashWithSalt Int
_salt UpdateScript' {Maybe Text
Maybe Base64
Maybe S3Location
Text
scriptId :: Text
zipFile :: Maybe Base64
version :: Maybe Text
storageLocation :: Maybe S3Location
name :: Maybe Text
$sel:scriptId:UpdateScript' :: UpdateScript -> Text
$sel:zipFile:UpdateScript' :: UpdateScript -> Maybe Base64
$sel:version:UpdateScript' :: UpdateScript -> Maybe Text
$sel:storageLocation:UpdateScript' :: UpdateScript -> Maybe S3Location
$sel:name:UpdateScript' :: UpdateScript -> 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 S3Location
storageLocation
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
version
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Base64
zipFile
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
scriptId
instance Prelude.NFData UpdateScript where
rnf :: UpdateScript -> ()
rnf UpdateScript' {Maybe Text
Maybe Base64
Maybe S3Location
Text
scriptId :: Text
zipFile :: Maybe Base64
version :: Maybe Text
storageLocation :: Maybe S3Location
name :: Maybe Text
$sel:scriptId:UpdateScript' :: UpdateScript -> Text
$sel:zipFile:UpdateScript' :: UpdateScript -> Maybe Base64
$sel:version:UpdateScript' :: UpdateScript -> Maybe Text
$sel:storageLocation:UpdateScript' :: UpdateScript -> Maybe S3Location
$sel:name:UpdateScript' :: UpdateScript -> 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 S3Location
storageLocation
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 Maybe Base64
zipFile
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
scriptId
instance Data.ToHeaders UpdateScript where
toHeaders :: UpdateScript -> 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.UpdateScript" :: 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 UpdateScript where
toJSON :: UpdateScript -> Value
toJSON UpdateScript' {Maybe Text
Maybe Base64
Maybe S3Location
Text
scriptId :: Text
zipFile :: Maybe Base64
version :: Maybe Text
storageLocation :: Maybe S3Location
name :: Maybe Text
$sel:scriptId:UpdateScript' :: UpdateScript -> Text
$sel:zipFile:UpdateScript' :: UpdateScript -> Maybe Base64
$sel:version:UpdateScript' :: UpdateScript -> Maybe Text
$sel:storageLocation:UpdateScript' :: UpdateScript -> Maybe S3Location
$sel:name:UpdateScript' :: UpdateScript -> 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
"StorageLocation" 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 S3Location
storageLocation,
(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,
(Key
"ZipFile" 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 Base64
zipFile,
forall a. a -> Maybe a
Prelude.Just (Key
"ScriptId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
scriptId)
]
)
instance Data.ToPath UpdateScript where
toPath :: UpdateScript -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"
instance Data.ToQuery UpdateScript where
toQuery :: UpdateScript -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty
data UpdateScriptResponse = UpdateScriptResponse'
{
UpdateScriptResponse -> Maybe Script
script :: Prelude.Maybe Script,
UpdateScriptResponse -> Int
httpStatus :: Prelude.Int
}
deriving (UpdateScriptResponse -> UpdateScriptResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateScriptResponse -> UpdateScriptResponse -> Bool
$c/= :: UpdateScriptResponse -> UpdateScriptResponse -> Bool
== :: UpdateScriptResponse -> UpdateScriptResponse -> Bool
$c== :: UpdateScriptResponse -> UpdateScriptResponse -> Bool
Prelude.Eq, ReadPrec [UpdateScriptResponse]
ReadPrec UpdateScriptResponse
Int -> ReadS UpdateScriptResponse
ReadS [UpdateScriptResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateScriptResponse]
$creadListPrec :: ReadPrec [UpdateScriptResponse]
readPrec :: ReadPrec UpdateScriptResponse
$creadPrec :: ReadPrec UpdateScriptResponse
readList :: ReadS [UpdateScriptResponse]
$creadList :: ReadS [UpdateScriptResponse]
readsPrec :: Int -> ReadS UpdateScriptResponse
$creadsPrec :: Int -> ReadS UpdateScriptResponse
Prelude.Read, Int -> UpdateScriptResponse -> ShowS
[UpdateScriptResponse] -> ShowS
UpdateScriptResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateScriptResponse] -> ShowS
$cshowList :: [UpdateScriptResponse] -> ShowS
show :: UpdateScriptResponse -> String
$cshow :: UpdateScriptResponse -> String
showsPrec :: Int -> UpdateScriptResponse -> ShowS
$cshowsPrec :: Int -> UpdateScriptResponse -> ShowS
Prelude.Show, forall x. Rep UpdateScriptResponse x -> UpdateScriptResponse
forall x. UpdateScriptResponse -> Rep UpdateScriptResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateScriptResponse x -> UpdateScriptResponse
$cfrom :: forall x. UpdateScriptResponse -> Rep UpdateScriptResponse x
Prelude.Generic)
newUpdateScriptResponse ::
Prelude.Int ->
UpdateScriptResponse
newUpdateScriptResponse :: Int -> UpdateScriptResponse
newUpdateScriptResponse Int
pHttpStatus_ =
UpdateScriptResponse'
{ $sel:script:UpdateScriptResponse' :: Maybe Script
script = forall a. Maybe a
Prelude.Nothing,
$sel:httpStatus:UpdateScriptResponse' :: Int
httpStatus = Int
pHttpStatus_
}
updateScriptResponse_script :: Lens.Lens' UpdateScriptResponse (Prelude.Maybe Script)
updateScriptResponse_script :: Lens' UpdateScriptResponse (Maybe Script)
updateScriptResponse_script = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateScriptResponse' {Maybe Script
script :: Maybe Script
$sel:script:UpdateScriptResponse' :: UpdateScriptResponse -> Maybe Script
script} -> Maybe Script
script) (\s :: UpdateScriptResponse
s@UpdateScriptResponse' {} Maybe Script
a -> UpdateScriptResponse
s {$sel:script:UpdateScriptResponse' :: Maybe Script
script = Maybe Script
a} :: UpdateScriptResponse)
updateScriptResponse_httpStatus :: Lens.Lens' UpdateScriptResponse Prelude.Int
updateScriptResponse_httpStatus :: Lens' UpdateScriptResponse Int
updateScriptResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateScriptResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateScriptResponse' :: UpdateScriptResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateScriptResponse
s@UpdateScriptResponse' {} Int
a -> UpdateScriptResponse
s {$sel:httpStatus:UpdateScriptResponse' :: Int
httpStatus = Int
a} :: UpdateScriptResponse)
instance Prelude.NFData UpdateScriptResponse where
rnf :: UpdateScriptResponse -> ()
rnf UpdateScriptResponse' {Int
Maybe Script
httpStatus :: Int
script :: Maybe Script
$sel:httpStatus:UpdateScriptResponse' :: UpdateScriptResponse -> Int
$sel:script:UpdateScriptResponse' :: UpdateScriptResponse -> Maybe Script
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe Script
script
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus