{-# 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.CreatePlayerSessions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Reserves open slots in a game session for a group of players. New player
-- sessions can be created in any game session with an open slot that is in
-- @ACTIVE@ status and has a player creation policy of @ACCEPT_ALL@. To add
-- a single player to a game session, use
-- <https://docs.aws.amazon.com/gamelift/latest/apireference/API_CreatePlayerSession.html CreatePlayerSession>
--
-- To create player sessions, specify a game session ID and a list of
-- player IDs. Optionally, provide a set of player data for each player ID.
--
-- If successful, a slot is reserved in the game session for each player,
-- and new @PlayerSession@ objects are returned with player session IDs.
-- Each player references their player session ID when sending a connection
-- request to the game session, and the game server can use it to validate
-- the player reservation with the GameLift service. Player sessions cannot
-- be updated.
--
-- The maximum number of players per game session is 200. It is not
-- adjustable.
--
-- __Related actions__
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/reference-awssdk.html#reference-awssdk-resources-fleets All APIs by task>
module Amazonka.GameLift.CreatePlayerSessions
  ( -- * Creating a Request
    CreatePlayerSessions (..),
    newCreatePlayerSessions,

    -- * Request Lenses
    createPlayerSessions_playerDataMap,
    createPlayerSessions_gameSessionId,
    createPlayerSessions_playerIds,

    -- * Destructuring the Response
    CreatePlayerSessionsResponse (..),
    newCreatePlayerSessionsResponse,

    -- * Response Lenses
    createPlayerSessionsResponse_playerSessions,
    createPlayerSessionsResponse_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:/ 'newCreatePlayerSessions' smart constructor.
data CreatePlayerSessions = CreatePlayerSessions'
  { -- | Map of string pairs, each specifying a player ID and a set of
    -- developer-defined information related to the player. Amazon GameLift
    -- does not use this data, so it can be formatted as needed for use in the
    -- game. Any player data strings for player IDs that are not included in
    -- the @PlayerIds@ parameter are ignored.
    CreatePlayerSessions -> Maybe (HashMap Text Text)
playerDataMap :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A unique identifier for the game session to add players to.
    CreatePlayerSessions -> Text
gameSessionId :: Prelude.Text,
    -- | List of unique identifiers for the players to be added.
    CreatePlayerSessions -> NonEmpty Text
playerIds :: Prelude.NonEmpty Prelude.Text
  }
  deriving (CreatePlayerSessions -> CreatePlayerSessions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePlayerSessions -> CreatePlayerSessions -> Bool
$c/= :: CreatePlayerSessions -> CreatePlayerSessions -> Bool
== :: CreatePlayerSessions -> CreatePlayerSessions -> Bool
$c== :: CreatePlayerSessions -> CreatePlayerSessions -> Bool
Prelude.Eq, ReadPrec [CreatePlayerSessions]
ReadPrec CreatePlayerSessions
Int -> ReadS CreatePlayerSessions
ReadS [CreatePlayerSessions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePlayerSessions]
$creadListPrec :: ReadPrec [CreatePlayerSessions]
readPrec :: ReadPrec CreatePlayerSessions
$creadPrec :: ReadPrec CreatePlayerSessions
readList :: ReadS [CreatePlayerSessions]
$creadList :: ReadS [CreatePlayerSessions]
readsPrec :: Int -> ReadS CreatePlayerSessions
$creadsPrec :: Int -> ReadS CreatePlayerSessions
Prelude.Read, Int -> CreatePlayerSessions -> ShowS
[CreatePlayerSessions] -> ShowS
CreatePlayerSessions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePlayerSessions] -> ShowS
$cshowList :: [CreatePlayerSessions] -> ShowS
show :: CreatePlayerSessions -> String
$cshow :: CreatePlayerSessions -> String
showsPrec :: Int -> CreatePlayerSessions -> ShowS
$cshowsPrec :: Int -> CreatePlayerSessions -> ShowS
Prelude.Show, forall x. Rep CreatePlayerSessions x -> CreatePlayerSessions
forall x. CreatePlayerSessions -> Rep CreatePlayerSessions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePlayerSessions x -> CreatePlayerSessions
$cfrom :: forall x. CreatePlayerSessions -> Rep CreatePlayerSessions x
Prelude.Generic)

-- |
-- Create a value of 'CreatePlayerSessions' 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:
--
-- 'playerDataMap', 'createPlayerSessions_playerDataMap' - Map of string pairs, each specifying a player ID and a set of
-- developer-defined information related to the player. Amazon GameLift
-- does not use this data, so it can be formatted as needed for use in the
-- game. Any player data strings for player IDs that are not included in
-- the @PlayerIds@ parameter are ignored.
--
-- 'gameSessionId', 'createPlayerSessions_gameSessionId' - A unique identifier for the game session to add players to.
--
-- 'playerIds', 'createPlayerSessions_playerIds' - List of unique identifiers for the players to be added.
newCreatePlayerSessions ::
  -- | 'gameSessionId'
  Prelude.Text ->
  -- | 'playerIds'
  Prelude.NonEmpty Prelude.Text ->
  CreatePlayerSessions
newCreatePlayerSessions :: Text -> NonEmpty Text -> CreatePlayerSessions
newCreatePlayerSessions Text
pGameSessionId_ NonEmpty Text
pPlayerIds_ =
  CreatePlayerSessions'
    { $sel:playerDataMap:CreatePlayerSessions' :: Maybe (HashMap Text Text)
playerDataMap =
        forall a. Maybe a
Prelude.Nothing,
      $sel:gameSessionId:CreatePlayerSessions' :: Text
gameSessionId = Text
pGameSessionId_,
      $sel:playerIds:CreatePlayerSessions' :: NonEmpty Text
playerIds = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pPlayerIds_
    }

-- | Map of string pairs, each specifying a player ID and a set of
-- developer-defined information related to the player. Amazon GameLift
-- does not use this data, so it can be formatted as needed for use in the
-- game. Any player data strings for player IDs that are not included in
-- the @PlayerIds@ parameter are ignored.
createPlayerSessions_playerDataMap :: Lens.Lens' CreatePlayerSessions (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createPlayerSessions_playerDataMap :: Lens' CreatePlayerSessions (Maybe (HashMap Text Text))
createPlayerSessions_playerDataMap = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlayerSessions' {Maybe (HashMap Text Text)
playerDataMap :: Maybe (HashMap Text Text)
$sel:playerDataMap:CreatePlayerSessions' :: CreatePlayerSessions -> Maybe (HashMap Text Text)
playerDataMap} -> Maybe (HashMap Text Text)
playerDataMap) (\s :: CreatePlayerSessions
s@CreatePlayerSessions' {} Maybe (HashMap Text Text)
a -> CreatePlayerSessions
s {$sel:playerDataMap:CreatePlayerSessions' :: Maybe (HashMap Text Text)
playerDataMap = Maybe (HashMap Text Text)
a} :: CreatePlayerSessions) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A unique identifier for the game session to add players to.
createPlayerSessions_gameSessionId :: Lens.Lens' CreatePlayerSessions Prelude.Text
createPlayerSessions_gameSessionId :: Lens' CreatePlayerSessions Text
createPlayerSessions_gameSessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlayerSessions' {Text
gameSessionId :: Text
$sel:gameSessionId:CreatePlayerSessions' :: CreatePlayerSessions -> Text
gameSessionId} -> Text
gameSessionId) (\s :: CreatePlayerSessions
s@CreatePlayerSessions' {} Text
a -> CreatePlayerSessions
s {$sel:gameSessionId:CreatePlayerSessions' :: Text
gameSessionId = Text
a} :: CreatePlayerSessions)

