{-# 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.UpdateBuild
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates metadata in a build resource, including the build name and
-- version. To update the metadata, specify the build ID to update and
-- provide the new values. If successful, a build object containing the
-- updated metadata is returned.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/gamelift-build-intro.html Upload a Custom Server Build>
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/reference-awssdk.html#reference-awssdk-resources-fleets All APIs by task>
module Amazonka.GameLift.UpdateBuild
  ( -- * Creating a Request
    UpdateBuild (..),
    newUpdateBuild,

    -- * Request Lenses
    updateBuild_name,
    updateBuild_version,
    updateBuild_buildId,

    -- * Destructuring the Response
    UpdateBuildResponse (..),
    newUpdateBuildResponse,

    -- * Response Lenses
    updateBuildResponse_build,
    updateBuildResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.GameLift.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateBuild' smart constructor.
data UpdateBuild = UpdateBuild'
  { -- | A descriptive label associated with a build. Build names do not need to
    -- be unique.
    UpdateBuild -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Version information associated with a build or script. Version strings
    -- do not need to be unique.
    UpdateBuild -> Maybe Text
version :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the build to update. You can use either the
    -- build ID or ARN value.
    UpdateBuild -> Text
buildId :: Prelude.Text
  }
  deriving (UpdateBuild -> UpdateBuild -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBuild -> UpdateBuild -> Bool
$c/= :: UpdateBuild -> UpdateBuild -> Bool
== :: UpdateBuild -> UpdateBuild -> Bool
$c== :: UpdateBuild -> UpdateBuild -> Bool
Prelude.Eq, ReadPrec [UpdateBuild]
ReadPrec UpdateBuild
Int -> ReadS UpdateBuild
ReadS [UpdateBuild]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateBuild]
$creadListPrec :: ReadPrec [UpdateBuild]
readPrec :: ReadPrec UpdateBuild
$creadPrec :: ReadPrec UpdateBuild
readList :: ReadS [UpdateBuild]
$creadList :: ReadS [UpdateBuild]
readsPrec :: Int -> ReadS UpdateBuild
$creadsPrec :: Int -> ReadS UpdateBuild
Prelude.Read, Int -> UpdateBuild -> ShowS
[UpdateBuild] -> ShowS
UpdateBuild -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBuild] -> ShowS
$cshowList :: [UpdateBuild] -> ShowS
show :: UpdateBuild -> String
$cshow :: UpdateBuild -> String
showsPrec :: Int -> UpdateBuild -> ShowS
$cshowsPrec :: Int -> UpdateBuild -> ShowS
Prelude.Show, forall x. Rep UpdateBuild x -> UpdateBuild
forall x. UpdateBuild -> Rep UpdateBuild x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBuild x -> UpdateBuild
$cfrom :: forall x. UpdateBuild -> Rep UpdateBuild x
Prelude.Generic)

-- |
-- Create a value of 'UpdateBuild' 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', 'updateBuild_name' - A descriptive label associated with a build. Build names do not need to
-- be unique.
--
-- 'version', 'updateBuild_version' - Version information associated with a build or script. Version strings
-- do not need to be unique.
--
-- 'buildId', 'updateBuild_buildId' - A unique identifier for the build to update. You can use either the
-- build ID or ARN value.
newUpdateBuild ::
  -- | 'buildId'
  Prelude.Text ->
  UpdateBuild
newUpdateBuild :: Text -> UpdateBuild
newUpdateBuild Text
pBuildId_ =
  UpdateBuild'
    { $sel:name:UpdateBuild' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:version:UpdateBuild' :: Maybe Text
version = forall a. Maybe a
Prelude.Nothing,
      $sel:buildId:UpdateBuild' :: Text
buildId = Text
pBuildId_
    }

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

-- | Version information associated with a build or script. Version strings
-- do not need to be unique.
updateBuild_version :: Lens.Lens' UpdateBuild (Prelude.Maybe Prelude.Text)
updateBuild_version :: Lens' UpdateBuild (Maybe Text)
updateBuild_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBuild' {Maybe Text
version :: Maybe Text
$sel:version:UpdateBuild' :: UpdateBuild -> Maybe Text
version} -> Maybe Text
version) (\s :: UpdateBuild
s@UpdateBuild' {} Maybe Text
a -> UpdateBuild
s {$sel:version:UpdateBuild' :: Maybe Text
version = Maybe Text
a} :: UpdateBuild)

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

instance Core.AWSRequest UpdateBuild where
  type AWSResponse UpdateBuild = UpdateBuildResponse
  request :: (Service -> Service) -> UpdateBuild -> Request UpdateBuild
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateBuild
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateBuild)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Build -> Int -> UpdateBuildResponse
UpdateBuildResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Build")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateBuild where
  hashWithSalt :: Int -> UpdateBuild -> Int
hashWithSalt Int
_salt UpdateBuild' {Maybe Text
Text
buildId :: Text
version :: Maybe Text
name :: Maybe Text
$sel:buildId:UpdateBuild' :: UpdateBuild -> Text
$sel:version:UpdateBuild' :: UpdateBuild -> Maybe Text
$sel:name:UpdateBuild' :: UpdateBuild -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
version
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
buildId

