{-# 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.StartMatchBackfill
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Finds new players to fill open slots in currently running game sessions.
-- The backfill match process is essentially identical to the process of
-- forming new matches. Backfill requests use the same matchmaker that was
-- used to make the original match, and they provide matchmaking data for
-- all players currently in the game session. FlexMatch uses this
-- information to select new players so that backfilled match continues to
-- meet the original match requirements.
--
-- When using FlexMatch with GameLift managed hosting, you can request a
-- backfill match from a client service by calling this operation with a
-- @GameSessions@ ID. You also have the option of making backfill requests
-- directly from your game server. In response to a request, FlexMatch
-- creates player sessions for the new players, updates the @GameSession@
-- resource, and sends updated matchmaking data to the game server. You can
-- request a backfill match at any point after a game session is started.
-- Each game session can have only one active backfill request at a time; a
-- subsequent request automatically replaces the earlier request.
--
-- When using FlexMatch as a standalone component, request a backfill match
-- by calling this operation without a game session identifier. As with
-- newly formed matches, matchmaking results are returned in a matchmaking
-- event so that your game can update the game session that is being
-- backfilled.
--
-- To request a backfill match, specify a unique ticket ID, the original
-- matchmaking configuration, and matchmaking data for all current players
-- in the game session being backfilled. Optionally, specify the
-- @GameSession@ ARN. If successful, a match backfill ticket is created and
-- returned with status set to QUEUED. Track the status of backfill tickets
-- using the same method for tracking tickets for new matches.
--
-- Only game sessions created by FlexMatch are supported for match
-- backfill.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-backfill.html Backfill existing games with FlexMatch>
--
-- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-events.html Matchmaking events>
-- (reference)
--
-- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/gamelift-match.html How GameLift FlexMatch works>
module Amazonka.GameLift.StartMatchBackfill
  ( -- * Creating a Request
    StartMatchBackfill (..),
    newStartMatchBackfill,

    -- * Request Lenses
    startMatchBackfill_gameSessionArn,
    startMatchBackfill_ticketId,
    startMatchBackfill_configurationName,
    startMatchBackfill_players,

    -- * Destructuring the Response
    StartMatchBackfillResponse (..),
    newStartMatchBackfillResponse,

    -- * Response Lenses
    startMatchBackfillResponse_matchmakingTicket,
    startMatchBackfillResponse_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:/ 'newStartMatchBackfill' smart constructor.
data StartMatchBackfill = StartMatchBackfill'
  { -- | A unique identifier for the game session. Use the game session ID. When
    -- using FlexMatch as a standalone matchmaking solution, this parameter is
    -- not needed.
    StartMatchBackfill -> Maybe Text
gameSessionArn :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for a matchmaking ticket. If no ticket ID is
    -- specified here, Amazon GameLift will generate one in the form of a UUID.
    -- Use this identifier to track the match backfill ticket status and
    -- retrieve match results.
    StartMatchBackfill -> Maybe Text
ticketId :: Prelude.Maybe Prelude.Text,
    -- | Name of the matchmaker to use for this request. You can use either the
    -- configuration name or ARN value. The ARN of the matchmaker that was used
    -- with the original game session is listed in the @GameSession@ object,
    -- @MatchmakerData@ property.
    StartMatchBackfill -> Text
configurationName :: Prelude.Text,
    -- | Match information on all players that are currently assigned to the game
    -- session. This information is used by the matchmaker to find new players
    -- and add them to the existing game.
    --
    -- You can include up to 199 @Players@ in a @StartMatchBackfill@ request.
    --
    -- -   PlayerID, PlayerAttributes, Team -- This information is maintained
    --     in the @GameSession@ object, @MatchmakerData@ property, for all
    --     players who are currently assigned to the game session. The
    --     matchmaker data is in JSON syntax, formatted as a string. For more
    --     details, see
    --     <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-server.html#match-server-data Match Data>.
    --
    --     The backfill request must specify the team membership for every
    --     player. Do not specify team if you are not using backfill.
    --
    -- -   LatencyInMs -- If the matchmaker uses player latency, include a
    --     latency value, in milliseconds, for the Region that the game session
    --     is currently in. Do not include latency values for any other Region.
    StartMatchBackfill -> [Player]
players :: [Player]
  }
  deriving (StartMatchBackfill -> StartMatchBackfill -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartMatchBackfill -> StartMatchBackfill -> Bool
$c/= :: StartMatchBackfill -> StartMatchBackfill -> Bool
== :: StartMatchBackfill -> StartMatchBackfill -> Bool
$c== :: StartMatchBackfill -> StartMatchBackfill -> Bool
Prelude.Eq, ReadPrec [StartMatchBackfill]
ReadPrec StartMatchBackfill
Int -> ReadS StartMatchBackfill
ReadS [StartMatchBackfill]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartMatchBackfill]
$creadListPrec :: ReadPrec [StartMatchBackfill]
readPrec :: ReadPrec StartMatchBackfill
$creadPrec :: ReadPrec StartMatchBackfill
readList :: ReadS [StartMatchBackfill]
$creadList :: ReadS [StartMatchBackfill]
readsPrec :: Int -> ReadS StartMatchBackfill
$creadsPrec :: Int -> ReadS StartMatchBackfill
Prelude.Read, Int -> StartMatchBackfill -> ShowS
[StartMatchBackfill] -> ShowS
StartMatchBackfill -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartMatchBackfill] -> ShowS
$cshowList :: [StartMatchBackfill] -> ShowS
show :: StartMatchBackfill -> String
$cshow :: StartMatchBackfill -> String
showsPrec :: Int -> StartMatchBackfill -> ShowS
$cshowsPrec :: Int -> StartMatchBackfill -> ShowS
Prelude.Show, forall x. Rep StartMatchBackfill x -> StartMatchBackfill
forall x. StartMatchBackfill -> Rep StartMatchBackfill x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartMatchBackfill x -> StartMatchBackfill
$cfrom :: forall x. StartMatchBackfill -> Rep StartMatchBackfill x
Prelude.Generic)

