{-# 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.CreateBuild
-- 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 Amazon GameLift build resource for your game server binary
-- files. Combine game server binaries into a zip file for use with Amazon
-- GameLift.
--
-- When setting up a new game build for GameLift, we recommend using the
-- CLI command
-- __<https://docs.aws.amazon.com/cli/latest/reference/gamelift/upload-build.html upload-build>__
-- . This helper command combines two tasks: (1) it uploads your build
-- files from a file directory to a GameLift Amazon S3 location, and (2) it
-- creates a new build resource.
--
-- You can use the operation in the following scenarios:
--
-- -   To create a new game build with build files that are in an Amazon S3
--     location under an Amazon Web Services account that you control. To
--     use this option, you give Amazon GameLift access to the Amazon S3
--     bucket. With permissions in place, specify a build name, operating
--     system, and the Amazon S3 storage location of your game build.
--
-- -   To directly upload your build files to a GameLift Amazon S3
--     location. To use this option, specify a build name and operating
--     system. This operation creates a new build resource and also returns
--     an Amazon S3 location with temporary access credentials. Use the
--     credentials to manually upload your build files to the specified
--     Amazon S3 location. For more information, see
--     <https://docs.aws.amazon.com/AmazonS3/latest/dev/UploadingObjects.html Uploading Objects>
--     in the /Amazon S3 Developer Guide/. After you upload build files to
--     the GameLift Amazon S3 location, you can\'t update them.
--
-- If successful, this operation creates a new build resource with a unique
-- build ID and places it in @INITIALIZED@ status. A build must be in
-- @READY@ status before you can create fleets with it.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/gamelift-build-intro.html Uploading Your Game>
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/gamelift-build-cli-uploading.html#gamelift-build-cli-uploading-create-build Create a Build with Files in Amazon S3>
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/reference-awssdk.html#reference-awssdk-resources-fleets All APIs by task>
module Amazonka.GameLift.CreateBuild
  ( -- * Creating a Request
    CreateBuild (..),
    newCreateBuild,

    -- * Request Lenses
    createBuild_name,
    createBuild_operatingSystem,
    createBuild_serverSdkVersion,
    createBuild_storageLocation,
    createBuild_tags,
    createBuild_version,

    -- * Destructuring the Response
    CreateBuildResponse (..),
    newCreateBuildResponse,

    -- * Response Lenses
    createBuildResponse_build,
    createBuildResponse_storageLocation,
    createBuildResponse_uploadCredentials,
    createBuildResponse_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:/ 'newCreateBuild' smart constructor.
data CreateBuild = CreateBuild'
  { -- | A descriptive label associated with a build. Build names do not need to
    -- be unique. You can change this value later.
    CreateBuild -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The operating system that you built the game server binaries to run on.
    -- This value determines the type of fleet resources that you can use for
    -- this build. If your game build contains multiple executables, they all
    -- must run on the same operating system. If an operating system is not
    -- specified when creating a build, GameLift uses the default value
    -- (WINDOWS_2012). This value cannot be changed later.
    CreateBuild -> Maybe OperatingSystem
operatingSystem :: Prelude.Maybe OperatingSystem,
    -- | A server SDK version you used when integrating your game server build
    -- with GameLift. For more information see
    -- <https://docs.aws.amazon.com/gamelift/latest/developerguide/integration-custom-intro.html Integrate games with custom game servers>.
    CreateBuild -> Maybe Text
serverSdkVersion :: Prelude.Maybe Prelude.Text,
    -- | Information indicating where your game build files are stored. Use this
    -- parameter only when creating a build with files stored in an Amazon S3
    -- bucket that you own. The storage location must specify an Amazon S3
    -- bucket name and key. The location must also specify a role ARN that you
    -- set up to allow Amazon GameLift to access your Amazon S3 bucket. The S3
    -- bucket and your new build must be in the same Region.
    --
    -- If a @StorageLocation@ is specified, the size of your file can be found
    -- in your Amazon S3 bucket. Amazon GameLift will report a @SizeOnDisk@ of
    -- 0.
    CreateBuild -> Maybe S3Location
storageLocation :: Prelude.Maybe S3Location,
    -- | A list of labels to assign to the new build 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.
    CreateBuild -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Version information associated with a build or script. Version strings
    -- do not need to be unique. You can change this value later.
    CreateBuild -> Maybe Text
version :: Prelude.Maybe Prelude.Text
  }
  deriving (CreateBuild -> CreateBuild -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBuild -> CreateBuild -> Bool
$c/= :: CreateBuild -> CreateBuild -> Bool
== :: CreateBuild -> CreateBuild -> Bool
$c== :: CreateBuild -> CreateBuild -> Bool
Prelude.Eq, ReadPrec [CreateBuild]
ReadPrec CreateBuild
Int -> ReadS CreateBuild
ReadS [CreateBuild]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBuild]
$creadListPrec :: ReadPrec [CreateBuild]
readPrec :: ReadPrec CreateBuild
$creadPrec :: ReadPrec CreateBuild
readList :: ReadS [CreateBuild]
$creadList :: ReadS [CreateBuild]
readsPrec :: Int -> ReadS CreateBuild
$creadsPrec :: Int -> ReadS CreateBuild
Prelude.Read, Int -> CreateBuild -> ShowS
[CreateBuild] -> ShowS
CreateBuild -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBuild] -> ShowS
$cshowList :: [CreateBuild] -> ShowS
show :: CreateBuild -> String
$cshow :: CreateBuild -> String
showsPrec :: Int -> CreateBuild -> ShowS
$cshowsPrec :: Int -> CreateBuild -> ShowS
Prelude.Show, forall x. Rep CreateBuild x -> CreateBuild
forall x. CreateBuild -> Rep CreateBuild x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateBuild x -> CreateBuild
$cfrom :: forall x. CreateBuild -> Rep CreateBuild x
Prelude.Generic)

-- |
-- Create a value of 'CreateBuild' 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', 'createBuild_name' - A descriptive label associated with a build. Build names do not need to
-- be unique. You can change this value later.
--
-- 'operatingSystem', 'createBuild_operatingSystem' - The operating system that you built the game server binaries to run on.
-- This value determines the type of fleet resources that you can use for
-- this build. If your game build contains multiple executables, they all
-- must run on the same operating system. If an operating system is not
-- specified when creating a build, GameLift uses the default value
-- (WINDOWS_2012). This value cannot be changed later.
--
-- 'serverSdkVersion', 'createBuild_serverSdkVersion' - A server SDK version you used when integrating your game server build
-- with GameLift. For more information see
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/integration-custom-intro.html Integrate games with custom game servers>.
--
-- 'storageLocation', 'createBuild_storageLocation' - Information indicating where your game build files are stored. Use this
-- parameter only when creating a build with files stored in an Amazon S3
-- bucket that you own. The storage location must specify an Amazon S3
-- bucket name and key. The location must also specify a role ARN that you
-- set up to allow Amazon GameLift to access your Amazon S3 bucket. The S3
-- bucket and your new build must be in the same Region.
--
-- If a @StorageLocation@ is specified, the size of your file can be found
-- in your Amazon S3 bucket. Amazon GameLift will report a @SizeOnDisk@ of
-- 0.
--
-- 'tags', 'createBuild_tags' - A list of labels to assign to the new build 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', 'createBuild_version' - Version information associated with a build or script. Version strings
-- do not need to be unique. You can change this value later.
newCreateBuild ::
  CreateBuild
newCreateBuild :: CreateBuild
newCreateBuild =
  CreateBuild'
    { $sel:name:CreateBuild' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:operatingSystem:CreateBuild' :: Maybe OperatingSystem
operatingSystem = forall a. Maybe a
Prelude.Nothing,
      $sel:serverSdkVersion:CreateBuild' :: Maybe Text
serverSdkVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:storageLocation:CreateBuild' :: Maybe S3Location
storageLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateBuild' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:version:CreateBuild' :: Maybe Text
version = forall a. Maybe a
Prelude.Nothing
    }