-- | List of unique identifiers for the players to be added.
createPlayerSessions_playerIds :: Lens.Lens' CreatePlayerSessions (Prelude.NonEmpty Prelude.Text)
createPlayerSessions_playerIds :: Lens' CreatePlayerSessions (NonEmpty Text)
createPlayerSessions_playerIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlayerSessions' {NonEmpty Text
playerIds :: NonEmpty Text
$sel:playerIds:CreatePlayerSessions' :: CreatePlayerSessions -> NonEmpty Text
playerIds} -> NonEmpty Text
playerIds) (\s :: CreatePlayerSessions
s@CreatePlayerSessions' {} NonEmpty Text
a -> CreatePlayerSessions
s {$sel:playerIds:CreatePlayerSessions' :: NonEmpty Text
playerIds = NonEmpty Text
a} :: CreatePlayerSessions) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreatePlayerSessions where
  type
    AWSResponse CreatePlayerSessions =
      CreatePlayerSessionsResponse
  request :: (Service -> Service)
-> CreatePlayerSessions -> Request CreatePlayerSessions
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 CreatePlayerSessions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreatePlayerSessions)))
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 [PlayerSession] -> Int -> CreatePlayerSessionsResponse
CreatePlayerSessionsResponse'
            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
"PlayerSessions" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 CreatePlayerSessions where
  hashWithSalt :: Int -> CreatePlayerSessions -> Int