-- |
-- Create a value of 'StartMatchBackfill' 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:
--
-- 'gameSessionArn', 'startMatchBackfill_gameSessionArn' - A unique identifier for the game session. Use the game session ID. When
-- using FlexMatch as a standalone matchmaking solution, this parameter is
-- not needed.
--
-- 'ticketId', 'startMatchBackfill_ticketId' - A unique identifier for a matchmaking ticket. If no ticket ID is
-- specified here, Amazon GameLift will generate one in the form of a UUID.
-- Use this identifier to track the match backfill ticket status and
-- retrieve match results.
--
-- 'configurationName', 'startMatchBackfill_configurationName' - Name of the matchmaker to use for this request. You can use either the
-- configuration name or ARN value. The ARN of the matchmaker that was used
-- with the original game session is listed in the @GameSession@ object,
-- @MatchmakerData@ property.
--
-- 'players', 'startMatchBackfill_players' - Match information on all players that are currently assigned to the game
-- session. This information is used by the matchmaker to find new players
-- and add them to the existing game.
--
-- You can include up to 199 @Players@ in a @StartMatchBackfill@ request.
--
-- -   PlayerID, PlayerAttributes, Team -- This information is maintained
--     in the @GameSession@ object, @MatchmakerData@ property, for all
--     players who are currently assigned to the game session. The
--     matchmaker data is in JSON syntax, formatted as a string. For more
--     details, see
--     <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-server.html#match-server-data Match Data>.
--
--     The backfill request must specify the team membership for every
--     player. Do not specify team if you are not using backfill.
--
-- -   LatencyInMs -- If the matchmaker uses player latency, include a
--     latency value, in milliseconds, for the Region that the game session
--     is currently in. Do not include latency values for any other Region.
newStartMatchBackfill ::
  -- | 'configurationName'
  Prelude.Text ->
  StartMatchBackfill
newStartMatchBackfill :: Text -> StartMatchBackfill
newStartMatchBackfill Text
pConfigurationName_ =
  StartMatchBackfill'
    { $sel:gameSessionArn:StartMatchBackfill' :: Maybe Text
gameSessionArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:ticketId:StartMatchBackfill' :: Maybe Text
ticketId = forall a. Maybe a
Prelude.Nothing,
      $sel:configurationName:StartMatchBackfill' :: Text
configurationName = Text
pConfigurationName_,
      $sel:players:StartMatchBackfill' :: [Player]
players = forall a. Monoid a => a
Prelude.mempty
    }

-- | A unique identifier for the game session. Use the game session ID. When
-- using FlexMatch as a standalone matchmaking solution, this parameter is
-- not needed.
startMatchBackfill_gameSessionArn :: Lens.Lens' StartMatchBackfill (Prelude.Maybe Prelude.Text)
startMatchBackfill_gameSessionArn :: Lens' StartMatchBackfill (Maybe Text)
startMatchBackfill_gameSessionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartMatchBackfill' {Maybe Text
gameSessionArn :: Maybe Text
$sel:gameSessionArn:StartMatchBackfill' :: StartMatchBackfill -> Maybe Text
gameSessionArn} -> Maybe Text
gameSessionArn) (\s :: StartMatchBackfill
s@StartMatchBackfill' {} Maybe Text
a -> StartMatchBackfill
s {$sel:gameSessionArn:StartMatchBackfill' :: Maybe Text
gameSessionArn = Maybe Text
a} :: StartMatchBackfill)

-- | A unique identifier for a matchmaking ticket. If no ticket ID is
-- specified here, Amazon GameLift will generate one in the form of a UUID.
-- Use this identifier to track the match backfill ticket status and
-- retrieve match results.
startMatchBackfill_ticketId :: Lens.Lens' StartMatchBackfill (Prelude.Maybe Prelude.Text)
startMatchBackfill_ticketId :: Lens' StartMatchBackfill (Maybe Text)
startMatchBackfill_ticketId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartMatchBackfill' {Maybe Text
ticketId :: Maybe Text
$sel:ticketId:StartMatchBackfill' :: StartMatchBackfill -> Maybe Text
ticketId} -> Maybe Text
ticketId) (\s :: StartMatchBackfill
s@StartMatchBackfill' {} Maybe Text
a -> StartMatchBackfill
s {$sel:ticketId:StartMatchBackfill' :: Maybe Text
ticketId = Maybe Text
a} :: StartMatchBackfill)

-- | Name of the matchmaker to use for this request. You can use either the
-- configuration name or ARN value. The ARN of the matchmaker that was used
-- with the original game session is listed in the @GameSession@ object,
-- @MatchmakerData@ property.
startMatchBackfill_configurationName :: Lens.Lens' StartMatchBackfill Prelude.Text
startMatchBackfill_configurationName :: Lens' StartMatchBackfill Text
startMatchBackfill_configurationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartMatchBackfill' {Text
configurationName :: Text
$sel:configurationName:StartMatchBackfill' :: StartMatchBackfill -> Text
configurationName} -> Text
configurationName) (\s :: StartMatchBackfill
s@StartMatchBackfill' {} Text
a -> StartMatchBackfill
s {$sel:configurationName:StartMatchBackfill' :: Text
configurationName = Text
a} :: StartMatchBackfill)

-- | Match information on all players that are currently assigned to the game
-- session. This information is used by the matchmaker to find new players
-- and add them to the existing game.
--
-- You can include up to 199 @Players@ in a @StartMatchBackfill@ request.
--
-- -   PlayerID, PlayerAttributes, Team -- This information is maintained
--     in the @GameSession@ object, @MatchmakerData@ property, for all
--     players who are currently assigned to the game session. The
--     matchmaker data is in JSON syntax, formatted as a string. For more
--     details, see
--     <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-server.html#match-server-data Match Data>.
--
--     The backfill request must specify the team membership for every
--     player. Do not specify team if you are not using backfill.
--
-- -   LatencyInMs -- If the matchmaker uses player latency, include a
--     latency value, in milliseconds, for the Region that the game session
--     is currently in. Do not include latency values for any other Region.
startMatchBackfill_players :: Lens.Lens' StartMatchBackfill [Player]
startMatchBackfill_players :: Lens' StartMatchBackfill [Player]
startMatchBackfill_players = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartMatchBackfill' {[Player]
players :: [Player]
$sel:players:StartMatchBackfill' :: StartMatchBackfill -> [Player]
players} -> [Player]
players) (\s :: StartMatchBackfill
s@StartMatchBackfill' {} [Player]
a -> StartMatchBackfill
s {$sel:players:StartMatchBackfill' :: [Player]
players = [Player]
a} :: StartMatchBackfill) 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 StartMatchBackfill where
  type
    AWSResponse StartMatchBackfill =
      StartMatchBackfillResponse
  request :: (Service -> Service)
-> StartMatchBackfill -> Request StartMatchBackfill
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 StartMatchBackfill
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartMatchBackfill)))
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 MatchmakingTicket -> Int -> StartMatchBackfillResponse
StartMatchBackfillResponse'
            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
"MatchmakingTicket")
            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 StartMatchBackfill where
  hashWithSalt :: Int -> StartMatchBackfill -> Int
hashWithSalt Int
_salt StartMatchBackfill' {[Player]
Maybe Text
Text
players :: [Player]
configurationName :: Text
ticketId :: Maybe Text
gameSessionArn :: Maybe Text
$sel:players:StartMatchBackfill' :: StartMatchBackfill -> [Player]
$sel:configurationName:StartMatchBackfill' :: StartMatchBackfill -> Text
$sel:ticketId:StartMatchBackfill' :: StartMatchBackfill -> Maybe Text
$sel:gameSessionArn:StartMatchBackfill' :: StartMatchBackfill -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
gameSessionArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ticketId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
configurationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Player]
players

instance Prelude.NFData StartMatchBackfill where
  rnf :: StartMatchBackfill -> ()
rnf StartMatchBackfill' {[Player]
Maybe Text
Text
players :: [Player]
configurationName :: Text
ticketId :: Maybe Text
gameSessionArn :: Maybe Text
$sel:players:StartMatchBackfill' :: StartMatchBackfill -> [Player]
$sel:configurationName:StartMatchBackfill' :: StartMatchBackfill -> Text
$sel:ticketId:StartMatchBackfill' :: StartMatchBackfill -> Maybe Text
$sel:gameSessionArn:StartMatchBackfill' :: StartMatchBackfill -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
gameSessionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ticketId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
configurationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Player]
players

instance Data.ToHeaders StartMatchBackfill where
  toHeaders :: StartMatchBackfill -> 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.StartMatchBackfill" ::
                          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 StartMatchBackfill where
  toJSON :: StartMatchBackfill -> Value
toJSON StartMatchBackfill' {[Player]
Maybe Text
Text
players :: [Player]
configurationName :: Text
ticketId :: Maybe Text
gameSessionArn :: Maybe Text
$sel:players:StartMatchBackfill' :: StartMatchBackfill -> [Player]
$sel:configurationName:StartMatchBackfill' :: StartMatchBackfill -> Text
$sel:ticketId:StartMatchBackfill' :: StartMatchBackfill -> Maybe Text
$sel:gameSessionArn:StartMatchBackfill' :: StartMatchBackfill -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"GameSessionArn" 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
gameSessionArn,
            (Key
"TicketId" 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
ticketId,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ConfigurationName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
configurationName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Players" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Player]
players)
          ]
      )

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

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