-- | A descriptive label associated with a build. Build names do not need to
-- be unique. You can change this value later.
createBuild_name :: Lens.Lens' CreateBuild (Prelude.Maybe Prelude.Text)
createBuild_name :: Lens' CreateBuild (Maybe Text)
createBuild_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBuild' {Maybe Text
name :: Maybe Text
$sel:name:CreateBuild' :: CreateBuild -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateBuild
s@CreateBuild' {} Maybe Text
a -> CreateBuild
s {$sel:name:CreateBuild' :: Maybe Text
name = Maybe Text
a} :: CreateBuild)

-- | The operating system that you built the game server binaries to run on.
-- This value determines the type of fleet resources that you can use for
-- this build. If your game build contains multiple executables, they all
-- must run on the same operating system. If an operating system is not
-- specified when creating a build, GameLift uses the default value
-- (WINDOWS_2012). This value cannot be changed later.
createBuild_operatingSystem :: Lens.Lens' CreateBuild (Prelude.Maybe OperatingSystem)
createBuild_operatingSystem :: Lens' CreateBuild (Maybe OperatingSystem)
createBuild_operatingSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBuild' {Maybe OperatingSystem
operatingSystem :: Maybe OperatingSystem
$sel:operatingSystem:CreateBuild' :: CreateBuild -> Maybe OperatingSystem
operatingSystem} -> Maybe OperatingSystem
operatingSystem) (\s :: CreateBuild
s@CreateBuild' {} Maybe OperatingSystem
a -> CreateBuild
s {$sel:operatingSystem:CreateBuild' :: Maybe OperatingSystem
operatingSystem = Maybe OperatingSystem
a} :: CreateBuild)

-- | A server SDK version you used when integrating your game server build
-- with GameLift. For more information see
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/integration-custom-intro.html Integrate games with custom game servers>.
createBuild_serverSdkVersion :: Lens.Lens' CreateBuild (Prelude.Maybe Prelude.Text)
createBuild_serverSdkVersion :: Lens' CreateBuild (Maybe Text)
createBuild_serverSdkVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBuild' {Maybe Text
serverSdkVersion :: Maybe Text
$sel:serverSdkVersion:CreateBuild' :: CreateBuild -> Maybe Text
serverSdkVersion} -> Maybe Text
serverSdkVersion) (\s :: CreateBuild
s@CreateBuild' {} Maybe Text
a -> CreateBuild
s {$sel:serverSdkVersion:CreateBuild' :: Maybe Text
serverSdkVersion = Maybe Text
a} :: CreateBuild)

-- | Information indicating where your game build files are stored. Use this
-- parameter only when creating a build with files stored in an Amazon S3
-- bucket that you own. The storage location must specify an Amazon S3
-- bucket name and key. The location must also specify a role ARN that you
-- set up to allow Amazon GameLift to access your Amazon S3 bucket. The S3
-- bucket and your new build must be in the same Region.
--
-- If a @StorageLocation@ is specified, the size of your file can be found
-- in your Amazon S3 bucket. Amazon GameLift will report a @SizeOnDisk@ of
-- 0.
createBuild_storageLocation :: Lens.Lens' CreateBuild (Prelude.Maybe S3Location)
createBuild_storageLocation :: Lens' CreateBuild (Maybe S3Location)
createBuild_storageLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBuild' {Maybe S3Location
storageLocation :: Maybe S3Location
$sel:storageLocation:CreateBuild' :: CreateBuild -> Maybe S3Location
storageLocation} -> Maybe S3Location
storageLocation) (\s :: CreateBuild
s@CreateBuild' {} Maybe S3Location
a -> CreateBuild
s {$sel:storageLocation:CreateBuild' :: Maybe S3Location
storageLocation = Maybe S3Location
a} :: CreateBuild)