hashWithSalt Int
_salt CreatePlayerSessions' {Maybe (HashMap Text Text)
NonEmpty Text
Text
playerIds :: NonEmpty Text
gameSessionId :: Text
playerDataMap :: Maybe (HashMap Text Text)
$sel:playerIds:CreatePlayerSessions' :: CreatePlayerSessions -> NonEmpty Text
$sel:gameSessionId:CreatePlayerSessions' :: CreatePlayerSessions -> Text
$sel:playerDataMap:CreatePlayerSessions' :: CreatePlayerSessions -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
playerDataMap
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gameSessionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
playerIds

instance Prelude.NFData CreatePlayerSessions where
  rnf :: CreatePlayerSessions -> ()
rnf CreatePlayerSessions' {Maybe (HashMap Text Text)
NonEmpty Text
Text
playerIds :: NonEmpty Text
gameSessionId :: Text
playerDataMap :: Maybe (HashMap Text Text)
$sel:playerIds:CreatePlayerSessions' :: CreatePlayerSessions -> NonEmpty Text
$sel:gameSessionId:CreatePlayerSessions' :: CreatePlayerSessions -> Text
$sel:playerDataMap:CreatePlayerSessions' :: CreatePlayerSessions -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
playerDataMap
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gameSessionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
playerIds

instance Data.ToHeaders CreatePlayerSessions where
  toHeaders :: CreatePlayerSessions -> 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.CreatePlayerSessions" ::
                          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 CreatePlayerSessions where
  toJSON :: CreatePlayerSessions -> Value
toJSON CreatePlayerSessions' {Maybe (HashMap Text Text)
NonEmpty Text
Text
playerIds :: NonEmpty Text
gameSessionId :: Text
playerDataMap :: Maybe (HashMap Text Text)
$sel:playerIds:CreatePlayerSessions' :: CreatePlayerSessions -> NonEmpty Text
$sel:gameSessionId:CreatePlayerSessions' :: CreatePlayerSessions -> Text
$sel:playerDataMap:CreatePlayerSessions' :: CreatePlayerSessions -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"PlayerDataMap" 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 (HashMap Text Text)
playerDataMap,
            forall a. a -> Maybe a
Prelude.Just (Key
"GameSessionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
gameSessionId),
            forall a. a -> Maybe a
Prelude.Just (Key
"PlayerIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
playerIds)
          ]
      )

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

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

