{-# 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.StartMatchmaking
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Uses FlexMatch to create a game match for a group of players based on
-- custom matchmaking rules. With games that use GameLift managed hosting,
-- this operation also triggers GameLift to find hosting resources and
-- start a new game session for the new match. Each matchmaking request
-- includes information on one or more players and specifies the FlexMatch
-- matchmaker to use. When a request is for multiple players, FlexMatch
-- attempts to build a match that includes all players in the request,
-- placing them in the same team and finding additional players as needed
-- to fill the match.
--
-- To start matchmaking, provide a unique ticket ID, specify a matchmaking
-- configuration, and include the players to be matched. You must also
-- include any player attributes that are required by the matchmaking
-- configuration\'s rule set. If successful, a matchmaking ticket is
-- returned with status set to @QUEUED@.
--
-- Track matchmaking events to respond as needed and acquire game session
-- connection information for successfully completed matches. Ticket status
-- updates are tracked using event notification through Amazon Simple
-- Notification Service, which is defined in the matchmaking configuration.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-client.html Add FlexMatch to a game client>
--
-- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-notification.html Set Up FlexMatch event notification>
--
-- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/gamelift-match.html How GameLift FlexMatch works>
module Amazonka.GameLift.StartMatchmaking
  ( -- * Creating a Request
    StartMatchmaking (..),
    newStartMatchmaking,

    -- * Request Lenses
    startMatchmaking_ticketId,
    startMatchmaking_configurationName,
    startMatchmaking_players,

    -- * Destructuring the Response
    StartMatchmakingResponse (..),
    newStartMatchmakingResponse,

    -- * Response Lenses
    startMatchmakingResponse_matchmakingTicket,
    startMatchmakingResponse_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:/ 'newStartMatchmaking' smart constructor.
data StartMatchmaking = StartMatchmaking'
  { -- | 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 matchmaking ticket status and retrieve
    -- match results.
    StartMatchmaking -> Maybe Text
ticketId :: Prelude.Maybe Prelude.Text,
    -- | Name of the matchmaking configuration to use for this request.
    -- Matchmaking configurations must exist in the same Region as this
    -- request. You can use either the configuration name or ARN value.
    StartMatchmaking -> Text
configurationName :: Prelude.Text,
    -- | Information on each player to be matched. This information must include
    -- a player ID, and may contain player attributes and latency data to be
    -- used in the matchmaking process. After a successful match, @Player@
    -- objects contain the name of the team the player is assigned to.
    --
    -- You can include up to 10 @Players@ in a @StartMatchmaking@ request.
    StartMatchmaking -> [Player]
players :: [Player]
  }
  deriving (StartMatchmaking -> StartMatchmaking -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartMatchmaking -> StartMatchmaking -> Bool
$c/= :: StartMatchmaking -> StartMatchmaking -> Bool
== :: StartMatchmaking -> StartMatchmaking -> Bool
$c== :: StartMatchmaking -> StartMatchmaking -> Bool
Prelude.Eq, ReadPrec [StartMatchmaking]
ReadPrec StartMatchmaking
Int -> ReadS StartMatchmaking
ReadS [StartMatchmaking]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartMatchmaking]
$creadListPrec :: ReadPrec [StartMatchmaking]
readPrec :: ReadPrec StartMatchmaking
$creadPrec :: ReadPrec StartMatchmaking
readList :: ReadS [StartMatchmaking]
$creadList :: ReadS [StartMatchmaking]
readsPrec :: Int -> ReadS StartMatchmaking
$creadsPrec :: Int -> ReadS StartMatchmaking
Prelude.Read, Int -> StartMatchmaking -> ShowS
[StartMatchmaking] -> ShowS
StartMatchmaking -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartMatchmaking] -> ShowS
$cshowList :: [StartMatchmaking] -> ShowS
show :: StartMatchmaking -> String
$cshow :: StartMatchmaking -> String
showsPrec :: Int -> StartMatchmaking -> ShowS
$cshowsPrec :: Int -> StartMatchmaking -> ShowS
Prelude.Show, forall x. Rep StartMatchmaking x -> StartMatchmaking
forall x. StartMatchmaking -> Rep StartMatchmaking x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartMatchmaking x -> StartMatchmaking
$cfrom :: forall x. StartMatchmaking -> Rep StartMatchmaking x
Prelude.Generic)

-- |
-- Create a value of 'StartMatchmaking' 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:
--
-- 'ticketId', 'startMatchmaking_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 matchmaking ticket status and retrieve
-- match results.
--
-- 'configurationName', 'startMatchmaking_configurationName' - Name of the matchmaking configuration to use for this request.
-- Matchmaking configurations must exist in the same Region as this
-- request. You can use either the configuration name or ARN value.
--
-- 'players', 'startMatchmaking_players' - Information on each player to be matched. This information must include
-- a player ID, and may contain player attributes and latency data to be
-- used in the matchmaking process. After a successful match, @Player@
-- objects contain the name of the team the player is assigned to.
--
-- You can include up to 10 @Players@ in a @StartMatchmaking@ request.
newStartMatchmaking ::
  -- | 'configurationName'
  Prelude.Text ->
  StartMatchmaking
newStartMatchmaking :: Text -> StartMatchmaking
newStartMatchmaking Text
pConfigurationName_ =
  StartMatchmaking'
    { $sel:ticketId:StartMatchmaking' :: Maybe Text
ticketId = forall a. Maybe a
Prelude.Nothing,
      $sel:configurationName:StartMatchmaking' :: Text
configurationName = Text
pConfigurationName_,
      $sel:players:StartMatchmaking' :: [Player]
players = forall a. Monoid a => a
Prelude.mempty
    }

-- | 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 matchmaking ticket status and retrieve
-- match results.
startMatchmaking_ticketId :: Lens.Lens' StartMatchmaking (Prelude.Maybe Prelude.Text)
startMatchmaking_ticketId :: Lens' StartMatchmaking (Maybe Text)
startMatchmaking_ticketId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartMatchmaking' {Maybe Text
ticketId :: Maybe Text
$sel:ticketId:StartMatchmaking' :: StartMatchmaking -> Maybe Text
ticketId} -> Maybe Text
ticketId) (\s :: StartMatchmaking
s@StartMatchmaking' {} Maybe Text
a -> StartMatchmaking
s {$sel:ticketId:StartMatchmaking' :: Maybe Text
ticketId = Maybe Text
a} :: StartMatchmaking)

-- | Name of the matchmaking configuration to use for this request.
-- Matchmaking configurations must exist in the same Region as this
-- request. You can use either the configuration name or ARN value.
startMatchmaking_configurationName :: Lens.Lens' StartMatchmaking Prelude.Text
startMatchmaking_configurationName :: Lens' StartMatchmaking Text
startMatchmaking_configurationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartMatchmaking' {Text
configurationName :: Text
$sel:configurationName:StartMatchmaking' :: StartMatchmaking -> Text
configurationName} -> Text
configurationName) (\s :: StartMatchmaking
s@StartMatchmaking' {} Text
a -> StartMatchmaking
s {$sel:configurationName:StartMatchmaking' :: Text
configurationName = Text
a} :: StartMatchmaking)

-- | Information on each player to be matched. This information must include
-- a player ID, and may contain player attributes and latency data to be
-- used in the matchmaking process. After a successful match, @Player@
-- objects contain the name of the team the player is assigned to.
--
-- You can include up to 10 @Players@ in a @StartMatchmaking@ request.
startMatchmaking_players :: Lens.Lens' StartMatchmaking [Player]
startMatchmaking_players :: Lens' StartMatchmaking [Player]
startMatchmaking_players = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartMatchmaking' {[Player]
players :: [Player]
$sel:players:StartMatchmaking' :: StartMatchmaking -> [Player]
players} -> [Player]
players) (\s :: StartMatchmaking
s@StartMatchmaking' {} [Player]
a -> StartMatchmaking
s {$sel:players:StartMatchmaking' :: [Player]
players = [Player]
a} :: StartMatchmaking) 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 StartMatchmaking where
  type
    AWSResponse StartMatchmaking =
      StartMatchmakingResponse
  request :: (Service -> Service)
-> StartMatchmaking -> Request StartMatchmaking
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 StartMatchmaking
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartMatchmaking)))
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 -> StartMatchmakingResponse
StartMatchmakingResponse'
            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 StartMatchmaking where
  hashWithSalt :: Int -> StartMatchmaking -> Int
hashWithSalt Int
_salt StartMatchmaking' {[Player]
Maybe Text
Text
players :: [Player]
configurationName :: Text
ticketId :: Maybe Text
$sel:players:StartMatchmaking' :: StartMatchmaking -> [Player]
$sel:configurationName:StartMatchmaking' :: StartMatchmaking -> Text
$sel:ticketId:StartMatchmaking' :: StartMatchmaking -> Maybe Text
..} =
    Int
_salt
      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 StartMatchmaking where
  rnf :: StartMatchmaking -> ()
rnf StartMatchmaking' {[Player]
Maybe Text
Text
players :: [Player]
configurationName :: Text
ticketId :: Maybe Text
$sel:players:StartMatchmaking' :: StartMatchmaking -> [Player]
$sel:configurationName:StartMatchmaking' :: StartMatchmaking -> Text
$sel:ticketId:StartMatchmaking' :: StartMatchmaking -> Maybe Text
..} =
    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 StartMatchmaking where
  toHeaders :: StartMatchmaking -> 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.StartMatchmaking" :: 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 StartMatchmaking where
  toJSON :: StartMatchmaking -> Value
toJSON StartMatchmaking' {[Player]
Maybe Text
Text
players :: [Player]
configurationName :: Text
ticketId :: Maybe Text
$sel:players:StartMatchmaking' :: StartMatchmaking -> [Player]
$sel:configurationName:StartMatchmaking' :: StartMatchmaking -> Text
$sel:ticketId:StartMatchmaking' :: StartMatchmaking -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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 StartMatchmaking where
  toPath :: StartMatchmaking -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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

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

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