{-# 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.RegisterGameServer
-- 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.__
--
-- Creates a new game server resource and notifies GameLift FleetIQ that
-- the game server is ready to host gameplay and players. This operation is
-- called by a game server process that is running on an instance in a game
-- server group. Registering game servers enables GameLift FleetIQ to track
-- available game servers and enables game clients and services to claim a
-- game server for a new game session.
--
-- To register a game server, identify the game server group and instance
-- where the game server is running, and provide a unique identifier for
-- the game server. You can also include connection and game server data.
--
-- Once a game server is successfully registered, it is put in status
-- @AVAILABLE@. A request to register a game server may fail if the
-- instance it is running on is in the process of shutting down as part of
-- instance balancing or scale-down activity.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/fleetiqguide/gsg-intro.html GameLift FleetIQ Guide>
module Amazonka.GameLift.RegisterGameServer
  ( -- * Creating a Request
    RegisterGameServer (..),
    newRegisterGameServer,

    -- * Request Lenses
    registerGameServer_connectionInfo,
    registerGameServer_gameServerData,
    registerGameServer_gameServerGroupName,
    registerGameServer_gameServerId,
    registerGameServer_instanceId,

    -- * Destructuring the Response
    RegisterGameServerResponse (..),
    newRegisterGameServerResponse,

    -- * Response Lenses
    registerGameServerResponse_gameServer,
    registerGameServerResponse_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:/ 'newRegisterGameServer' smart constructor.
data RegisterGameServer = RegisterGameServer'
  { -- | Information that is needed to make inbound client connections to the
    -- game server. This might include the IP address and port, DNS name, and
    -- other information.
    RegisterGameServer -> Maybe Text
connectionInfo :: Prelude.Maybe Prelude.Text,
    -- | 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.
    RegisterGameServer -> Maybe Text
gameServerData :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the game server group where the game server is
    -- running.
    RegisterGameServer -> Text
gameServerGroupName :: Prelude.Text,
    -- | A custom string that uniquely identifies the game server to register.
    -- Game server IDs are developer-defined and must be unique across all game
    -- server groups in your Amazon Web Services account.
    RegisterGameServer -> Text
gameServerId :: Prelude.Text,
    -- | The unique identifier for the instance where the game server is running.
    -- This ID is available in the instance metadata. EC2 instance IDs use a
    -- 17-character format, for example: @i-1234567890abcdef0@.
    RegisterGameServer -> Text
instanceId :: Prelude.Text
  }
  deriving (RegisterGameServer -> RegisterGameServer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegisterGameServer -> RegisterGameServer -> Bool
$c/= :: RegisterGameServer -> RegisterGameServer -> Bool
== :: RegisterGameServer -> RegisterGameServer -> Bool
$c== :: RegisterGameServer -> RegisterGameServer -> Bool
Prelude.Eq, ReadPrec [RegisterGameServer]
ReadPrec RegisterGameServer
Int -> ReadS RegisterGameServer
ReadS [RegisterGameServer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegisterGameServer]
$creadListPrec :: ReadPrec [RegisterGameServer]
readPrec :: ReadPrec RegisterGameServer
$creadPrec :: ReadPrec RegisterGameServer
readList :: ReadS [RegisterGameServer]
$creadList :: ReadS [RegisterGameServer]
readsPrec :: Int -> ReadS RegisterGameServer
$creadsPrec :: Int -> ReadS RegisterGameServer
Prelude.Read, Int -> RegisterGameServer -> ShowS
[RegisterGameServer] -> ShowS
RegisterGameServer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegisterGameServer] -> ShowS
$cshowList :: [RegisterGameServer] -> ShowS
show :: RegisterGameServer -> String
$cshow :: RegisterGameServer -> String
showsPrec :: Int -> RegisterGameServer -> ShowS
$cshowsPrec :: Int -> RegisterGameServer -> ShowS
Prelude.Show, forall x. Rep RegisterGameServer x -> RegisterGameServer
forall x. RegisterGameServer -> Rep RegisterGameServer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RegisterGameServer x -> RegisterGameServer
$cfrom :: forall x. RegisterGameServer -> Rep RegisterGameServer x
Prelude.Generic)

-- |
-- Create a value of 'RegisterGameServer' 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:
--
-- 'connectionInfo', 'registerGameServer_connectionInfo' - Information that is needed to make inbound client connections to the
-- game server. This might include the IP address and port, DNS name, and
-- other information.
--
-- 'gameServerData', 'registerGameServer_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.
--
-- 'gameServerGroupName', 'registerGameServer_gameServerGroupName' - A unique identifier for the game server group where the game server is
-- running.
--
-- 'gameServerId', 'registerGameServer_gameServerId' - A custom string that uniquely identifies the game server to register.
-- Game server IDs are developer-defined and must be unique across all game
-- server groups in your Amazon Web Services account.
--
-- 'instanceId', 'registerGameServer_instanceId' - The unique identifier for the instance where the game server is running.
-- This ID is available in the instance metadata. EC2 instance IDs use a
-- 17-character format, for example: @i-1234567890abcdef0@.
newRegisterGameServer ::
  -- | 'gameServerGroupName'
  Prelude.Text ->
  -- | 'gameServerId'
  Prelude.Text ->
  -- | 'instanceId'
  Prelude.Text ->
  RegisterGameServer
newRegisterGameServer :: Text -> Text -> Text -> RegisterGameServer
newRegisterGameServer
  Text
pGameServerGroupName_
  Text
pGameServerId_
  Text
pInstanceId_ =
    RegisterGameServer'
      { $sel:connectionInfo:RegisterGameServer' :: Maybe Text
connectionInfo =
          forall a. Maybe a
Prelude.Nothing,
        $sel:gameServerData:RegisterGameServer' :: Maybe Text
gameServerData = forall a. Maybe a
Prelude.Nothing,
        $sel:gameServerGroupName:RegisterGameServer' :: Text
gameServerGroupName = Text
pGameServerGroupName_,
        $sel:gameServerId:RegisterGameServer' :: Text
gameServerId = Text
pGameServerId_,
        $sel:instanceId:RegisterGameServer' :: Text
instanceId = Text
pInstanceId_
      }

-- | Information that is needed to make inbound client connections to the
-- game server. This might include the IP address and port, DNS name, and
-- other information.
registerGameServer_connectionInfo :: Lens.Lens' RegisterGameServer (Prelude.Maybe Prelude.Text)
registerGameServer_connectionInfo :: Lens' RegisterGameServer (Maybe Text)
registerGameServer_connectionInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterGameServer' {Maybe Text
connectionInfo :: Maybe Text
$sel:connectionInfo:RegisterGameServer' :: RegisterGameServer -> Maybe Text
connectionInfo} -> Maybe Text
connectionInfo) (\s :: RegisterGameServer
s@RegisterGameServer' {} Maybe Text
a -> RegisterGameServer
s {$sel:connectionInfo:RegisterGameServer' :: Maybe Text
connectionInfo = Maybe Text
a} :: RegisterGameServer)

-- | 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.
registerGameServer_gameServerData :: Lens.Lens' RegisterGameServer (Prelude.Maybe Prelude.Text)
registerGameServer_gameServerData :: Lens' RegisterGameServer (Maybe Text)
registerGameServer_gameServerData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterGameServer' {Maybe Text
gameServerData :: Maybe Text
$sel:gameServerData:RegisterGameServer' :: RegisterGameServer -> Maybe Text
gameServerData} -> Maybe Text
gameServerData) (\s :: RegisterGameServer
s@RegisterGameServer' {} Maybe Text
a -> RegisterGameServer
s {$sel:gameServerData:RegisterGameServer' :: Maybe Text
gameServerData = Maybe Text
a} :: RegisterGameServer)

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

-- | A custom string that uniquely identifies the game server to register.
-- Game server IDs are developer-defined and must be unique across all game
-- server groups in your Amazon Web Services account.
registerGameServer_gameServerId :: Lens.Lens' RegisterGameServer Prelude.Text
registerGameServer_gameServerId :: Lens' RegisterGameServer Text
registerGameServer_gameServerId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterGameServer' {Text
gameServerId :: Text
$sel:gameServerId:RegisterGameServer' :: RegisterGameServer -> Text
gameServerId} -> Text
gameServerId) (\s :: RegisterGameServer
s@RegisterGameServer' {} Text
a -> RegisterGameServer
s {$sel:gameServerId:RegisterGameServer' :: Text
gameServerId = Text
a} :: RegisterGameServer)