-- | /See:/ 'newStartMatchBackfillResponse' smart constructor.
data StartMatchBackfillResponse = StartMatchBackfillResponse'
  { -- | Ticket representing the backfill matchmaking request. This object
    -- includes the information in the request, ticket status, and match
    -- results as generated during the matchmaking process.
    StartMatchBackfillResponse -> Maybe MatchmakingTicket
matchmakingTicket :: Prelude.Maybe MatchmakingTicket,
    -- | The response's http status code.
    StartMatchBackfillResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartMatchBackfillResponse -> StartMatchBackfillResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartMatchBackfillResponse -> StartMatchBackfillResponse -> Bool
$c/= :: StartMatchBackfillResponse -> StartMatchBackfillResponse -> Bool
== :: StartMatchBackfillResponse -> StartMatchBackfillResponse -> Bool
$c== :: StartMatchBackfillResponse -> StartMatchBackfillResponse -> Bool
Prelude.Eq, ReadPrec [StartMatchBackfillResponse]
ReadPrec StartMatchBackfillResponse
Int -> ReadS StartMatchBackfillResponse
ReadS [StartMatchBackfillResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartMatchBackfillResponse]
$creadListPrec :: ReadPrec [StartMatchBackfillResponse]
readPrec :: ReadPrec StartMatchBackfillResponse
$creadPrec :: ReadPrec StartMatchBackfillResponse
readList :: ReadS [StartMatchBackfillResponse]
$creadList :: ReadS [StartMatchBackfillResponse]
readsPrec :: Int -> ReadS StartMatchBackfillResponse
$creadsPrec :: Int -> ReadS StartMatchBackfillResponse
Prelude.Read, Int -> StartMatchBackfillResponse -> ShowS
[StartMatchBackfillResponse] -> ShowS
StartMatchBackfillResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartMatchBackfillResponse] -> ShowS
$cshowList :: [StartMatchBackfillResponse] -> ShowS
show :: StartMatchBackfillResponse -> String
$cshow :: StartMatchBackfillResponse -> String
showsPrec :: Int -> StartMatchBackfillResponse -> ShowS
$cshowsPrec :: Int -> StartMatchBackfillResponse -> ShowS
Prelude.Show, forall x.
Rep StartMatchBackfillResponse x -> StartMatchBackfillResponse
forall x.
StartMatchBackfillResponse -> Rep StartMatchBackfillResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartMatchBackfillResponse x -> StartMatchBackfillResponse
$cfrom :: forall x.
StartMatchBackfillResponse -> Rep StartMatchBackfillResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartMatchBackfillResponse' 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:
--
-- 'matchmakingTicket', 'startMatchBackfillResponse_matchmakingTicket' - Ticket representing the backfill matchmaking request. This object
-- includes the information in the request, ticket status, and match
-- results as generated during the matchmaking process.
--
-- 'httpStatus', 'startMatchBackfillResponse_httpStatus' - The response's http status code.
newStartMatchBackfillResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartMatchBackfillResponse
newStartMatchBackfillResponse :: Int -> StartMatchBackfillResponse
newStartMatchBackfillResponse Int
pHttpStatus_ =
  StartMatchBackfillResponse'
    { $sel:matchmakingTicket:StartMatchBackfillResponse' :: Maybe MatchmakingTicket
matchmakingTicket =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartMatchBackfillResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Ticket representing the backfill matchmaking request. This object
-- includes the information in the request, ticket status, and match
-- results as generated during the matchmaking process.
startMatchBackfillResponse_matchmakingTicket :: Lens.Lens' StartMatchBackfillResponse (Prelude.Maybe MatchmakingTicket)
startMatchBackfillResponse_matchmakingTicket :: Lens' StartMatchBackfillResponse (Maybe MatchmakingTicket)
startMatchBackfillResponse_matchmakingTicket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartMatchBackfillResponse' {Maybe MatchmakingTicket
matchmakingTicket :: Maybe MatchmakingTicket
$sel:matchmakingTicket:StartMatchBackfillResponse' :: StartMatchBackfillResponse -> Maybe MatchmakingTicket
matchmakingTicket} -> Maybe MatchmakingTicket
matchmakingTicket) (\s :: StartMatchBackfillResponse
s@StartMatchBackfillResponse' {} Maybe MatchmakingTicket
a -> StartMatchBackfillResponse
s {$sel:matchmakingTicket:StartMatchBackfillResponse' :: Maybe MatchmakingTicket
matchmakingTicket = Maybe MatchmakingTicket
a} :: StartMatchBackfillResponse)

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

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