{-# 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.GamesParks.UpdateGame
-- 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 details of the game.
module Amazonka.GamesParks.UpdateGame
  ( -- * Creating a Request
    UpdateGame (..),
    newUpdateGame,

    -- * Request Lenses
    updateGame_description,
    updateGame_gameName,

    -- * Destructuring the Response
    UpdateGameResponse (..),
    newUpdateGameResponse,

    -- * Response Lenses
    updateGameResponse_game,
    updateGameResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateGame' smart constructor.
data UpdateGame = UpdateGame'
  { -- | The description of the game.
    UpdateGame -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The name of the game.
    UpdateGame -> Text
gameName :: Prelude.Text
  }
  deriving (UpdateGame -> UpdateGame -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateGame -> UpdateGame -> Bool
$c/= :: UpdateGame -> UpdateGame -> Bool
== :: UpdateGame -> UpdateGame -> Bool
$c== :: UpdateGame -> UpdateGame -> Bool
Prelude.Eq, ReadPrec [UpdateGame]
ReadPrec UpdateGame
Int -> ReadS UpdateGame
ReadS [UpdateGame]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateGame]
$creadListPrec :: ReadPrec [UpdateGame]
readPrec :: ReadPrec UpdateGame
$creadPrec :: ReadPrec UpdateGame
readList :: ReadS [UpdateGame]
$creadList :: ReadS [UpdateGame]
readsPrec :: Int -> ReadS UpdateGame
$creadsPrec :: Int -> ReadS UpdateGame
Prelude.Read, Int -> UpdateGame -> ShowS
[UpdateGame] -> ShowS
UpdateGame -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateGame] -> ShowS
$cshowList :: [UpdateGame] -> ShowS
show :: UpdateGame -> String
$cshow :: UpdateGame -> String
showsPrec :: Int -> UpdateGame -> ShowS
$cshowsPrec :: Int -> UpdateGame -> ShowS
Prelude.Show, forall x. Rep UpdateGame x -> UpdateGame
forall x. UpdateGame -> Rep UpdateGame x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateGame x -> UpdateGame
$cfrom :: forall x. UpdateGame -> Rep UpdateGame x
Prelude.Generic)

-- |
-- Create a value of 'UpdateGame' 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:
--
-- 'description', 'updateGame_description' - The description of the game.
--
-- 'gameName', 'updateGame_gameName' - The name of the game.
newUpdateGame ::
  -- | 'gameName'
  Prelude.Text ->
  UpdateGame
newUpdateGame :: Text -> UpdateGame
newUpdateGame Text
pGameName_ =
  UpdateGame'
    { $sel:description:UpdateGame' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:gameName:UpdateGame' :: Text
gameName = Text
pGameName_
    }

-- | The description of the game.
updateGame_description :: Lens.Lens' UpdateGame (Prelude.Maybe Prelude.Text)
updateGame_description :: Lens' UpdateGame (Maybe Text)
updateGame_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGame' {Maybe Text
description :: Maybe Text
$sel:description:UpdateGame' :: UpdateGame -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateGame
s@UpdateGame' {} Maybe Text
a -> UpdateGame
s {$sel:description:UpdateGame' :: Maybe Text
description = Maybe Text
a} :: UpdateGame)

-- | The name of the game.
updateGame_gameName :: Lens.Lens' UpdateGame Prelude.Text
updateGame_gameName :: Lens' UpdateGame Text
updateGame_gameName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGame' {Text
gameName :: Text
$sel:gameName:UpdateGame' :: UpdateGame -> Text
gameName} -> Text
gameName) (\s :: UpdateGame
s@UpdateGame' {} Text
a -> UpdateGame
s {$sel:gameName:UpdateGame' :: Text
gameName = Text
a} :: UpdateGame)

instance Core.AWSRequest UpdateGame where
  type AWSResponse UpdateGame = UpdateGameResponse
  request :: (Service -> Service) -> UpdateGame -> Request UpdateGame
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateGame
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateGame)))
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 GameDetails -> Int -> UpdateGameResponse
UpdateGameResponse'
            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
"Game")
            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 UpdateGame where
  hashWithSalt :: Int -> UpdateGame -> Int
hashWithSalt Int
_salt UpdateGame' {Maybe Text
Text
gameName :: Text
description :: Maybe Text
$sel:gameName:UpdateGame' :: UpdateGame -> Text
$sel:description:UpdateGame' :: UpdateGame -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gameName

instance Prelude.NFData UpdateGame where
  rnf :: UpdateGame -> ()
rnf UpdateGame' {Maybe Text
Text
gameName :: Text
description :: Maybe Text
$sel:gameName:UpdateGame' :: UpdateGame -> Text
$sel:description:UpdateGame' :: UpdateGame -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gameName

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

instance Data.ToJSON UpdateGame where
  toJSON :: UpdateGame -> Value
toJSON UpdateGame' {Maybe Text
Text
gameName :: Text
description :: Maybe Text
$sel:gameName:UpdateGame' :: UpdateGame -> Text
$sel:description:UpdateGame' :: UpdateGame -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"Description" 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
description]
      )

instance Data.ToPath UpdateGame where
  toPath :: UpdateGame -> ByteString
toPath UpdateGame' {Maybe Text
Text
gameName :: Text
description :: Maybe Text
$sel:gameName:UpdateGame' :: UpdateGame -> Text
$sel:description:UpdateGame' :: UpdateGame -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/game/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
gameName]

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

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

-- |
-- Create a value of 'UpdateGameResponse' 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:
--
-- 'game', 'updateGameResponse_game' - The details of the game.
--
-- 'httpStatus', 'updateGameResponse_httpStatus' - The response's http status code.
newUpdateGameResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateGameResponse
newUpdateGameResponse :: Int -> UpdateGameResponse
newUpdateGameResponse Int
pHttpStatus_ =
  UpdateGameResponse'
    { $sel:game:UpdateGameResponse' :: Maybe GameDetails
game = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateGameResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The details of the game.
updateGameResponse_game :: Lens.Lens' UpdateGameResponse (Prelude.Maybe GameDetails)
updateGameResponse_game :: Lens' UpdateGameResponse (Maybe GameDetails)
updateGameResponse_game = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGameResponse' {Maybe GameDetails
game :: Maybe GameDetails
$sel:game:UpdateGameResponse' :: UpdateGameResponse -> Maybe GameDetails
game} -> Maybe GameDetails
game) (\s :: UpdateGameResponse
s@UpdateGameResponse' {} Maybe GameDetails
a -> UpdateGameResponse
s {$sel:game:UpdateGameResponse' :: Maybe GameDetails
game = Maybe GameDetails
a} :: UpdateGameResponse)

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

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