-- | A list of labels to assign to the new build 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.
createBuild_tags :: Lens.Lens' CreateBuild (Prelude.Maybe [Tag])
createBuild_tags :: Lens' CreateBuild (Maybe [Tag])
createBuild_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBuild' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateBuild' :: CreateBuild -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateBuild
s@CreateBuild' {} Maybe [Tag]
a -> CreateBuild
s {$sel:tags:CreateBuild' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateBuild) 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 change this value later.
createBuild_version :: Lens.Lens' CreateBuild (Prelude.Maybe Prelude.Text)
createBuild_version :: Lens' CreateBuild (Maybe Text)
createBuild_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBuild' {Maybe Text
version :: Maybe Text
$sel:version:CreateBuild' :: CreateBuild -> Maybe Text
version} -> Maybe Text
version) (\s :: CreateBuild
s@CreateBuild' {} Maybe Text
a -> CreateBuild
s {$sel:version:CreateBuild' :: Maybe Text
version = Maybe Text
a} :: CreateBuild)

instance Core.AWSRequest CreateBuild where
  type AWSResponse CreateBuild = CreateBuildResponse
  request :: (Service -> Service) -> CreateBuild -> Request CreateBuild
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 CreateBuild
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateBuild)))
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
-> Maybe S3Location
-> Maybe (Sensitive AwsCredentials)
-> Int
-> CreateBuildResponse
CreateBuildResponse'
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StorageLocation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"UploadCredentials")
            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 CreateBuild where
  hashWithSalt :: Int -> CreateBuild -> Int
hashWithSalt Int
_salt CreateBuild' {Maybe [Tag]
Maybe Text
Maybe OperatingSystem
Maybe S3Location
version :: Maybe Text
tags :: Maybe [Tag]
storageLocation :: Maybe S3Location
serverSdkVersion :: Maybe Text
operatingSystem :: Maybe OperatingSystem
name :: Maybe Text
$sel:version:CreateBuild' :: CreateBuild -> Maybe Text
$sel:tags:CreateBuild' :: CreateBuild -> Maybe [Tag]
$sel:storageLocation:CreateBuild' :: CreateBuild -> Maybe S3Location
$sel:serverSdkVersion:CreateBuild' :: CreateBuild -> Maybe Text
$sel:operatingSystem:CreateBuild' :: CreateBuild -> Maybe OperatingSystem
$sel:name:CreateBuild' :: CreateBuild -> 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 OperatingSystem
operatingSystem
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serverSdkVersion
      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

instance Prelude.NFData CreateBuild where
  rnf :: CreateBuild -> ()
rnf CreateBuild' {Maybe [Tag]
Maybe Text
Maybe OperatingSystem
Maybe S3Location
version :: Maybe Text
tags :: Maybe [Tag]
storageLocation :: Maybe S3Location
serverSdkVersion :: Maybe Text
operatingSystem :: Maybe OperatingSystem
name :: Maybe Text
$sel:version:CreateBuild' :: CreateBuild -> Maybe Text
$sel:tags:CreateBuild' :: CreateBuild -> Maybe [Tag]
$sel:storageLocation:CreateBuild' :: CreateBuild -> Maybe S3Location
$sel:serverSdkVersion:CreateBuild' :: CreateBuild -> Maybe Text
$sel:operatingSystem:CreateBuild' :: CreateBuild -> Maybe OperatingSystem
$sel:name:CreateBuild' :: CreateBuild -> 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 OperatingSystem
operatingSystem
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serverSdkVersion
      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

instance Data.ToHeaders CreateBuild where
  toHeaders :: CreateBuild -> 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.CreateBuild" :: 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 CreateBuild where
  toJSON :: CreateBuild -> Value