-- | The unique identifier for the instance where the game server is running.
-- This ID is available in the instance metadata. EC2 instance IDs use a
-- 17-character format, for example: @i-1234567890abcdef0@.
registerGameServer_instanceId :: Lens.Lens' RegisterGameServer Prelude.Text
registerGameServer_instanceId :: Lens' RegisterGameServer Text
registerGameServer_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterGameServer' {Text
instanceId :: Text
$sel:instanceId:RegisterGameServer' :: RegisterGameServer -> Text
instanceId} -> Text
instanceId) (\s :: RegisterGameServer
s@RegisterGameServer' {} Text
a -> RegisterGameServer
s {$sel:instanceId:RegisterGameServer' :: Text
instanceId = Text
a} :: RegisterGameServer)

instance Core.AWSRequest RegisterGameServer where
  type
    AWSResponse RegisterGameServer =
      RegisterGameServerResponse
  request :: (Service -> Service)
-> RegisterGameServer -> Request RegisterGameServer
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 RegisterGameServer
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RegisterGameServer)))
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 -> RegisterGameServerResponse
RegisterGameServerResponse'
            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 RegisterGameServer where
  hashWithSalt :: Int -> RegisterGameServer -> Int
hashWithSalt Int
_salt RegisterGameServer' {Maybe Text
Text
instanceId :: Text
gameServerId :: Text
gameServerGroupName :: Text
gameServerData :: Maybe Text
connectionInfo :: Maybe Text
$sel:instanceId:RegisterGameServer' :: RegisterGameServer -> Text
$sel:gameServerId:RegisterGameServer' :: RegisterGameServer -> Text
$sel:gameServerGroupName:RegisterGameServer' :: RegisterGameServer -> Text
$sel:gameServerData:RegisterGameServer' :: RegisterGameServer -> Maybe Text
$sel:connectionInfo:RegisterGameServer' :: RegisterGameServer -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
connectionInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
gameServerData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gameServerGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gameServerId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId

instance Prelude.NFData RegisterGameServer where
  rnf :: RegisterGameServer -> ()
rnf RegisterGameServer' {Maybe Text
Text
instanceId :: Text
gameServerId :: Text
gameServerGroupName :: Text
gameServerData :: Maybe Text
connectionInfo :: Maybe Text
$sel:instanceId:RegisterGameServer' :: RegisterGameServer -> Text
$sel:gameServerId:RegisterGameServer' :: RegisterGameServer -> Text
$sel:gameServerGroupName:RegisterGameServer' :: RegisterGameServer -> Text
$sel:gameServerData:RegisterGameServer' :: RegisterGameServer -> Maybe Text
$sel:connectionInfo:RegisterGameServer' :: RegisterGameServer -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectionInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
gameServerGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gameServerId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceId

instance Data.ToHeaders RegisterGameServer where
  toHeaders :: RegisterGameServer -> 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.RegisterGameServer" ::
                          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 RegisterGameServer where
  toJSON :: RegisterGameServer -> Value
toJSON RegisterGameServer' {Maybe Text
Text
instanceId :: Text
gameServerId :: Text
gameServerGroupName :: Text
gameServerData :: Maybe Text
connectionInfo :: Maybe Text
$sel:instanceId:RegisterGameServer' :: RegisterGameServer -> Text
$sel:gameServerId:RegisterGameServer' :: RegisterGameServer -> Text
$sel:gameServerGroupName:RegisterGameServer' :: RegisterGameServer -> Text
$sel:gameServerData:RegisterGameServer' :: RegisterGameServer -> Maybe Text
$sel:connectionInfo:RegisterGameServer' :: RegisterGameServer -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ConnectionInfo" 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
connectionInfo,
            (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,
            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),
            forall a. a -> Maybe a
Prelude.Just (Key
"InstanceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceId)
          ]
      )

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

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

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

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

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

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

instance Prelude.NFData RegisterGameServerResponse where
  rnf :: RegisterGameServerResponse -> ()
rnf RegisterGameServerResponse' {Int
Maybe GameServer
httpStatus :: Int
gameServer :: Maybe GameServer
$sel:httpStatus:RegisterGameServerResponse' :: RegisterGameServerResponse -> Int
$sel:gameServer:RegisterGameServerResponse' :: RegisterGameServerResponse -> 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