-- | /See:/ 'newCreatePlayerSessionsResponse' smart constructor.
data CreatePlayerSessionsResponse = CreatePlayerSessionsResponse'
  { -- | A collection of player session objects created for the added players.
    CreatePlayerSessionsResponse -> Maybe [PlayerSession]
playerSessions :: Prelude.Maybe [PlayerSession],
    -- | The response's http status code.
    CreatePlayerSessionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreatePlayerSessionsResponse
-> CreatePlayerSessionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePlayerSessionsResponse
-> CreatePlayerSessionsResponse -> Bool
$c/= :: CreatePlayerSessionsResponse
-> CreatePlayerSessionsResponse -> Bool
== :: CreatePlayerSessionsResponse
-> CreatePlayerSessionsResponse -> Bool
$c== :: CreatePlayerSessionsResponse
-> CreatePlayerSessionsResponse -> Bool
Prelude.Eq, ReadPrec [CreatePlayerSessionsResponse]
ReadPrec CreatePlayerSessionsResponse
Int -> ReadS CreatePlayerSessionsResponse
ReadS [CreatePlayerSessionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePlayerSessionsResponse]
$creadListPrec :: ReadPrec [CreatePlayerSessionsResponse]
readPrec :: ReadPrec CreatePlayerSessionsResponse
$creadPrec :: ReadPrec CreatePlayerSessionsResponse
readList :: ReadS [CreatePlayerSessionsResponse]
$creadList :: ReadS [CreatePlayerSessionsResponse]
readsPrec :: Int -> ReadS CreatePlayerSessionsResponse
$creadsPrec :: Int -> ReadS CreatePlayerSessionsResponse
Prelude.Read, Int -> CreatePlayerSessionsResponse -> ShowS
[CreatePlayerSessionsResponse] -> ShowS
CreatePlayerSessionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePlayerSessionsResponse] -> ShowS
$cshowList :: [CreatePlayerSessionsResponse] -> ShowS
show :: CreatePlayerSessionsResponse -> String
$cshow :: CreatePlayerSessionsResponse -> String
showsPrec :: Int -> CreatePlayerSessionsResponse -> ShowS
$cshowsPrec :: Int -> CreatePlayerSessionsResponse -> ShowS
Prelude.Show, forall x.
Rep CreatePlayerSessionsResponse x -> CreatePlayerSessionsResponse
forall x.
CreatePlayerSessionsResponse -> Rep CreatePlayerSessionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreatePlayerSessionsResponse x -> CreatePlayerSessionsResponse
$cfrom :: forall x.
CreatePlayerSessionsResponse -> Rep CreatePlayerSessionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreatePlayerSessionsResponse' 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:
--
-- 'playerSessions', 'createPlayerSessionsResponse_playerSessions' - A collection of player session objects created for the added players.
--
-- 'httpStatus', 'createPlayerSessionsResponse_httpStatus' - The response's http status code.
newCreatePlayerSessionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreatePlayerSessionsResponse
newCreatePlayerSessionsResponse :: Int -> CreatePlayerSessionsResponse
newCreatePlayerSessionsResponse Int
pHttpStatus_ =
  CreatePlayerSessionsResponse'
    { $sel:playerSessions:CreatePlayerSessionsResponse' :: Maybe [PlayerSession]
playerSessions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreatePlayerSessionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A collection of player session objects created for the added players.
createPlayerSessionsResponse_playerSessions :: Lens.Lens' CreatePlayerSessionsResponse (Prelude.Maybe [PlayerSession])
createPlayerSessionsResponse_playerSessions :: Lens' CreatePlayerSessionsResponse (Maybe [PlayerSession])
createPlayerSessionsResponse_playerSessions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlayerSessionsResponse' {Maybe [PlayerSession]
playerSessions :: Maybe [PlayerSession]
$sel:playerSessions:CreatePlayerSessionsResponse' :: CreatePlayerSessionsResponse -> Maybe [PlayerSession]
playerSessions} -> Maybe [PlayerSession]
playerSessions) (\s :: CreatePlayerSessionsResponse
s@CreatePlayerSessionsResponse' {} Maybe [PlayerSession]
a -> CreatePlayerSessionsResponse
s {$sel:playerSessions:CreatePlayerSessionsResponse' :: Maybe [PlayerSession]
playerSessions = Maybe [PlayerSession]
a} :: CreatePlayerSessionsResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData CreatePlayerSessionsResponse where
  rnf :: CreatePlayerSessionsResponse -> ()
rnf CreatePlayerSessionsResponse' {Int
Maybe [PlayerSession]
httpStatus :: Int
playerSessions :: Maybe [PlayerSession]
$sel:httpStatus:CreatePlayerSessionsResponse' :: CreatePlayerSessionsResponse -> Int
$sel:playerSessions:CreatePlayerSessionsResponse' :: CreatePlayerSessionsResponse -> Maybe [PlayerSession]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [PlayerSession]
playerSessions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus