{-# 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.GameLift.CreateScript
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new script record for your Realtime Servers script. Realtime
-- scripts are JavaScript that provide configuration settings and optional
-- custom game logic for your game. The script is deployed when you create
-- a Realtime Servers fleet to host your game sessions. Script logic is
-- executed during an active game session.
--
-- To create a new script record, specify a script name and provide the
-- script file(s). The script files and all dependencies must be zipped
-- into a single file. You can pull the zip file from either of these
-- locations:
--
-- -   A locally available directory. Use the /ZipFile/ parameter for this
--     option.
--
-- -   An Amazon Simple Storage Service (Amazon S3) bucket under your
--     Amazon Web Services account. Use the /StorageLocation/ parameter for
--     this option. You\'ll need to have an Identity Access Management
--     (IAM) role that allows the Amazon GameLift service to access your S3
--     bucket.
--
-- If the call is successful, a new script record is created with a unique
-- script ID. If the script file is provided as a local file, the file is
-- uploaded to an Amazon GameLift-owned S3 bucket and the script record\'s
-- storage location reflects this location. If the script file is provided
-- as an S3 bucket, Amazon GameLift accesses the file at this storage
-- location as needed for deployment.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/realtime-intro.html Amazon GameLift Realtime Servers>
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/setting-up-role.html Set Up a Role for Amazon GameLift Access>
--
-- __Related actions__
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/reference-awssdk.html#reference-awssdk-resources-fleets All APIs by task>
module Amazonka.GameLift.CreateScript
  ( -- * Creating a Request
    CreateScript (..),
    newCreateScript,

    -- * Request Lenses
    createScript_name,
    createScript_storageLocation,
    createScript_tags,
    createScript_version,
    createScript_zipFile,

    -- * Destructuring the Response
    CreateScriptResponse (..),
    newCreateScriptResponse,

    -- * Response Lenses
    createScriptResponse_script,
    createScriptResponse_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

-- | /See:/ 'newCreateScript' smart constructor.
data CreateScript = CreateScript'
  { -- | A descriptive label that is associated with a script. Script names do
    -- not need to be unique. You can use
    -- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_UpdateScript.html UpdateScript>
    -- to change this value later.
    CreateScript -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The location of the Amazon S3 bucket where a zipped file containing your
    -- Realtime scripts is stored. The storage location must specify the Amazon
    -- S3 bucket name, the zip file name (the \"key\"), and a role ARN that
    -- allows Amazon GameLift to access the Amazon S3 storage location. The S3
    -- bucket must be in the same Region where you want to create a new script.
    -- By default, Amazon GameLift uploads the latest version of the zip file;
    -- if you have S3 object versioning turned on, you can use the
    -- @ObjectVersion@ parameter to specify an earlier version.
    CreateScript -> Maybe S3Location
storageLocation :: Prelude.Maybe S3Location,
    -- | A list of labels to assign to the new script resource. Tags are
    -- developer-defined key-value pairs. Tagging Amazon Web Services resources
    -- are useful for resource management, access management and cost
    -- allocation. For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
    -- in the /Amazon Web Services General Reference/. Once the resource is
    -- created, you can use
    -- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_TagResource.html TagResource>,
    -- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_UntagResource.html UntagResource>,
    -- and
    -- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_ListTagsForResource.html ListTagsForResource>
    -- to add, remove, and view tags. The maximum tag limit may be lower than
    -- stated. See the Amazon Web Services General Reference for actual tagging
    -- limits.
    CreateScript -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Version information associated with a build or script. Version strings
    -- do not need to be unique. You can use
    -- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_UpdateScript.html UpdateScript>
    -- to change this value later.
    CreateScript -> Maybe Text
version :: Prelude.Maybe Prelude.Text,
    -- | A data object containing your Realtime scripts and dependencies as a zip
    -- file. The zip file can have one or multiple files. Maximum size of a zip
    -- file is 5 MB.
    --
    -- When using the Amazon Web Services CLI tool to create a script, this
    -- parameter is set to the zip file name. It must be prepended with the
    -- string \"fileb:\/\/\" to indicate that the file data is a binary object.
    -- For example: @--zip-file fileb:\/\/myRealtimeScript.zip@.
    CreateScript -> Maybe Base64
zipFile :: Prelude.Maybe Data.Base64
  }
  deriving (CreateScript -> CreateScript -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateScript -> CreateScript -> Bool
$c/= :: CreateScript -> CreateScript -> Bool
== :: CreateScript -> CreateScript -> Bool
$c== :: CreateScript -> CreateScript -> Bool
Prelude.Eq, ReadPrec [CreateScript]
ReadPrec CreateScript
Int -> ReadS CreateScript
ReadS [CreateScript]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateScript]
$creadListPrec :: ReadPrec [CreateScript]
readPrec :: ReadPrec CreateScript
$creadPrec :: ReadPrec CreateScript
readList :: ReadS [CreateScript]
$creadList :: ReadS [CreateScript]
readsPrec :: Int -> ReadS CreateScript
$creadsPrec :: Int -> ReadS CreateScript
Prelude.Read, Int -> CreateScript -> ShowS
[CreateScript] -> ShowS
CreateScript -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateScript] -> ShowS
$cshowList :: [CreateScript] -> ShowS
show :: CreateScript -> String
$cshow :: CreateScript -> String
showsPrec :: Int -> CreateScript -> ShowS
$cshowsPrec :: Int -> CreateScript -> ShowS
Prelude.Show, forall x. Rep CreateScript x -> CreateScript
forall x. CreateScript -> Rep CreateScript x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateScript x -> CreateScript
$cfrom :: forall x. CreateScript -> Rep CreateScript x
Prelude.Generic)

-- |
-- Create a value of 'CreateScript' 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:
--
-- 'name', 'createScript_name' - A descriptive label that is associated with a script. Script names do
-- not need to be unique. You can use
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_UpdateScript.html UpdateScript>
-- to change this value later.
--
-- 'storageLocation', 'createScript_storageLocation' - The location of the Amazon S3 bucket where a zipped file containing your
-- Realtime scripts is stored. The storage location must specify the Amazon
-- S3 bucket name, the zip file name (the \"key\"), and a role ARN that
-- allows Amazon GameLift to access the Amazon S3 storage location. The S3
-- bucket must be in the same Region where you want to create a new script.
-- By default, Amazon GameLift uploads the latest version of the zip file;
-- if you have S3 object versioning turned on, you can use the
-- @ObjectVersion@ parameter to specify an earlier version.
--
-- 'tags', 'createScript_tags' - A list of labels to assign to the new script resource. Tags are
-- developer-defined key-value pairs. Tagging Amazon Web Services resources
-- are useful for resource management, access management and cost
-- allocation. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
-- in the /Amazon Web Services General Reference/. Once the resource is
-- created, you can use
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_TagResource.html TagResource>,
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_UntagResource.html UntagResource>,
-- and
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_ListTagsForResource.html ListTagsForResource>
-- to add, remove, and view tags. The maximum tag limit may be lower than
-- stated. See the Amazon Web Services General Reference for actual tagging
-- limits.
--
-- 'version', 'createScript_version' - Version information associated with a build or script. Version strings
-- do not need to be unique. You can use
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_UpdateScript.html UpdateScript>
-- to change this value later.
--
-- 'zipFile', 'createScript_zipFile' - A data object containing your Realtime scripts and dependencies as a zip
-- file. The zip file can have one or multiple files. Maximum size of a zip
-- file is 5 MB.
--
-- When using the Amazon Web Services CLI tool to create a script, this
-- parameter is set to the zip file name. It must be prepended with the
-- string \"fileb:\/\/\" to indicate that the file data is a binary object.
-- For example: @--zip-file fileb:\/\/myRealtimeScript.zip@.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
newCreateScript ::
  CreateScript
newCreateScript :: CreateScript
newCreateScript =
  CreateScript'
    { $sel:name:CreateScript' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:storageLocation:CreateScript' :: Maybe S3Location
storageLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateScript' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:version:CreateScript' :: Maybe Text
version = forall a. Maybe a
Prelude.Nothing,
      $sel:zipFile:CreateScript' :: Maybe Base64
zipFile = forall a. Maybe a
Prelude.Nothing
    }

-- | A descriptive label that is associated with a script. Script names do
-- not need to be unique. You can use
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_UpdateScript.html UpdateScript>
-- to change this value later.
createScript_name :: Lens.Lens' CreateScript (Prelude.Maybe Prelude.Text)
createScript_name :: Lens' CreateScript (Maybe Text)
createScript_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScript' {Maybe Text
name :: Maybe Text
$sel:name:CreateScript' :: CreateScript -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateScript
s@CreateScript' {} Maybe Text
a -> CreateScript
s {$sel:name:CreateScript' :: Maybe Text
name = Maybe Text
a} :: CreateScript)

-- | The location of the Amazon S3 bucket where a zipped file containing your
-- Realtime scripts is stored. The storage location must specify the Amazon
-- S3 bucket name, the zip file name (the \"key\"), and a role ARN that
-- allows Amazon GameLift to access the Amazon S3 storage location. The S3
-- bucket must be in the same Region where you want to create a new script.
-- By default, Amazon GameLift uploads the latest version of the zip file;
-- if you have S3 object versioning turned on, you can use the
-- @ObjectVersion@ parameter to specify an earlier version.
createScript_storageLocation :: Lens.Lens' CreateScript (Prelude.Maybe S3Location)
createScript_storageLocation :: Lens' CreateScript (Maybe S3Location)
createScript_storageLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScript' {Maybe S3Location
storageLocation :: Maybe S3Location
$sel:storageLocation:CreateScript' :: CreateScript -> Maybe S3Location
storageLocation} -> Maybe S3Location
storageLocation) (\s :: CreateScript
s@CreateScript' {} Maybe S3Location
a -> CreateScript
s {$sel:storageLocation:CreateScript' :: Maybe S3Location
storageLocation = Maybe S3Location
a} :: CreateScript)

-- | A list of labels to assign to the new script resource. Tags are
-- developer-defined key-value pairs. Tagging Amazon Web Services resources
-- are useful for resource management, access management and cost
-- allocation. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
-- in the /Amazon Web Services General Reference/. Once the resource is
-- created, you can use
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_TagResource.html TagResource>,
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_UntagResource.html UntagResource>,
-- and
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_ListTagsForResource.html ListTagsForResource>
-- to add, remove, and view tags. The maximum tag limit may be lower than
-- stated. See the Amazon Web Services General Reference for actual tagging
-- limits.
createScript_tags :: Lens.Lens' CreateScript (Prelude.Maybe [Tag])
createScript_tags :: Lens' CreateScript (Maybe [Tag])
createScript_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScript' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateScript' :: CreateScript -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateScript
s@CreateScript' {} Maybe [Tag]
a -> CreateScript
s {$sel:tags:CreateScript' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateScript) 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

-- | Version information associated with a build or script. Version strings
-- do not need to be unique. You can use
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_UpdateScript.html UpdateScript>
-- to change this value later.
createScript_version :: Lens.Lens' CreateScript (Prelude.Maybe Prelude.Text)
createScript_version :: Lens' CreateScript (Maybe Text)
createScript_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScript' {Maybe Text
version :: Maybe Text
$sel:version:CreateScript' :: CreateScript -> Maybe Text
version} -> Maybe Text
version) (\s :: CreateScript
s@CreateScript' {} Maybe Text
a -> CreateScript
s {$sel:version:CreateScript' :: Maybe Text
version = Maybe Text
a} :: CreateScript)

-- | A data object containing your Realtime scripts and dependencies as a zip
-- file. The zip file can have one or multiple files. Maximum size of a zip
-- file is 5 MB.
--
-- When using the Amazon Web Services CLI tool to create a script, this
-- parameter is set to the zip file name. It must be prepended with the
-- string \"fileb:\/\/\" to indicate that the file data is a binary object.
-- For example: @--zip-file fileb:\/\/myRealtimeScript.zip@.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
createScript_zipFile :: Lens.Lens' CreateScript (Prelude.Maybe Prelude.ByteString)
createScript_zipFile :: Lens' CreateScript (Maybe ByteString)
createScript_zipFile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScript' {Maybe Base64
zipFile :: Maybe Base64
$sel:zipFile:CreateScript' :: CreateScript -> Maybe Base64
zipFile} -> Maybe Base64
zipFile) (\s :: CreateScript
s@CreateScript' {} Maybe Base64
a -> CreateScript
s {$sel:zipFile:CreateScript' :: Maybe Base64
zipFile = Maybe Base64
a} :: CreateScript) 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

instance Core.AWSRequest CreateScript where
  type AWSResponse CreateScript = CreateScriptResponse
  request :: (Service -> Service) -> CreateScript -> Request CreateScript
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 CreateScript
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateScript)))
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 -> CreateScriptResponse
CreateScriptResponse'
            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 CreateScript where
  hashWithSalt :: Int -> CreateScript -> Int
hashWithSalt Int
_salt CreateScript' {Maybe [Tag]
Maybe Text
Maybe Base64
Maybe S3Location
zipFile :: Maybe Base64
version :: Maybe Text
tags :: Maybe [Tag]
storageLocation :: Maybe S3Location
name :: Maybe Text
$sel:zipFile:CreateScript' :: CreateScript -> Maybe Base64
$sel:version:CreateScript' :: CreateScript -> Maybe Text
$sel:tags:CreateScript' :: CreateScript -> Maybe [Tag]
$sel:storageLocation:CreateScript' :: CreateScript -> Maybe S3Location
$sel:name:CreateScript' :: CreateScript -> 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 [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
version
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Base64
zipFile

instance Prelude.NFData CreateScript where
  rnf :: CreateScript -> ()
rnf CreateScript' {Maybe [Tag]
Maybe Text
Maybe Base64
Maybe S3Location
zipFile :: Maybe Base64
version :: Maybe Text
tags :: Maybe [Tag]
storageLocation :: Maybe S3Location
name :: Maybe Text
$sel:zipFile:CreateScript' :: CreateScript -> Maybe Base64
$sel:version:CreateScript' :: CreateScript -> Maybe Text
$sel:tags:CreateScript' :: CreateScript -> Maybe [Tag]
$sel:storageLocation:CreateScript' :: CreateScript -> Maybe S3Location
$sel:name:CreateScript' :: CreateScript -> 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 [Tag]
tags
      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

instance Data.ToHeaders CreateScript where
  toHeaders :: CreateScript -> 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.CreateScript" :: 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 CreateScript where
  toJSON :: CreateScript -> Value
toJSON CreateScript' {Maybe [Tag]
Maybe Text
Maybe Base64
Maybe S3Location
zipFile :: Maybe Base64
version :: Maybe Text
tags :: Maybe [Tag]
storageLocation :: Maybe S3Location
name :: Maybe Text
$sel:zipFile:CreateScript' :: CreateScript -> Maybe Base64
$sel:version:CreateScript' :: CreateScript -> Maybe Text
$sel:tags:CreateScript' :: CreateScript -> Maybe [Tag]
$sel:storageLocation:CreateScript' :: CreateScript -> Maybe S3Location
$sel:name:CreateScript' :: CreateScript -> 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
"Tags" 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 [Tag]
tags,
            (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
          ]
      )

instance Data.ToPath CreateScript where
  toPath :: CreateScript -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newCreateScriptResponse' smart constructor.
data CreateScriptResponse = CreateScriptResponse'
  { -- | The newly created script record with a unique script ID and ARN. The new
    -- script\'s storage location reflects an Amazon S3 location: (1) If the
    -- script was uploaded from an S3 bucket under your account, the storage
    -- location reflects the information that was provided in the
    -- /CreateScript/ request; (2) If the script file was uploaded from a local
    -- zip file, the storage location reflects an S3 location controls by the
    -- Amazon GameLift service.
    CreateScriptResponse -> Maybe Script
script :: Prelude.Maybe Script,
    -- | The response's http status code.
    CreateScriptResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateScriptResponse -> CreateScriptResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateScriptResponse -> CreateScriptResponse -> Bool
$c/= :: CreateScriptResponse -> CreateScriptResponse -> Bool
== :: CreateScriptResponse -> CreateScriptResponse -> Bool
$c== :: CreateScriptResponse -> CreateScriptResponse -> Bool
Prelude.Eq, ReadPrec [CreateScriptResponse]
ReadPrec CreateScriptResponse
Int -> ReadS CreateScriptResponse
ReadS [CreateScriptResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateScriptResponse]
$creadListPrec :: ReadPrec [CreateScriptResponse]
readPrec :: ReadPrec CreateScriptResponse
$creadPrec :: ReadPrec CreateScriptResponse
readList :: ReadS [CreateScriptResponse]
$creadList :: ReadS [CreateScriptResponse]
readsPrec :: Int -> ReadS CreateScriptResponse
$creadsPrec :: Int -> ReadS CreateScriptResponse
Prelude.Read, Int -> CreateScriptResponse -> ShowS
[CreateScriptResponse] -> ShowS
CreateScriptResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateScriptResponse] -> ShowS
$cshowList :: [CreateScriptResponse] -> ShowS
show :: CreateScriptResponse -> String
$cshow :: CreateScriptResponse -> String
showsPrec :: Int -> CreateScriptResponse -> ShowS
$cshowsPrec :: Int -> CreateScriptResponse -> ShowS
Prelude.Show, forall x. Rep CreateScriptResponse x -> CreateScriptResponse
forall x. CreateScriptResponse -> Rep CreateScriptResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateScriptResponse x -> CreateScriptResponse
$cfrom :: forall x. CreateScriptResponse -> Rep CreateScriptResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateScriptResponse' 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:
--
-- 'script', 'createScriptResponse_script' - The newly created script record with a unique script ID and ARN. The new
-- script\'s storage location reflects an Amazon S3 location: (1) If the
-- script was uploaded from an S3 bucket under your account, the storage
-- location reflects the information that was provided in the
-- /CreateScript/ request; (2) If the script file was uploaded from a local
-- zip file, the storage location reflects an S3 location controls by the
-- Amazon GameLift service.
--
-- 'httpStatus', 'createScriptResponse_httpStatus' - The response's http status code.
newCreateScriptResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateScriptResponse
newCreateScriptResponse :: Int -> CreateScriptResponse
newCreateScriptResponse Int
pHttpStatus_ =
  CreateScriptResponse'
    { $sel:script:CreateScriptResponse' :: Maybe Script
script = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateScriptResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The newly created script record with a unique script ID and ARN. The new
-- script\'s storage location reflects an Amazon S3 location: (1) If the
-- script was uploaded from an S3 bucket under your account, the storage
-- location reflects the information that was provided in the
-- /CreateScript/ request; (2) If the script file was uploaded from a local
-- zip file, the storage location reflects an S3 location controls by the
-- Amazon GameLift service.
createScriptResponse_script :: Lens.Lens' CreateScriptResponse (Prelude.Maybe Script)
createScriptResponse_script :: Lens' CreateScriptResponse (Maybe Script)
createScriptResponse_script = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScriptResponse' {Maybe Script
script :: Maybe Script
$sel:script:CreateScriptResponse' :: CreateScriptResponse -> Maybe Script
script} -> Maybe Script
script) (\s :: CreateScriptResponse
s@CreateScriptResponse' {} Maybe Script
a -> CreateScriptResponse
s {$sel:script:CreateScriptResponse' :: Maybe Script
script = Maybe Script
a} :: CreateScriptResponse)

-- | The response's http status code.
createScriptResponse_httpStatus :: Lens.Lens' CreateScriptResponse Prelude.Int
createScriptResponse_httpStatus :: Lens' CreateScriptResponse Int
createScriptResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateScriptResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateScriptResponse' :: CreateScriptResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateScriptResponse
s@CreateScriptResponse' {} Int
a -> CreateScriptResponse
s {$sel:httpStatus:CreateScriptResponse' :: Int
httpStatus = Int
a} :: CreateScriptResponse)

instance Prelude.NFData CreateScriptResponse where
  rnf :: CreateScriptResponse -> ()
rnf CreateScriptResponse' {Int
Maybe Script
httpStatus :: Int
script :: Maybe Script
$sel:httpStatus:CreateScriptResponse' :: CreateScriptResponse -> Int
$sel:script:CreateScriptResponse' :: CreateScriptResponse -> 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