{-# 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.RequestUploadCredentials
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a fresh set of credentials for use when uploading a new set of
-- game build files to Amazon GameLift\'s Amazon S3. This is done as part
-- of the build creation process; see
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_CreateBuild.html GameSession>.
--
-- To request new credentials, specify the build ID as returned with an
-- initial @CreateBuild@ request. If successful, a new set of credentials
-- are returned, along with the S3 storage location associated with the
-- build ID.
--
-- __Learn more__
--
-- <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 S3>
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/reference-awssdk.html#reference-awssdk-resources-fleets All APIs by task>
module Amazonka.GameLift.RequestUploadCredentials
  ( -- * Creating a Request
    RequestUploadCredentials (..),
    newRequestUploadCredentials,

    -- * Request Lenses
    requestUploadCredentials_buildId,

    -- * Destructuring the Response
    RequestUploadCredentialsResponse (..),
    newRequestUploadCredentialsResponse,

    -- * Response Lenses
    requestUploadCredentialsResponse_storageLocation,
    requestUploadCredentialsResponse_uploadCredentials,
    requestUploadCredentialsResponse_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:/ 'newRequestUploadCredentials' smart constructor.
data RequestUploadCredentials = RequestUploadCredentials'
  { -- | A unique identifier for the build to get credentials for. You can use
    -- either the build ID or ARN value.
    RequestUploadCredentials -> Text
buildId :: Prelude.Text
  }
  deriving (RequestUploadCredentials -> RequestUploadCredentials -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestUploadCredentials -> RequestUploadCredentials -> Bool
$c/= :: RequestUploadCredentials -> RequestUploadCredentials -> Bool
== :: RequestUploadCredentials -> RequestUploadCredentials -> Bool
$c== :: RequestUploadCredentials -> RequestUploadCredentials -> Bool
Prelude.Eq, ReadPrec [RequestUploadCredentials]
ReadPrec RequestUploadCredentials
Int -> ReadS RequestUploadCredentials
ReadS [RequestUploadCredentials]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RequestUploadCredentials]
$creadListPrec :: ReadPrec [RequestUploadCredentials]
readPrec :: ReadPrec RequestUploadCredentials
$creadPrec :: ReadPrec RequestUploadCredentials
readList :: ReadS [RequestUploadCredentials]
$creadList :: ReadS [RequestUploadCredentials]
readsPrec :: Int -> ReadS RequestUploadCredentials
$creadsPrec :: Int -> ReadS RequestUploadCredentials
Prelude.Read, Int -> RequestUploadCredentials -> ShowS
[RequestUploadCredentials] -> ShowS
RequestUploadCredentials -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestUploadCredentials] -> ShowS
$cshowList :: [RequestUploadCredentials] -> ShowS
show :: RequestUploadCredentials -> String
$cshow :: RequestUploadCredentials -> String
showsPrec :: Int -> RequestUploadCredentials -> ShowS
$cshowsPrec :: Int -> RequestUploadCredentials -> ShowS
Prelude.Show, forall x.
Rep RequestUploadCredentials x -> RequestUploadCredentials
forall x.
RequestUploadCredentials -> Rep RequestUploadCredentials x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RequestUploadCredentials x -> RequestUploadCredentials
$cfrom :: forall x.
RequestUploadCredentials -> Rep RequestUploadCredentials x
Prelude.Generic)

-- |
-- Create a value of 'RequestUploadCredentials' 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:
--
-- 'buildId', 'requestUploadCredentials_buildId' - A unique identifier for the build to get credentials for. You can use
-- either the build ID or ARN value.
newRequestUploadCredentials ::
  -- | 'buildId'
  Prelude.Text ->
  RequestUploadCredentials
newRequestUploadCredentials :: Text -> RequestUploadCredentials
newRequestUploadCredentials Text
pBuildId_ =
  RequestUploadCredentials' {$sel:buildId:RequestUploadCredentials' :: Text
buildId = Text
pBuildId_}

-- | A unique identifier for the build to get credentials for. You can use
-- either the build ID or ARN value.
requestUploadCredentials_buildId :: Lens.Lens' RequestUploadCredentials Prelude.Text
requestUploadCredentials_buildId :: Lens' RequestUploadCredentials Text
requestUploadCredentials_buildId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestUploadCredentials' {Text
buildId :: Text
$sel:buildId:RequestUploadCredentials' :: RequestUploadCredentials -> Text
buildId} -> Text
buildId) (\s :: RequestUploadCredentials
s@RequestUploadCredentials' {} Text
a -> RequestUploadCredentials
s {$sel:buildId:RequestUploadCredentials' :: Text
buildId = Text
a} :: RequestUploadCredentials)

instance Core.AWSRequest RequestUploadCredentials where
  type
    AWSResponse RequestUploadCredentials =
      RequestUploadCredentialsResponse
  request :: (Service -> Service)
-> RequestUploadCredentials -> Request RequestUploadCredentials
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 RequestUploadCredentials
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RequestUploadCredentials)))
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 S3Location
-> Maybe (Sensitive AwsCredentials)
-> Int
-> RequestUploadCredentialsResponse
RequestUploadCredentialsResponse'
            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
"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 RequestUploadCredentials where
  hashWithSalt :: Int -> RequestUploadCredentials -> Int
hashWithSalt Int
_salt RequestUploadCredentials' {Text
buildId :: Text
$sel:buildId:RequestUploadCredentials' :: RequestUploadCredentials -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
buildId

instance Prelude.NFData RequestUploadCredentials where
  rnf :: RequestUploadCredentials -> ()
rnf RequestUploadCredentials' {Text
buildId :: Text
$sel:buildId:RequestUploadCredentials' :: RequestUploadCredentials -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
buildId

instance Data.ToHeaders RequestUploadCredentials where
  toHeaders :: RequestUploadCredentials -> 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.RequestUploadCredentials" ::
                          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 RequestUploadCredentials where
  toJSON :: RequestUploadCredentials -> Value
toJSON RequestUploadCredentials' {Text
buildId :: Text
$sel:buildId:RequestUploadCredentials' :: RequestUploadCredentials -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [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 RequestUploadCredentials where
  toPath :: RequestUploadCredentials -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newRequestUploadCredentialsResponse' smart constructor.
data RequestUploadCredentialsResponse = RequestUploadCredentialsResponse'
  { -- | Amazon S3 path and key, identifying where the game build files are
    -- stored.
    RequestUploadCredentialsResponse -> Maybe S3Location
storageLocation :: Prelude.Maybe S3Location,
    -- | Amazon Web Services credentials required when uploading a game build to
    -- the storage location. These credentials have a limited lifespan and are
    -- valid only for the build they were issued for.
    RequestUploadCredentialsResponse
-> Maybe (Sensitive AwsCredentials)
uploadCredentials :: Prelude.Maybe (Data.Sensitive AwsCredentials),
    -- | The response's http status code.
    RequestUploadCredentialsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RequestUploadCredentialsResponse
-> RequestUploadCredentialsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestUploadCredentialsResponse
-> RequestUploadCredentialsResponse -> Bool
$c/= :: RequestUploadCredentialsResponse
-> RequestUploadCredentialsResponse -> Bool
== :: RequestUploadCredentialsResponse
-> RequestUploadCredentialsResponse -> Bool
$c== :: RequestUploadCredentialsResponse
-> RequestUploadCredentialsResponse -> Bool
Prelude.Eq, Int -> RequestUploadCredentialsResponse -> ShowS
[RequestUploadCredentialsResponse] -> ShowS
RequestUploadCredentialsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestUploadCredentialsResponse] -> ShowS
$cshowList :: [RequestUploadCredentialsResponse] -> ShowS
show :: RequestUploadCredentialsResponse -> String
$cshow :: RequestUploadCredentialsResponse -> String
showsPrec :: Int -> RequestUploadCredentialsResponse -> ShowS
$cshowsPrec :: Int -> RequestUploadCredentialsResponse -> ShowS
Prelude.Show, forall x.
Rep RequestUploadCredentialsResponse x
-> RequestUploadCredentialsResponse
forall x.
RequestUploadCredentialsResponse
-> Rep RequestUploadCredentialsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RequestUploadCredentialsResponse x
-> RequestUploadCredentialsResponse
$cfrom :: forall x.
RequestUploadCredentialsResponse
-> Rep RequestUploadCredentialsResponse x
Prelude.Generic)

-- |
-- Create a value of 'RequestUploadCredentialsResponse' 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:
--
-- 'storageLocation', 'requestUploadCredentialsResponse_storageLocation' - Amazon S3 path and key, identifying where the game build files are
-- stored.
--
-- 'uploadCredentials', 'requestUploadCredentialsResponse_uploadCredentials' - Amazon Web Services credentials required when uploading a game build to
-- the storage location. These credentials have a limited lifespan and are
-- valid only for the build they were issued for.
--
-- 'httpStatus', 'requestUploadCredentialsResponse_httpStatus' - The response's http status code.
newRequestUploadCredentialsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RequestUploadCredentialsResponse
newRequestUploadCredentialsResponse :: Int -> RequestUploadCredentialsResponse
newRequestUploadCredentialsResponse Int
pHttpStatus_ =
  RequestUploadCredentialsResponse'
    { $sel:storageLocation:RequestUploadCredentialsResponse' :: Maybe S3Location
storageLocation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:uploadCredentials:RequestUploadCredentialsResponse' :: Maybe (Sensitive AwsCredentials)
uploadCredentials = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RequestUploadCredentialsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Amazon S3 path and key, identifying where the game build files are
-- stored.
requestUploadCredentialsResponse_storageLocation :: Lens.Lens' RequestUploadCredentialsResponse (Prelude.Maybe S3Location)
requestUploadCredentialsResponse_storageLocation :: Lens' RequestUploadCredentialsResponse (Maybe S3Location)
requestUploadCredentialsResponse_storageLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestUploadCredentialsResponse' {Maybe S3Location
storageLocation :: Maybe S3Location
$sel:storageLocation:RequestUploadCredentialsResponse' :: RequestUploadCredentialsResponse -> Maybe S3Location
storageLocation} -> Maybe S3Location
storageLocation) (\s :: RequestUploadCredentialsResponse
s@RequestUploadCredentialsResponse' {} Maybe S3Location
a -> RequestUploadCredentialsResponse
s {$sel:storageLocation:RequestUploadCredentialsResponse' :: Maybe S3Location
storageLocation = Maybe S3Location
a} :: RequestUploadCredentialsResponse)

-- | Amazon Web Services credentials required when uploading a game build to
-- the storage location. These credentials have a limited lifespan and are
-- valid only for the build they were issued for.
requestUploadCredentialsResponse_uploadCredentials :: Lens.Lens' RequestUploadCredentialsResponse (Prelude.Maybe AwsCredentials)
requestUploadCredentialsResponse_uploadCredentials :: Lens' RequestUploadCredentialsResponse (Maybe AwsCredentials)
requestUploadCredentialsResponse_uploadCredentials = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestUploadCredentialsResponse' {Maybe (Sensitive AwsCredentials)
uploadCredentials :: Maybe (Sensitive AwsCredentials)
$sel:uploadCredentials:RequestUploadCredentialsResponse' :: RequestUploadCredentialsResponse
-> Maybe (Sensitive AwsCredentials)
uploadCredentials} -> Maybe (Sensitive AwsCredentials)
uploadCredentials) (\s :: RequestUploadCredentialsResponse
s@RequestUploadCredentialsResponse' {} Maybe (Sensitive AwsCredentials)
a -> RequestUploadCredentialsResponse
s {$sel:uploadCredentials:RequestUploadCredentialsResponse' :: Maybe (Sensitive AwsCredentials)
uploadCredentials = Maybe (Sensitive AwsCredentials)
a} :: RequestUploadCredentialsResponse) 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.
requestUploadCredentialsResponse_httpStatus :: Lens.Lens' RequestUploadCredentialsResponse Prelude.Int
requestUploadCredentialsResponse_httpStatus :: Lens' RequestUploadCredentialsResponse Int
requestUploadCredentialsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestUploadCredentialsResponse' {Int
httpStatus :: Int
$sel:httpStatus:RequestUploadCredentialsResponse' :: RequestUploadCredentialsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: RequestUploadCredentialsResponse
s@RequestUploadCredentialsResponse' {} Int
a -> RequestUploadCredentialsResponse
s {$sel:httpStatus:RequestUploadCredentialsResponse' :: Int
httpStatus = Int
a} :: RequestUploadCredentialsResponse)

instance
  Prelude.NFData
    RequestUploadCredentialsResponse
  where
  rnf :: RequestUploadCredentialsResponse -> ()
rnf RequestUploadCredentialsResponse' {Int
Maybe (Sensitive AwsCredentials)
Maybe S3Location
httpStatus :: Int
uploadCredentials :: Maybe (Sensitive AwsCredentials)
storageLocation :: Maybe S3Location
$sel:httpStatus:RequestUploadCredentialsResponse' :: RequestUploadCredentialsResponse -> Int
$sel:uploadCredentials:RequestUploadCredentialsResponse' :: RequestUploadCredentialsResponse
-> Maybe (Sensitive AwsCredentials)
$sel:storageLocation:RequestUploadCredentialsResponse' :: RequestUploadCredentialsResponse -> Maybe S3Location
..} =
    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