instance Prelude.NFData UpdateBuild where
  rnf :: UpdateBuild -> ()
rnf UpdateBuild' {Maybe Text
Text
buildId :: Text
version :: Maybe Text
name :: Maybe Text
$sel:buildId:UpdateBuild' :: UpdateBuild -> Text
$sel:version:UpdateBuild' :: UpdateBuild -> Maybe Text
$sel:name:UpdateBuild' :: UpdateBuild -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
version
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
buildId

instance Data.ToHeaders UpdateBuild where
  toHeaders :: UpdateBuild -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"GameLift.UpdateBuild" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateBuild where
  toJSON :: UpdateBuild -> Value
toJSON UpdateBuild' {Maybe Text
Text
buildId :: Text
version :: Maybe Text
name :: Maybe Text
$sel:buildId:UpdateBuild' :: UpdateBuild -> Text
$sel:version:UpdateBuild' :: UpdateBuild -> Maybe Text
$sel:name:UpdateBuild' :: UpdateBuild -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
name,
            (Key
"Version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
version,
            forall a. a -> Maybe a
Prelude.Just (Key
"BuildId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
buildId)
          ]
      )

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

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

-- | /See:/ 'newUpdateBuildResponse' smart constructor.
data UpdateBuildResponse = UpdateBuildResponse'
  { -- | The updated build resource.
    UpdateBuildResponse -> Maybe Build
build :: Prelude.Maybe Build,
    -- | The response's http status code.
    UpdateBuildResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateBuildResponse -> UpdateBuildResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBuildResponse -> UpdateBuildResponse -> Bool
$c/= :: UpdateBuildResponse -> UpdateBuildResponse -> Bool
== :: UpdateBuildResponse -> UpdateBuildResponse -> Bool
$c== :: UpdateBuildResponse -> UpdateBuildResponse -> Bool
Prelude.Eq, ReadPrec [UpdateBuildResponse]
ReadPrec UpdateBuildResponse
Int -> ReadS UpdateBuildResponse
ReadS [UpdateBuildResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateBuildResponse]
$creadListPrec :: ReadPrec [UpdateBuildResponse]
readPrec :: ReadPrec UpdateBuildResponse
$creadPrec :: ReadPrec UpdateBuildResponse
readList :: ReadS [UpdateBuildResponse]
$creadList :: ReadS [UpdateBuildResponse]
readsPrec :: Int -> ReadS UpdateBuildResponse
$creadsPrec :: Int -> ReadS UpdateBuildResponse
Prelude.Read, Int -> UpdateBuildResponse -> ShowS
[UpdateBuildResponse] -> ShowS
UpdateBuildResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBuildResponse] -> ShowS
$cshowList :: [UpdateBuildResponse] -> ShowS
show :: UpdateBuildResponse -> String
$cshow :: UpdateBuildResponse -> String
showsPrec :: Int -> UpdateBuildResponse -> ShowS
$cshowsPrec :: Int -> UpdateBuildResponse -> ShowS
Prelude.Show, forall x. Rep UpdateBuildResponse x -> UpdateBuildResponse
forall x. UpdateBuildResponse -> Rep UpdateBuildResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBuildResponse x -> UpdateBuildResponse
$cfrom :: forall x. UpdateBuildResponse -> Rep UpdateBuildResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateBuildResponse' 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', 'updateBuildResponse_build' - The updated build resource.
--
-- 'httpStatus', 'updateBuildResponse_httpStatus' - The response's http status code.
newUpdateBuildResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateBuildResponse
newUpdateBuildResponse :: Int -> UpdateBuildResponse
newUpdateBuildResponse Int
pHttpStatus_ =
  UpdateBuildResponse'
    { $sel:build:UpdateBuildResponse' :: Maybe Build
build = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateBuildResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The updated build resource.
updateBuildResponse_build :: Lens.Lens' UpdateBuildResponse (Prelude.Maybe Build)
updateBuildResponse_build :: Lens' UpdateBuildResponse (Maybe Build)
updateBuildResponse_build = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBuildResponse' {Maybe Build
build :: Maybe Build
$sel:build:UpdateBuildResponse' :: UpdateBuildResponse -> Maybe Build
build} -> Maybe Build
build) (\s :: UpdateBuildResponse
s@UpdateBuildResponse' {} Maybe Build
a -> UpdateBuildResponse
s {$sel:build:UpdateBuildResponse' :: Maybe Build
build = Maybe Build
a} :: UpdateBuildResponse)

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

instance Prelude.NFData UpdateBuildResponse where
  rnf :: UpdateBuildResponse -> ()
rnf UpdateBuildResponse' {Int
Maybe Build
httpStatus :: Int
build :: Maybe Build
$sel:httpStatus:UpdateBuildResponse' :: UpdateBuildResponse -> Int
$sel:build:UpdateBuildResponse' :: UpdateBuildResponse -> Maybe Build
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Build
build
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus