{-# 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.UpdateGameServer
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- __This operation is used with the GameLift FleetIQ solution and game
-- server groups.__
--
-- Updates information about a registered game server to help GameLift
-- FleetIQ to track game server availability. This operation is called by a
-- game server process that is running on an instance in a game server
-- group.
--
-- Use this operation to update the following types of game server
-- information. You can make all three types of updates in the same
-- request:
--
-- -   To update the game server\'s utilization status, identify the game
--     server and game server group and specify the current utilization
--     status. Use this status to identify when game servers are currently
--     hosting games and when they are available to be claimed.
--
-- -   To report health status, identify the game server and game server
--     group and set health check to @HEALTHY@. If a game server does not
--     report health status for a certain length of time, the game server
--     is no longer considered healthy. As a result, it will be eventually
--     deregistered from the game server group to avoid affecting
--     utilization metrics. The best practice is to report health every 60
--     seconds.
--
-- -   To change game server metadata, provide updated game server data.
--
-- Once a game server is successfully updated, the relevant statuses and
-- timestamps are updated.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/fleetiqguide/gsg-intro.html GameLift FleetIQ Guide>
module Amazonka.GameLift.UpdateGameServer
  ( -- * Creating a Request
    UpdateGameServer (..),
    newUpdateGameServer,

    -- * Request Lenses
    updateGameServer_gameServerData,
    updateGameServer_healthCheck,
    updateGameServer_utilizationStatus,
    updateGameServer_gameServerGroupName,
    updateGameServer_gameServerId,

    -- * Destructuring the Response
    UpdateGameServerResponse (..),
    newUpdateGameServerResponse,

    -- * Response Lenses
    updateGameServerResponse_gameServer,
    updateGameServerResponse_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:/ 'newUpdateGameServer' smart constructor.
data UpdateGameServer = UpdateGameServer'
  { -- | A set of custom game server properties, formatted as a single string
    -- value. This data is passed to a game client or service when it requests
    -- information on game servers.
    UpdateGameServer -> Maybe Text
gameServerData :: Prelude.Maybe Prelude.Text,
    -- | Indicates health status of the game server. A request that includes this
    -- parameter updates the game server\'s /LastHealthCheckTime/ timestamp.
    UpdateGameServer -> Maybe GameServerHealthCheck
healthCheck :: Prelude.Maybe GameServerHealthCheck,
    -- | Indicates whether the game server is available or is currently hosting
    -- gameplay.
    UpdateGameServer -> Maybe GameServerUtilizationStatus
utilizationStatus :: Prelude.Maybe GameServerUtilizationStatus,
    -- | A unique identifier for the game server group where the game server is
    -- running.
    UpdateGameServer -> Text
gameServerGroupName :: Prelude.Text,
    -- | A custom string that uniquely identifies the game server to update.
    UpdateGameServer -> Text
gameServerId :: Prelude.Text
  }
  deriving (UpdateGameServer -> UpdateGameServer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateGameServer -> UpdateGameServer -> Bool
$c/= :: UpdateGameServer -> UpdateGameServer -> Bool
== :: UpdateGameServer -> UpdateGameServer -> Bool
$c== :: UpdateGameServer -> UpdateGameServer -> Bool
Prelude.Eq, ReadPrec [UpdateGameServer]
ReadPrec UpdateGameServer
Int -> ReadS UpdateGameServer
ReadS [UpdateGameServer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateGameServer]
$creadListPrec :: ReadPrec [UpdateGameServer]
readPrec :: ReadPrec UpdateGameServer
$creadPrec :: ReadPrec UpdateGameServer
readList :: ReadS [UpdateGameServer]
$creadList :: ReadS [UpdateGameServer]
readsPrec :: Int -> ReadS UpdateGameServer
$creadsPrec :: Int -> ReadS UpdateGameServer
Prelude.Read, Int -> UpdateGameServer -> ShowS
[UpdateGameServer] -> ShowS
UpdateGameServer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateGameServer] -> ShowS
$cshowList :: [UpdateGameServer] -> ShowS
show :: UpdateGameServer -> String
$cshow :: UpdateGameServer -> String
showsPrec :: Int -> UpdateGameServer -> ShowS
$cshowsPrec :: Int -> UpdateGameServer -> ShowS
Prelude.Show, forall x. Rep UpdateGameServer x -> UpdateGameServer
forall x. UpdateGameServer -> Rep UpdateGameServer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateGameServer x -> UpdateGameServer
$cfrom :: forall x. UpdateGameServer -> Rep UpdateGameServer x
Prelude.Generic)

-- |
-- Create a value of 'UpdateGameServer' 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:
--
-- 'gameServerData', 'updateGameServer_gameServerData' - A set of custom game server properties, formatted as a single string
-- value. This data is passed to a game client or service when it requests
-- information on game servers.
--
-- 'healthCheck', 'updateGameServer_healthCheck' - Indicates health status of the game server. A request that includes this
-- parameter updates the game server\'s /LastHealthCheckTime/ timestamp.
--
-- 'utilizationStatus', 'updateGameServer_utilizationStatus' - Indicates whether the game server is available or is currently hosting
-- gameplay.
--
-- 'gameServerGroupName', 'updateGameServer_gameServerGroupName' - A unique identifier for the game server group where the game server is
-- running.
--
-- 'gameServerId', 'updateGameServer_gameServerId' - A custom string that uniquely identifies the game server to update.
newUpdateGameServer ::
  -- | 'gameServerGroupName'
  Prelude.Text ->
  -- | 'gameServerId'
  Prelude.Text ->
  UpdateGameServer
newUpdateGameServer :: Text -> Text -> UpdateGameServer
newUpdateGameServer
  Text
pGameServerGroupName_
  Text
pGameServerId_ =
    UpdateGameServer'
      { $sel:gameServerData:UpdateGameServer' :: Maybe Text
gameServerData = forall a. Maybe a
Prelude.Nothing,
        $sel:healthCheck:UpdateGameServer' :: Maybe GameServerHealthCheck
healthCheck = forall a. Maybe a
Prelude.Nothing,
        $sel:utilizationStatus:UpdateGameServer' :: Maybe GameServerUtilizationStatus
utilizationStatus = forall a. Maybe a
Prelude.Nothing,
        $sel:gameServerGroupName:UpdateGameServer' :: Text
gameServerGroupName = Text
pGameServerGroupName_,
        $sel:gameServerId:UpdateGameServer' :: Text
gameServerId = Text
pGameServerId_
      }

-- | A set of custom game server properties, formatted as a single string
-- value. This data is passed to a game client or service when it requests
-- information on game servers.
updateGameServer_gameServerData :: Lens.Lens' UpdateGameServer (Prelude.Maybe Prelude.Text)
updateGameServer_gameServerData :: Lens' UpdateGameServer (Maybe Text)
updateGameServer_gameServerData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGameServer' {Maybe Text
gameServerData :: Maybe Text
$sel:gameServerData:UpdateGameServer' :: UpdateGameServer -> Maybe Text
gameServerData} -> Maybe Text
gameServerData) (\s :: UpdateGameServer
s@UpdateGameServer' {} Maybe Text
a -> UpdateGameServer
s {$sel:gameServerData:UpdateGameServer' :: Maybe Text
gameServerData = Maybe Text
a} :: UpdateGameServer)

-- | Indicates health status of the game server. A request that includes this
-- parameter updates the game server\'s /LastHealthCheckTime/ timestamp.
updateGameServer_healthCheck :: Lens.Lens' UpdateGameServer (Prelude.Maybe GameServerHealthCheck)
updateGameServer_healthCheck :: Lens' UpdateGameServer (Maybe GameServerHealthCheck)
updateGameServer_healthCheck = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGameServer' {Maybe GameServerHealthCheck
healthCheck :: Maybe GameServerHealthCheck
$sel:healthCheck:UpdateGameServer' :: UpdateGameServer -> Maybe GameServerHealthCheck
healthCheck} -> Maybe GameServerHealthCheck
healthCheck) (\s :: UpdateGameServer
s@UpdateGameServer' {} Maybe GameServerHealthCheck
a -> UpdateGameServer
s {$sel:healthCheck:UpdateGameServer' :: Maybe GameServerHealthCheck
healthCheck = Maybe GameServerHealthCheck
a} :: UpdateGameServer)

-- | Indicates whether the game server is available or is currently hosting
-- gameplay.
updateGameServer_utilizationStatus :: Lens.Lens' UpdateGameServer (Prelude.Maybe GameServerUtilizationStatus)
updateGameServer_utilizationStatus :: Lens' UpdateGameServer (Maybe GameServerUtilizationStatus)
updateGameServer_utilizationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGameServer' {Maybe GameServerUtilizationStatus
utilizationStatus :: Maybe GameServerUtilizationStatus
$sel:utilizationStatus:UpdateGameServer' :: UpdateGameServer -> Maybe GameServerUtilizationStatus
utilizationStatus} -> Maybe GameServerUtilizationStatus
utilizationStatus) (\s :: UpdateGameServer
s@UpdateGameServer' {} Maybe GameServerUtilizationStatus
a -> UpdateGameServer
s {$sel:utilizationStatus:UpdateGameServer' :: Maybe GameServerUtilizationStatus
utilizationStatus = Maybe GameServerUtilizationStatus
a} :: UpdateGameServer)

-- | A unique identifier for the game server group where the game server is
-- running.
updateGameServer_gameServerGroupName :: Lens.Lens' UpdateGameServer Prelude.Text
updateGameServer_gameServerGroupName :: Lens' UpdateGameServer Text
updateGameServer_gameServerGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGameServer' {Text
gameServerGroupName :: Text
$sel:gameServerGroupName:UpdateGameServer' :: UpdateGameServer -> Text
gameServerGroupName} -> Text
gameServerGroupName) (\s :: UpdateGameServer
s@UpdateGameServer' {} Text
a -> UpdateGameServer
s {$sel:gameServerGroupName:UpdateGameServer' :: Text
gameServerGroupName = Text
a} :: UpdateGameServer)

-- | A custom string that uniquely identifies the game server to update.
updateGameServer_gameServerId :: Lens.Lens' UpdateGameServer Prelude.Text
updateGameServer_gameServerId :: Lens' UpdateGameServer Text
updateGameServer_gameServerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGameServer' {Text
gameServerId :: Text
$sel:gameServerId:UpdateGameServer' :: UpdateGameServer -> Text
gameServerId} -> Text
gameServerId) (\s :: UpdateGameServer
s@UpdateGameServer' {} Text
a -> UpdateGameServer
s {$sel:gameServerId:UpdateGameServer' :: Text
gameServerId = Text
a} :: UpdateGameServer)

instance Core.AWSRequest UpdateGameServer where
  type
    AWSResponse UpdateGameServer =
      UpdateGameServerResponse
  request :: (Service -> Service)
-> UpdateGameServer -> Request UpdateGameServer
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 UpdateGameServer
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateGameServer)))
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 GameServer -> Int -> UpdateGameServerResponse
UpdateGameServerResponse'
            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
"GameServer")
            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 UpdateGameServer where
  hashWithSalt :: Int -> UpdateGameServer -> Int
hashWithSalt Int
_salt UpdateGameServer' {Maybe Text
Maybe GameServerHealthCheck
Maybe GameServerUtilizationStatus
Text
gameServerId :: Text
gameServerGroupName :: Text
utilizationStatus :: Maybe GameServerUtilizationStatus
healthCheck :: Maybe GameServerHealthCheck
gameServerData :: Maybe Text
$sel:gameServerId:UpdateGameServer' :: UpdateGameServer -> Text
$sel:gameServerGroupName:UpdateGameServer' :: UpdateGameServer -> Text
$sel:utilizationStatus:UpdateGameServer' :: UpdateGameServer -> Maybe GameServerUtilizationStatus
$sel:healthCheck:UpdateGameServer' :: UpdateGameServer -> Maybe GameServerHealthCheck
$sel:gameServerData:UpdateGameServer' :: UpdateGameServer -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
gameServerData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GameServerHealthCheck
healthCheck
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GameServerUtilizationStatus
utilizationStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gameServerGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gameServerId

instance Prelude.NFData UpdateGameServer where
  rnf :: UpdateGameServer -> ()
rnf UpdateGameServer' {Maybe Text
Maybe GameServerHealthCheck
Maybe GameServerUtilizationStatus
Text
gameServerId :: Text
gameServerGroupName :: Text
utilizationStatus :: Maybe GameServerUtilizationStatus
healthCheck :: Maybe GameServerHealthCheck
gameServerData :: Maybe Text
$sel:gameServerId:UpdateGameServer' :: UpdateGameServer -> Text
$sel:gameServerGroupName:UpdateGameServer' :: UpdateGameServer -> Text
$sel:utilizationStatus:UpdateGameServer' :: UpdateGameServer -> Maybe GameServerUtilizationStatus
$sel:healthCheck:UpdateGameServer' :: UpdateGameServer -> Maybe GameServerHealthCheck
$sel:gameServerData:UpdateGameServer' :: UpdateGameServer -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
gameServerData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GameServerHealthCheck
healthCheck
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GameServerUtilizationStatus
utilizationStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gameServerGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gameServerId

instance Data.ToHeaders UpdateGameServer where
  toHeaders :: UpdateGameServer -> 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.UpdateGameServer" :: 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 UpdateGameServer where
  toJSON :: UpdateGameServer -> Value
toJSON UpdateGameServer' {Maybe Text
Maybe GameServerHealthCheck
Maybe GameServerUtilizationStatus
Text
gameServerId :: Text
gameServerGroupName :: Text
utilizationStatus :: Maybe GameServerUtilizationStatus
healthCheck :: Maybe GameServerHealthCheck
gameServerData :: Maybe Text
$sel:gameServerId:UpdateGameServer' :: UpdateGameServer -> Text
$sel:gameServerGroupName:UpdateGameServer' :: UpdateGameServer -> Text
$sel:utilizationStatus:UpdateGameServer' :: UpdateGameServer -> Maybe GameServerUtilizationStatus
$sel:healthCheck:UpdateGameServer' :: UpdateGameServer -> Maybe GameServerHealthCheck
$sel:gameServerData:UpdateGameServer' :: UpdateGameServer -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"GameServerData" 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
gameServerData,
            (Key
"HealthCheck" 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 GameServerHealthCheck
healthCheck,
            (Key
"UtilizationStatus" 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 GameServerUtilizationStatus
utilizationStatus,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"GameServerGroupName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
gameServerGroupName),
            forall a. a -> Maybe a
Prelude.Just (Key
"GameServerId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
gameServerId)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateGameServerResponse' 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:
--
-- 'gameServer', 'updateGameServerResponse_gameServer' - Object that describes the newly updated game server.
--
-- 'httpStatus', 'updateGameServerResponse_httpStatus' - The response's http status code.
newUpdateGameServerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateGameServerResponse
newUpdateGameServerResponse :: Int -> UpdateGameServerResponse
newUpdateGameServerResponse Int
pHttpStatus_ =
  UpdateGameServerResponse'
    { $sel:gameServer:UpdateGameServerResponse' :: Maybe GameServer
gameServer =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateGameServerResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Object that describes the newly updated game server.
updateGameServerResponse_gameServer :: Lens.Lens' UpdateGameServerResponse (Prelude.Maybe GameServer)
updateGameServerResponse_gameServer :: Lens' UpdateGameServerResponse (Maybe GameServer)
updateGameServerResponse_gameServer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateGameServerResponse' {Maybe GameServer
gameServer :: Maybe GameServer
$sel:gameServer:UpdateGameServerResponse' :: UpdateGameServerResponse -> Maybe GameServer
gameServer} -> Maybe GameServer
gameServer) (\s :: UpdateGameServerResponse
s@UpdateGameServerResponse' {} Maybe GameServer
a -> UpdateGameServerResponse
s {$sel:gameServer:UpdateGameServerResponse' :: Maybe GameServer
gameServer = Maybe GameServer
a} :: UpdateGameServerResponse)

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

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