toJSON CreateBuild' {Maybe [Tag]
Maybe Text
Maybe OperatingSystem
Maybe S3Location
version :: Maybe Text
tags :: Maybe [Tag]
storageLocation :: Maybe S3Location
serverSdkVersion :: Maybe Text
operatingSystem :: Maybe OperatingSystem
name :: Maybe Text
$sel:version:CreateBuild' :: CreateBuild -> Maybe Text
$sel:tags:CreateBuild' :: CreateBuild -> Maybe [Tag]
$sel:storageLocation:CreateBuild' :: CreateBuild -> Maybe S3Location
$sel:serverSdkVersion:CreateBuild' :: CreateBuild -> Maybe Text
$sel:operatingSystem:CreateBuild' :: CreateBuild -> Maybe OperatingSystem
$sel:name:CreateBuild' :: CreateBuild -> 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
"OperatingSystem" 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 OperatingSystem
operatingSystem,
            (Key
"ServerSdkVersion" 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
serverSdkVersion,
            (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
          ]
      )

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

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

-- | /See:/ 'newCreateBuildResponse' smart constructor.
data CreateBuildResponse = CreateBuildResponse'
  { -- | The newly created build resource, including a unique build IDs and
    -- status.
    CreateBuildResponse -> Maybe Build
build :: Prelude.Maybe Build,
    -- | Amazon S3 location for your game build file, including bucket name and
    -- key.
    CreateBuildResponse -> Maybe S3Location
storageLocation :: Prelude.Maybe S3Location,
    -- | This element is returned only when the operation is called without a
    -- storage location. It contains credentials to use when you are uploading
    -- a build file to an Amazon S3 bucket that is owned by Amazon GameLift.
    -- Credentials have a limited life span. To refresh these credentials, call
    -- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_RequestUploadCredentials.html RequestUploadCredentials>.
    CreateBuildResponse -> Maybe (Sensitive AwsCredentials)
uploadCredentials :: Prelude.Maybe (Data.Sensitive AwsCredentials),
    -- | The response's http status code.
    CreateBuildResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateBuildResponse -> CreateBuildResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBuildResponse -> CreateBuildResponse -> Bool
$c/= :: CreateBuildResponse -> CreateBuildResponse -> Bool
== :: CreateBuildResponse -> CreateBuildResponse -> Bool
$c== :: CreateBuildResponse -> CreateBuildResponse -> Bool
Prelude.Eq, Int -> CreateBuildResponse -> ShowS
[CreateBuildResponse] -> ShowS
CreateBuildResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBuildResponse] -> ShowS
$cshowList :: [CreateBuildResponse] -> ShowS
show :: CreateBuildResponse -> String
$cshow :: CreateBuildResponse -> String
showsPrec :: Int -> CreateBuildResponse -> ShowS
$cshowsPrec :: Int -> CreateBuildResponse -> ShowS
Prelude.Show, forall x. Rep CreateBuildResponse x -> CreateBuildResponse
forall x. CreateBuildResponse -> Rep CreateBuildResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateBuildResponse x -> CreateBuildResponse
$cfrom :: forall x. CreateBuildResponse -> Rep CreateBuildResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateBuildResponse' 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:
--
-- 'build', 'createBuildResponse_build' - The newly created build resource, including a unique build IDs and
-- status.
--
-- 'storageLocation', 'createBuildResponse_storageLocation' - Amazon S3 location for your game build file, including bucket name and
-- key.
--
-- 'uploadCredentials', 'createBuildResponse_uploadCredentials' - This element is returned only when the operation is called without a
-- storage location. It contains credentials to use when you are uploading
-- a build file to an Amazon S3 bucket that is owned by Amazon GameLift.
-- Credentials have a limited life span. To refresh these credentials, call
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_RequestUploadCredentials.html RequestUploadCredentials>.
--
-- 'httpStatus', 'createBuildResponse_httpStatus' - The response's http status code.
newCreateBuildResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateBuildResponse
newCreateBuildResponse :: Int -> CreateBuildResponse
newCreateBuildResponse Int
pHttpStatus_ =
  CreateBuildResponse'
    { $sel:build:CreateBuildResponse' :: Maybe Build
build = forall a. Maybe a
Prelude.Nothing,
      $sel:storageLocation:CreateBuildResponse' :: Maybe S3Location
storageLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:uploadCredentials:CreateBuildResponse' :: Maybe (Sensitive AwsCredentials)
uploadCredentials = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateBuildResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The newly created build resource, including a unique build IDs and
-- status.
createBuildResponse_build :: Lens.Lens' CreateBuildResponse (Prelude.Maybe Build)
createBuildResponse_build :: Lens' CreateBuildResponse (Maybe Build)
createBuildResponse_build = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBuildResponse' {Maybe Build
build :: Maybe Build
$sel:build:CreateBuildResponse' :: CreateBuildResponse -> Maybe Build
build} -> Maybe Build
build) (\s :: CreateBuildResponse
s@CreateBuildResponse' {} Maybe Build
a -> CreateBuildResponse
s {$sel:build:CreateBuildResponse' :: Maybe Build
build = Maybe Build
a} :: CreateBuildResponse)

-- | Amazon S3 location for your game build file, including bucket name and
-- key.
createBuildResponse_storageLocation :: Lens.Lens' CreateBuildResponse (Prelude.Maybe S3Location)
createBuildResponse_storageLocation :: Lens' CreateBuildResponse (Maybe S3Location)
createBuildResponse_storageLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBuildResponse' {Maybe S3Location
storageLocation :: Maybe S3Location
$sel:storageLocation:CreateBuildResponse' :: CreateBuildResponse -> Maybe S3Location
storageLocation} -> Maybe S3Location
storageLocation) (\s :: CreateBuildResponse
s@CreateBuildResponse' {} Maybe S3Location
a -> CreateBuildResponse
s {$sel:storageLocation:CreateBuildResponse' :: Maybe S3Location
storageLocation = Maybe S3Location
a} :: CreateBuildResponse)

-- | This element is returned only when the operation is called without a
-- storage location. It contains credentials to use when you are uploading
-- a build file to an Amazon S3 bucket that is owned by Amazon GameLift.
-- Credentials have a limited life span. To refresh these credentials, call
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_RequestUploadCredentials.html RequestUploadCredentials>.
createBuildResponse_uploadCredentials :: Lens.Lens' CreateBuildResponse (Prelude.Maybe AwsCredentials)
createBuildResponse_uploadCredentials :: Lens' CreateBuildResponse (Maybe AwsCredentials)
createBuildResponse_uploadCredentials = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBuildResponse' {Maybe (Sensitive AwsCredentials)
uploadCredentials :: Maybe (Sensitive AwsCredentials)
$sel:uploadCredentials:CreateBuildResponse' :: CreateBuildResponse -> Maybe (Sensitive AwsCredentials)
uploadCredentials} -> Maybe (Sensitive AwsCredentials)
uploadCredentials) (\s :: CreateBuildResponse
s@CreateBuildResponse' {} Maybe (Sensitive AwsCredentials)
a -> CreateBuildResponse
s {$sel:uploadCredentials:CreateBuildResponse' :: Maybe (Sensitive AwsCredentials)
uploadCredentials = Maybe (Sensitive AwsCredentials)
a} :: CreateBuildResponse) 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 a. Iso' (Sensitive a) a
Data._Sensitive

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

instance Prelude.NFData CreateBuildResponse where
  rnf :: CreateBuildResponse -> ()
rnf CreateBuildResponse' {Int
Maybe (Sensitive AwsCredentials)
Maybe Build
Maybe S3Location
httpStatus :: Int
uploadCredentials :: Maybe (Sensitive AwsCredentials)
storageLocation :: Maybe S3Location
build :: Maybe Build
$sel:httpStatus:CreateBuildResponse' :: CreateBuildResponse -> Int
$sel:uploadCredentials:CreateBuildResponse' :: CreateBuildResponse -> Maybe (Sensitive AwsCredentials)
$sel:storageLocation:CreateBuildResponse' :: CreateBuildResponse -> Maybe S3Location
$sel:build:CreateBuildResponse' :: CreateBuildResponse -> 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 Maybe S3Location
storageLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive AwsCredentials)
uploadCredentials
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus