{-# 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.CreateMatchmakingConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Defines a new matchmaking configuration for use with FlexMatch. Whether
-- your are using FlexMatch with GameLift hosting or as a standalone
-- matchmaking service, the matchmaking configuration sets out rules for
-- matching players and forming teams. If you\'re also using GameLift
-- hosting, it defines how to start game sessions for each match. Your
-- matchmaking system can use multiple configurations to handle different
-- game scenarios. All matchmaking requests identify the matchmaking
-- configuration to use and provide player attributes consistent with that
-- configuration.
--
-- To create a matchmaking configuration, you must provide the following:
-- configuration name and FlexMatch mode (with or without GameLift
-- hosting); a rule set that specifies how to evaluate players and find
-- acceptable matches; whether player acceptance is required; and the
-- maximum time allowed for a matchmaking attempt. When using FlexMatch
-- with GameLift hosting, you also need to identify the game session queue
-- to use when starting a game session for the match.
--
-- In addition, you must set up an Amazon Simple Notification Service topic
-- to receive matchmaking notifications. Provide the topic ARN in the
-- matchmaking configuration.
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-configuration.html Design a FlexMatch matchmaker>
--
-- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-notification.html Set up FlexMatch event notification>
module Amazonka.GameLift.CreateMatchmakingConfiguration
  ( -- * Creating a Request
    CreateMatchmakingConfiguration (..),
    newCreateMatchmakingConfiguration,

    -- * Request Lenses
    createMatchmakingConfiguration_acceptanceTimeoutSeconds,
    createMatchmakingConfiguration_additionalPlayerCount,
    createMatchmakingConfiguration_backfillMode,
    createMatchmakingConfiguration_customEventData,
    createMatchmakingConfiguration_description,
    createMatchmakingConfiguration_flexMatchMode,
    createMatchmakingConfiguration_gameProperties,
    createMatchmakingConfiguration_gameSessionData,
    createMatchmakingConfiguration_gameSessionQueueArns,
    createMatchmakingConfiguration_notificationTarget,
    createMatchmakingConfiguration_tags,
    createMatchmakingConfiguration_name,
    createMatchmakingConfiguration_requestTimeoutSeconds,
    createMatchmakingConfiguration_acceptanceRequired,
    createMatchmakingConfiguration_ruleSetName,

    -- * Destructuring the Response
    CreateMatchmakingConfigurationResponse (..),
    newCreateMatchmakingConfigurationResponse,

    -- * Response Lenses
    createMatchmakingConfigurationResponse_configuration,
    createMatchmakingConfigurationResponse_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:/ 'newCreateMatchmakingConfiguration' smart constructor.
data CreateMatchmakingConfiguration = CreateMatchmakingConfiguration'
  { -- | The length of time (in seconds) to wait for players to accept a proposed
    -- match, if acceptance is required.
    CreateMatchmakingConfiguration -> Maybe Natural
acceptanceTimeoutSeconds :: Prelude.Maybe Prelude.Natural,
    -- | The number of player slots in a match to keep open for future players.
    -- For example, if the configuration\'s rule set specifies a match for a
    -- single 12-person team, and the additional player count is set to 2, only
    -- 10 players are selected for the match. This parameter is not used if
    -- @FlexMatchMode@ is set to @STANDALONE@.
    CreateMatchmakingConfiguration -> Maybe Natural
additionalPlayerCount :: Prelude.Maybe Prelude.Natural,
    -- | The method used to backfill game sessions that are created with this
    -- matchmaking configuration. Specify @MANUAL@ when your game manages
    -- backfill requests manually or does not use the match backfill feature.
    -- Specify @AUTOMATIC@ to have GameLift create a backfill request whenever
    -- a game session has one or more open slots. Learn more about manual and
    -- automatic backfill in
    -- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-backfill.html Backfill Existing Games with FlexMatch>.
    -- Automatic backfill is not available when @FlexMatchMode@ is set to
    -- @STANDALONE@.
    CreateMatchmakingConfiguration -> Maybe BackfillMode
backfillMode :: Prelude.Maybe BackfillMode,
    -- | Information to be added to all events related to this matchmaking
    -- configuration.
    CreateMatchmakingConfiguration -> Maybe Text
customEventData :: Prelude.Maybe Prelude.Text,
    -- | A human-readable description of the matchmaking configuration.
    CreateMatchmakingConfiguration -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether this matchmaking configuration is being used with
    -- GameLift hosting or as a standalone matchmaking solution.
    --
    -- -   __STANDALONE__ - FlexMatch forms matches and returns match
    --     information, including players and team assignments, in a
    --     <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-events.html#match-events-matchmakingsucceeded MatchmakingSucceeded>
    --     event.
    --
    -- -   __WITH_QUEUE__ - FlexMatch forms matches and uses the specified
    --     GameLift queue to start a game session for the match.
    CreateMatchmakingConfiguration -> Maybe FlexMatchMode
flexMatchMode :: Prelude.Maybe FlexMatchMode,
    -- | A set of custom properties for a game session, formatted as key:value
    -- pairs. These properties are passed to a game server process with a
    -- request to start a new game session (see
    -- <https://docs.aws.amazon.com/gamelift/latest/developerguide/gamelift-sdk-server-api.html#gamelift-sdk-server-startsession Start a Game Session>).
    -- This information is added to the new @GameSession@ object that is
    -- created for a successful match. This parameter is not used if
    -- @FlexMatchMode@ is set to @STANDALONE@.
    CreateMatchmakingConfiguration -> Maybe [GameProperty]
gameProperties :: Prelude.Maybe [GameProperty],
    -- | A set of custom game session properties, formatted as a single string
    -- value. This data is passed to a game server process with a request to
    -- start a new game session (see
    -- <https://docs.aws.amazon.com/gamelift/latest/developerguide/gamelift-sdk-server-api.html#gamelift-sdk-server-startsession Start a Game Session>).
    -- This information is added to the new @GameSession@ object that is
    -- created for a successful match. This parameter is not used if
    -- @FlexMatchMode@ is set to @STANDALONE@.
    CreateMatchmakingConfiguration -> Maybe Text
gameSessionData :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name
    -- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
    -- that is assigned to a GameLift game session queue resource and uniquely
    -- identifies it. ARNs are unique across all Regions. Format is
    -- @arn:aws:gamelift:\<region>::gamesessionqueue\/\<queue name>@. Queues
    -- can be located in any Region. Queues are used to start new
    -- GameLift-hosted game sessions for matches that are created with this
    -- matchmaking configuration. If @FlexMatchMode@ is set to @STANDALONE@, do
    -- not set this parameter.
    CreateMatchmakingConfiguration -> Maybe [Text]
gameSessionQueueArns :: Prelude.Maybe [Prelude.Text],
    -- | An SNS topic ARN that is set up to receive matchmaking notifications.
    -- See
    -- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-notification.html Setting up notifications for matchmaking>
    -- for more information.
    CreateMatchmakingConfiguration -> Maybe Text
notificationTarget :: Prelude.Maybe Prelude.Text,
    -- | A list of labels to assign to the new matchmaking configuration
    -- resource. Tags are developer-defined key-value pairs. Tagging Amazon Web
    -- Services resources are useful for resource management, access management
    -- and cost allocation. For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
    -- in the /Amazon Web Services General Reference/.
    CreateMatchmakingConfiguration -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A unique identifier for the matchmaking configuration. This name is used
    -- to identify the configuration associated with a matchmaking request or
    -- ticket.
    CreateMatchmakingConfiguration -> Text
name :: Prelude.Text,
    -- | The maximum duration, in seconds, that a matchmaking ticket can remain
    -- in process before timing out. Requests that fail due to timing out can
    -- be resubmitted as needed.
    CreateMatchmakingConfiguration -> Natural
requestTimeoutSeconds :: Prelude.Natural,
    -- | A flag that determines whether a match that was created with this
    -- configuration must be accepted by the matched players. To require
    -- acceptance, set to @TRUE@. With this option enabled, matchmaking tickets
    -- use the status @REQUIRES_ACCEPTANCE@ to indicate when a completed
    -- potential match is waiting for player acceptance.
    CreateMatchmakingConfiguration -> Bool
acceptanceRequired :: Prelude.Bool,
    -- | A unique identifier for the matchmaking rule set to use with this
    -- configuration. You can use either the rule set name or ARN value. A
    -- matchmaking configuration can only use rule sets that are defined in the
    -- same Region.
    CreateMatchmakingConfiguration -> Text
ruleSetName :: Prelude.Text
  }
  deriving (CreateMatchmakingConfiguration
-> CreateMatchmakingConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMatchmakingConfiguration
-> CreateMatchmakingConfiguration -> Bool
$c/= :: CreateMatchmakingConfiguration
-> CreateMatchmakingConfiguration -> Bool
== :: CreateMatchmakingConfiguration
-> CreateMatchmakingConfiguration -> Bool
$c== :: CreateMatchmakingConfiguration
-> CreateMatchmakingConfiguration -> Bool
Prelude.Eq, ReadPrec [CreateMatchmakingConfiguration]
ReadPrec CreateMatchmakingConfiguration
Int -> ReadS CreateMatchmakingConfiguration
ReadS [CreateMatchmakingConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateMatchmakingConfiguration]
$creadListPrec :: ReadPrec [CreateMatchmakingConfiguration]
readPrec :: ReadPrec CreateMatchmakingConfiguration
$creadPrec :: ReadPrec CreateMatchmakingConfiguration
readList :: ReadS [CreateMatchmakingConfiguration]
$creadList :: ReadS [CreateMatchmakingConfiguration]
readsPrec :: Int -> ReadS CreateMatchmakingConfiguration
$creadsPrec :: Int -> ReadS CreateMatchmakingConfiguration
Prelude.Read, Int -> CreateMatchmakingConfiguration -> ShowS
[CreateMatchmakingConfiguration] -> ShowS
CreateMatchmakingConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMatchmakingConfiguration] -> ShowS
$cshowList :: [CreateMatchmakingConfiguration] -> ShowS
show :: CreateMatchmakingConfiguration -> String
$cshow :: CreateMatchmakingConfiguration -> String
showsPrec :: Int -> CreateMatchmakingConfiguration -> ShowS
$cshowsPrec :: Int -> CreateMatchmakingConfiguration -> ShowS
Prelude.Show, forall x.
Rep CreateMatchmakingConfiguration x
-> CreateMatchmakingConfiguration
forall x.
CreateMatchmakingConfiguration
-> Rep CreateMatchmakingConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateMatchmakingConfiguration x
-> CreateMatchmakingConfiguration
$cfrom :: forall x.
CreateMatchmakingConfiguration
-> Rep CreateMatchmakingConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'CreateMatchmakingConfiguration' 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:
--
-- 'acceptanceTimeoutSeconds', 'createMatchmakingConfiguration_acceptanceTimeoutSeconds' - The length of time (in seconds) to wait for players to accept a proposed
-- match, if acceptance is required.
--
-- 'additionalPlayerCount', 'createMatchmakingConfiguration_additionalPlayerCount' - The number of player slots in a match to keep open for future players.
-- For example, if the configuration\'s rule set specifies a match for a
-- single 12-person team, and the additional player count is set to 2, only
-- 10 players are selected for the match. This parameter is not used if
-- @FlexMatchMode@ is set to @STANDALONE@.
--
-- 'backfillMode', 'createMatchmakingConfiguration_backfillMode' - The method used to backfill game sessions that are created with this
-- matchmaking configuration. Specify @MANUAL@ when your game manages
-- backfill requests manually or does not use the match backfill feature.
-- Specify @AUTOMATIC@ to have GameLift create a backfill request whenever
-- a game session has one or more open slots. Learn more about manual and
-- automatic backfill in
-- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-backfill.html Backfill Existing Games with FlexMatch>.
-- Automatic backfill is not available when @FlexMatchMode@ is set to
-- @STANDALONE@.
--
-- 'customEventData', 'createMatchmakingConfiguration_customEventData' - Information to be added to all events related to this matchmaking
-- configuration.
--
-- 'description', 'createMatchmakingConfiguration_description' - A human-readable description of the matchmaking configuration.
--
-- 'flexMatchMode', 'createMatchmakingConfiguration_flexMatchMode' - Indicates whether this matchmaking configuration is being used with
-- GameLift hosting or as a standalone matchmaking solution.
--
-- -   __STANDALONE__ - FlexMatch forms matches and returns match
--     information, including players and team assignments, in a
--     <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-events.html#match-events-matchmakingsucceeded MatchmakingSucceeded>
--     event.
--
-- -   __WITH_QUEUE__ - FlexMatch forms matches and uses the specified
--     GameLift queue to start a game session for the match.
--
-- 'gameProperties', 'createMatchmakingConfiguration_gameProperties' - A set of custom properties for a game session, formatted as key:value
-- pairs. These properties are passed to a game server process with a
-- request to start a new game session (see
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/gamelift-sdk-server-api.html#gamelift-sdk-server-startsession Start a Game Session>).
-- This information is added to the new @GameSession@ object that is
-- created for a successful match. This parameter is not used if
-- @FlexMatchMode@ is set to @STANDALONE@.
--
-- 'gameSessionData', 'createMatchmakingConfiguration_gameSessionData' - A set of custom game session properties, formatted as a single string
-- value. This data is passed to a game server process with a request to
-- start a new game session (see
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/gamelift-sdk-server-api.html#gamelift-sdk-server-startsession Start a Game Session>).
-- This information is added to the new @GameSession@ object that is
-- created for a successful match. This parameter is not used if
-- @FlexMatchMode@ is set to @STANDALONE@.
--
-- 'gameSessionQueueArns', 'createMatchmakingConfiguration_gameSessionQueueArns' - The Amazon Resource Name
-- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
-- that is assigned to a GameLift game session queue resource and uniquely
-- identifies it. ARNs are unique across all Regions. Format is
-- @arn:aws:gamelift:\<region>::gamesessionqueue\/\<queue name>@. Queues
-- can be located in any Region. Queues are used to start new
-- GameLift-hosted game sessions for matches that are created with this
-- matchmaking configuration. If @FlexMatchMode@ is set to @STANDALONE@, do
-- not set this parameter.
--
-- 'notificationTarget', 'createMatchmakingConfiguration_notificationTarget' - An SNS topic ARN that is set up to receive matchmaking notifications.
-- See
-- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-notification.html Setting up notifications for matchmaking>
-- for more information.
--
-- 'tags', 'createMatchmakingConfiguration_tags' - A list of labels to assign to the new matchmaking configuration
-- resource. Tags are developer-defined key-value pairs. Tagging Amazon Web
-- Services resources are useful for resource management, access management
-- and cost allocation. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
-- in the /Amazon Web Services General Reference/.
--
-- 'name', 'createMatchmakingConfiguration_name' - A unique identifier for the matchmaking configuration. This name is used
-- to identify the configuration associated with a matchmaking request or
-- ticket.
--
-- 'requestTimeoutSeconds', 'createMatchmakingConfiguration_requestTimeoutSeconds' - The maximum duration, in seconds, that a matchmaking ticket can remain
-- in process before timing out. Requests that fail due to timing out can
-- be resubmitted as needed.
--
-- 'acceptanceRequired', 'createMatchmakingConfiguration_acceptanceRequired' - A flag that determines whether a match that was created with this
-- configuration must be accepted by the matched players. To require
-- acceptance, set to @TRUE@. With this option enabled, matchmaking tickets
-- use the status @REQUIRES_ACCEPTANCE@ to indicate when a completed
-- potential match is waiting for player acceptance.
--
-- 'ruleSetName', 'createMatchmakingConfiguration_ruleSetName' - A unique identifier for the matchmaking rule set to use with this
-- configuration. You can use either the rule set name or ARN value. A
-- matchmaking configuration can only use rule sets that are defined in the
-- same Region.
newCreateMatchmakingConfiguration ::
  -- | 'name'
  Prelude.Text ->
  -- | 'requestTimeoutSeconds'
  Prelude.Natural ->
  -- | 'acceptanceRequired'
  Prelude.Bool ->
  -- | 'ruleSetName'
  Prelude.Text ->
  CreateMatchmakingConfiguration
newCreateMatchmakingConfiguration :: Text -> Natural -> Bool -> Text -> CreateMatchmakingConfiguration
newCreateMatchmakingConfiguration
  Text
pName_
  Natural
pRequestTimeoutSeconds_
  Bool
pAcceptanceRequired_
  Text
pRuleSetName_ =
    CreateMatchmakingConfiguration'
      { $sel:acceptanceTimeoutSeconds:CreateMatchmakingConfiguration' :: Maybe Natural
acceptanceTimeoutSeconds =
          forall a. Maybe a
Prelude.Nothing,
        $sel:additionalPlayerCount:CreateMatchmakingConfiguration' :: Maybe Natural
additionalPlayerCount = forall a. Maybe a
Prelude.Nothing,
        $sel:backfillMode:CreateMatchmakingConfiguration' :: Maybe BackfillMode
backfillMode = forall a. Maybe a
Prelude.Nothing,
        $sel:customEventData:CreateMatchmakingConfiguration' :: Maybe Text
customEventData = forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateMatchmakingConfiguration' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:flexMatchMode:CreateMatchmakingConfiguration' :: Maybe FlexMatchMode
flexMatchMode = forall a. Maybe a
Prelude.Nothing,
        $sel:gameProperties:CreateMatchmakingConfiguration' :: Maybe [GameProperty]
gameProperties = forall a. Maybe a
Prelude.Nothing,
        $sel:gameSessionData:CreateMatchmakingConfiguration' :: Maybe Text
gameSessionData = forall a. Maybe a
Prelude.Nothing,
        $sel:gameSessionQueueArns:CreateMatchmakingConfiguration' :: Maybe [Text]
gameSessionQueueArns = forall a. Maybe a
Prelude.Nothing,
        $sel:notificationTarget:CreateMatchmakingConfiguration' :: Maybe Text
notificationTarget = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateMatchmakingConfiguration' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateMatchmakingConfiguration' :: Text
name = Text
pName_,
        $sel:requestTimeoutSeconds:CreateMatchmakingConfiguration' :: Natural
requestTimeoutSeconds =
          Natural
pRequestTimeoutSeconds_,
        $sel:acceptanceRequired:CreateMatchmakingConfiguration' :: Bool
acceptanceRequired = Bool
pAcceptanceRequired_,
        $sel:ruleSetName:CreateMatchmakingConfiguration' :: Text
ruleSetName = Text
pRuleSetName_
      }

-- | The length of time (in seconds) to wait for players to accept a proposed
-- match, if acceptance is required.
createMatchmakingConfiguration_acceptanceTimeoutSeconds :: Lens.Lens' CreateMatchmakingConfiguration (Prelude.Maybe Prelude.Natural)
createMatchmakingConfiguration_acceptanceTimeoutSeconds :: Lens' CreateMatchmakingConfiguration (Maybe Natural)
createMatchmakingConfiguration_acceptanceTimeoutSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Maybe Natural
acceptanceTimeoutSeconds :: Maybe Natural
$sel:acceptanceTimeoutSeconds:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Natural
acceptanceTimeoutSeconds} -> Maybe Natural
acceptanceTimeoutSeconds) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Maybe Natural
a -> CreateMatchmakingConfiguration
s {$sel:acceptanceTimeoutSeconds:CreateMatchmakingConfiguration' :: Maybe Natural
acceptanceTimeoutSeconds = Maybe Natural
a} :: CreateMatchmakingConfiguration)

-- | The number of player slots in a match to keep open for future players.
-- For example, if the configuration\'s rule set specifies a match for a
-- single 12-person team, and the additional player count is set to 2, only
-- 10 players are selected for the match. This parameter is not used if
-- @FlexMatchMode@ is set to @STANDALONE@.
createMatchmakingConfiguration_additionalPlayerCount :: Lens.Lens' CreateMatchmakingConfiguration (Prelude.Maybe Prelude.Natural)
createMatchmakingConfiguration_additionalPlayerCount :: Lens' CreateMatchmakingConfiguration (Maybe Natural)
createMatchmakingConfiguration_additionalPlayerCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Maybe Natural
additionalPlayerCount :: Maybe Natural
$sel:additionalPlayerCount:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Natural
additionalPlayerCount} -> Maybe Natural
additionalPlayerCount) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Maybe Natural
a -> CreateMatchmakingConfiguration
s {$sel:additionalPlayerCount:CreateMatchmakingConfiguration' :: Maybe Natural
additionalPlayerCount = Maybe Natural
a} :: CreateMatchmakingConfiguration)

-- | The method used to backfill game sessions that are created with this
-- matchmaking configuration. Specify @MANUAL@ when your game manages
-- backfill requests manually or does not use the match backfill feature.
-- Specify @AUTOMATIC@ to have GameLift create a backfill request whenever
-- a game session has one or more open slots. Learn more about manual and
-- automatic backfill in
-- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-backfill.html Backfill Existing Games with FlexMatch>.
-- Automatic backfill is not available when @FlexMatchMode@ is set to
-- @STANDALONE@.
createMatchmakingConfiguration_backfillMode :: Lens.Lens' CreateMatchmakingConfiguration (Prelude.Maybe BackfillMode)
createMatchmakingConfiguration_backfillMode :: Lens' CreateMatchmakingConfiguration (Maybe BackfillMode)
createMatchmakingConfiguration_backfillMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Maybe BackfillMode
backfillMode :: Maybe BackfillMode
$sel:backfillMode:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe BackfillMode
backfillMode} -> Maybe BackfillMode
backfillMode) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Maybe BackfillMode
a -> CreateMatchmakingConfiguration
s {$sel:backfillMode:CreateMatchmakingConfiguration' :: Maybe BackfillMode
backfillMode = Maybe BackfillMode
a} :: CreateMatchmakingConfiguration)

-- | Information to be added to all events related to this matchmaking
-- configuration.
createMatchmakingConfiguration_customEventData :: Lens.Lens' CreateMatchmakingConfiguration (Prelude.Maybe Prelude.Text)
createMatchmakingConfiguration_customEventData :: Lens' CreateMatchmakingConfiguration (Maybe Text)
createMatchmakingConfiguration_customEventData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Maybe Text
customEventData :: Maybe Text
$sel:customEventData:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
customEventData} -> Maybe Text
customEventData) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Maybe Text
a -> CreateMatchmakingConfiguration
s {$sel:customEventData:CreateMatchmakingConfiguration' :: Maybe Text
customEventData = Maybe Text
a} :: CreateMatchmakingConfiguration)

-- | A human-readable description of the matchmaking configuration.
createMatchmakingConfiguration_description :: Lens.Lens' CreateMatchmakingConfiguration (Prelude.Maybe Prelude.Text)
createMatchmakingConfiguration_description :: Lens' CreateMatchmakingConfiguration (Maybe Text)
createMatchmakingConfiguration_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Maybe Text
description :: Maybe Text
$sel:description:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Maybe Text
a -> CreateMatchmakingConfiguration
s {$sel:description:CreateMatchmakingConfiguration' :: Maybe Text
description = Maybe Text
a} :: CreateMatchmakingConfiguration)

-- | Indicates whether this matchmaking configuration is being used with
-- GameLift hosting or as a standalone matchmaking solution.
--
-- -   __STANDALONE__ - FlexMatch forms matches and returns match
--     information, including players and team assignments, in a
--     <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-events.html#match-events-matchmakingsucceeded MatchmakingSucceeded>
--     event.
--
-- -   __WITH_QUEUE__ - FlexMatch forms matches and uses the specified
--     GameLift queue to start a game session for the match.
createMatchmakingConfiguration_flexMatchMode :: Lens.Lens' CreateMatchmakingConfiguration (Prelude.Maybe FlexMatchMode)
createMatchmakingConfiguration_flexMatchMode :: Lens' CreateMatchmakingConfiguration (Maybe FlexMatchMode)
createMatchmakingConfiguration_flexMatchMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Maybe FlexMatchMode
flexMatchMode :: Maybe FlexMatchMode
$sel:flexMatchMode:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe FlexMatchMode
flexMatchMode} -> Maybe FlexMatchMode
flexMatchMode) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Maybe FlexMatchMode
a -> CreateMatchmakingConfiguration
s {$sel:flexMatchMode:CreateMatchmakingConfiguration' :: Maybe FlexMatchMode
flexMatchMode = Maybe FlexMatchMode
a} :: CreateMatchmakingConfiguration)

-- | A set of custom properties for a game session, formatted as key:value
-- pairs. These properties are passed to a game server process with a
-- request to start a new game session (see
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/gamelift-sdk-server-api.html#gamelift-sdk-server-startsession Start a Game Session>).
-- This information is added to the new @GameSession@ object that is
-- created for a successful match. This parameter is not used if
-- @FlexMatchMode@ is set to @STANDALONE@.
createMatchmakingConfiguration_gameProperties :: Lens.Lens' CreateMatchmakingConfiguration (Prelude.Maybe [GameProperty])
createMatchmakingConfiguration_gameProperties :: Lens' CreateMatchmakingConfiguration (Maybe [GameProperty])
createMatchmakingConfiguration_gameProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Maybe [GameProperty]
gameProperties :: Maybe [GameProperty]
$sel:gameProperties:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe [GameProperty]
gameProperties} -> Maybe [GameProperty]
gameProperties) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Maybe [GameProperty]
a -> CreateMatchmakingConfiguration
s {$sel:gameProperties:CreateMatchmakingConfiguration' :: Maybe [GameProperty]
gameProperties = Maybe [GameProperty]
a} :: CreateMatchmakingConfiguration) 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 set of custom game session properties, formatted as a single string
-- value. This data is passed to a game server process with a request to
-- start a new game session (see
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/gamelift-sdk-server-api.html#gamelift-sdk-server-startsession Start a Game Session>).
-- This information is added to the new @GameSession@ object that is
-- created for a successful match. This parameter is not used if
-- @FlexMatchMode@ is set to @STANDALONE@.
createMatchmakingConfiguration_gameSessionData :: Lens.Lens' CreateMatchmakingConfiguration (Prelude.Maybe Prelude.Text)
createMatchmakingConfiguration_gameSessionData :: Lens' CreateMatchmakingConfiguration (Maybe Text)
createMatchmakingConfiguration_gameSessionData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Maybe Text
gameSessionData :: Maybe Text
$sel:gameSessionData:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
gameSessionData} -> Maybe Text
gameSessionData) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Maybe Text
a -> CreateMatchmakingConfiguration
s {$sel:gameSessionData:CreateMatchmakingConfiguration' :: Maybe Text
gameSessionData = Maybe Text
a} :: CreateMatchmakingConfiguration)

-- | The Amazon Resource Name
-- (<https://docs.aws.amazon.com/AmazonS3/latest/dev/s3-arn-format.html ARN>)
-- that is assigned to a GameLift game session queue resource and uniquely
-- identifies it. ARNs are unique across all Regions. Format is
-- @arn:aws:gamelift:\<region>::gamesessionqueue\/\<queue name>@. Queues
-- can be located in any Region. Queues are used to start new
-- GameLift-hosted game sessions for matches that are created with this
-- matchmaking configuration. If @FlexMatchMode@ is set to @STANDALONE@, do
-- not set this parameter.
createMatchmakingConfiguration_gameSessionQueueArns :: Lens.Lens' CreateMatchmakingConfiguration (Prelude.Maybe [Prelude.Text])
createMatchmakingConfiguration_gameSessionQueueArns :: Lens' CreateMatchmakingConfiguration (Maybe [Text])
createMatchmakingConfiguration_gameSessionQueueArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Maybe [Text]
gameSessionQueueArns :: Maybe [Text]
$sel:gameSessionQueueArns:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe [Text]
gameSessionQueueArns} -> Maybe [Text]
gameSessionQueueArns) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Maybe [Text]
a -> CreateMatchmakingConfiguration
s {$sel:gameSessionQueueArns:CreateMatchmakingConfiguration' :: Maybe [Text]
gameSessionQueueArns = Maybe [Text]
a} :: CreateMatchmakingConfiguration) 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

-- | An SNS topic ARN that is set up to receive matchmaking notifications.
-- See
-- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-notification.html Setting up notifications for matchmaking>
-- for more information.
createMatchmakingConfiguration_notificationTarget :: Lens.Lens' CreateMatchmakingConfiguration (Prelude.Maybe Prelude.Text)
createMatchmakingConfiguration_notificationTarget :: Lens' CreateMatchmakingConfiguration (Maybe Text)
createMatchmakingConfiguration_notificationTarget = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Maybe Text
notificationTarget :: Maybe Text
$sel:notificationTarget:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
notificationTarget} -> Maybe Text
notificationTarget) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Maybe Text
a -> CreateMatchmakingConfiguration
s {$sel:notificationTarget:CreateMatchmakingConfiguration' :: Maybe Text
notificationTarget = Maybe Text
a} :: CreateMatchmakingConfiguration)

-- | A list of labels to assign to the new matchmaking configuration
-- resource. Tags are developer-defined key-value pairs. Tagging Amazon Web
-- Services resources are useful for resource management, access management
-- and cost allocation. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
-- in the /Amazon Web Services General Reference/.
createMatchmakingConfiguration_tags :: Lens.Lens' CreateMatchmakingConfiguration (Prelude.Maybe [Tag])
createMatchmakingConfiguration_tags :: Lens' CreateMatchmakingConfiguration (Maybe [Tag])
createMatchmakingConfiguration_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Maybe [Tag]
a -> CreateMatchmakingConfiguration
s {$sel:tags:CreateMatchmakingConfiguration' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateMatchmakingConfiguration) 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 matchmaking configuration. This name is used
-- to identify the configuration associated with a matchmaking request or
-- ticket.
createMatchmakingConfiguration_name :: Lens.Lens' CreateMatchmakingConfiguration Prelude.Text
createMatchmakingConfiguration_name :: Lens' CreateMatchmakingConfiguration Text
createMatchmakingConfiguration_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Text
name :: Text
$sel:name:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Text
name} -> Text
name) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Text
a -> CreateMatchmakingConfiguration
s {$sel:name:CreateMatchmakingConfiguration' :: Text
name = Text
a} :: CreateMatchmakingConfiguration)

-- | The maximum duration, in seconds, that a matchmaking ticket can remain
-- in process before timing out. Requests that fail due to timing out can
-- be resubmitted as needed.
createMatchmakingConfiguration_requestTimeoutSeconds :: Lens.Lens' CreateMatchmakingConfiguration Prelude.Natural
createMatchmakingConfiguration_requestTimeoutSeconds :: Lens' CreateMatchmakingConfiguration Natural
createMatchmakingConfiguration_requestTimeoutSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Natural
requestTimeoutSeconds :: Natural
$sel:requestTimeoutSeconds:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Natural
requestTimeoutSeconds} -> Natural
requestTimeoutSeconds) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Natural
a -> CreateMatchmakingConfiguration
s {$sel:requestTimeoutSeconds:CreateMatchmakingConfiguration' :: Natural
requestTimeoutSeconds = Natural
a} :: CreateMatchmakingConfiguration)

-- | A flag that determines whether a match that was created with this
-- configuration must be accepted by the matched players. To require
-- acceptance, set to @TRUE@. With this option enabled, matchmaking tickets
-- use the status @REQUIRES_ACCEPTANCE@ to indicate when a completed
-- potential match is waiting for player acceptance.
createMatchmakingConfiguration_acceptanceRequired :: Lens.Lens' CreateMatchmakingConfiguration Prelude.Bool
createMatchmakingConfiguration_acceptanceRequired :: Lens' CreateMatchmakingConfiguration Bool
createMatchmakingConfiguration_acceptanceRequired = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Bool
acceptanceRequired :: Bool
$sel:acceptanceRequired:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Bool
acceptanceRequired} -> Bool
acceptanceRequired) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Bool
a -> CreateMatchmakingConfiguration
s {$sel:acceptanceRequired:CreateMatchmakingConfiguration' :: Bool
acceptanceRequired = Bool
a} :: CreateMatchmakingConfiguration)

-- | A unique identifier for the matchmaking rule set to use with this
-- configuration. You can use either the rule set name or ARN value. A
-- matchmaking configuration can only use rule sets that are defined in the
-- same Region.
createMatchmakingConfiguration_ruleSetName :: Lens.Lens' CreateMatchmakingConfiguration Prelude.Text
createMatchmakingConfiguration_ruleSetName :: Lens' CreateMatchmakingConfiguration Text
createMatchmakingConfiguration_ruleSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfiguration' {Text
ruleSetName :: Text
$sel:ruleSetName:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Text
ruleSetName} -> Text
ruleSetName) (\s :: CreateMatchmakingConfiguration
s@CreateMatchmakingConfiguration' {} Text
a -> CreateMatchmakingConfiguration
s {$sel:ruleSetName:CreateMatchmakingConfiguration' :: Text
ruleSetName = Text
a} :: CreateMatchmakingConfiguration)

instance
  Core.AWSRequest
    CreateMatchmakingConfiguration
  where
  type
    AWSResponse CreateMatchmakingConfiguration =
      CreateMatchmakingConfigurationResponse
  request :: (Service -> Service)
-> CreateMatchmakingConfiguration
-> Request CreateMatchmakingConfiguration
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 CreateMatchmakingConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateMatchmakingConfiguration)))
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 MatchmakingConfiguration
-> Int -> CreateMatchmakingConfigurationResponse
CreateMatchmakingConfigurationResponse'
            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
"Configuration")
            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
    CreateMatchmakingConfiguration
  where
  hashWithSalt :: Int -> CreateMatchmakingConfiguration -> Int
hashWithSalt
    Int
_salt
    CreateMatchmakingConfiguration' {Bool
Natural
Maybe Natural
Maybe [Text]
Maybe [GameProperty]
Maybe [Tag]
Maybe Text
Maybe BackfillMode
Maybe FlexMatchMode
Text
ruleSetName :: Text
acceptanceRequired :: Bool
requestTimeoutSeconds :: Natural
name :: Text
tags :: Maybe [Tag]
notificationTarget :: Maybe Text
gameSessionQueueArns :: Maybe [Text]
gameSessionData :: Maybe Text
gameProperties :: Maybe [GameProperty]
flexMatchMode :: Maybe FlexMatchMode
description :: Maybe Text
customEventData :: Maybe Text
backfillMode :: Maybe BackfillMode
additionalPlayerCount :: Maybe Natural
acceptanceTimeoutSeconds :: Maybe Natural
$sel:ruleSetName:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Text
$sel:acceptanceRequired:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Bool
$sel:requestTimeoutSeconds:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Natural
$sel:name:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Text
$sel:tags:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe [Tag]
$sel:notificationTarget:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
$sel:gameSessionQueueArns:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe [Text]
$sel:gameSessionData:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
$sel:gameProperties:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe [GameProperty]
$sel:flexMatchMode:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe FlexMatchMode
$sel:description:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
$sel:customEventData:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
$sel:backfillMode:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe BackfillMode
$sel:additionalPlayerCount:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Natural
$sel:acceptanceTimeoutSeconds:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Natural
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
acceptanceTimeoutSeconds
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
additionalPlayerCount
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BackfillMode
backfillMode
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customEventData
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FlexMatchMode
flexMatchMode
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [GameProperty]
gameProperties
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
gameSessionData
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
gameSessionQueueArns
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
notificationTarget
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
requestTimeoutSeconds
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
acceptanceRequired
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ruleSetName

instance
  Prelude.NFData
    CreateMatchmakingConfiguration
  where
  rnf :: CreateMatchmakingConfiguration -> ()
rnf CreateMatchmakingConfiguration' {Bool
Natural
Maybe Natural
Maybe [Text]
Maybe [GameProperty]
Maybe [Tag]
Maybe Text
Maybe BackfillMode
Maybe FlexMatchMode
Text
ruleSetName :: Text
acceptanceRequired :: Bool
requestTimeoutSeconds :: Natural
name :: Text
tags :: Maybe [Tag]
notificationTarget :: Maybe Text
gameSessionQueueArns :: Maybe [Text]
gameSessionData :: Maybe Text
gameProperties :: Maybe [GameProperty]
flexMatchMode :: Maybe FlexMatchMode
description :: Maybe Text
customEventData :: Maybe Text
backfillMode :: Maybe BackfillMode
additionalPlayerCount :: Maybe Natural
acceptanceTimeoutSeconds :: Maybe Natural
$sel:ruleSetName:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Text
$sel:acceptanceRequired:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Bool
$sel:requestTimeoutSeconds:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Natural
$sel:name:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Text
$sel:tags:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe [Tag]
$sel:notificationTarget:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
$sel:gameSessionQueueArns:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe [Text]
$sel:gameSessionData:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
$sel:gameProperties:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe [GameProperty]
$sel:flexMatchMode:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe FlexMatchMode
$sel:description:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
$sel:customEventData:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
$sel:backfillMode:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe BackfillMode
$sel:additionalPlayerCount:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Natural
$sel:acceptanceTimeoutSeconds:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
acceptanceTimeoutSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
additionalPlayerCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BackfillMode
backfillMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
customEventData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FlexMatchMode
flexMatchMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [GameProperty]
gameProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
gameSessionData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
gameSessionQueueArns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
notificationTarget
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
requestTimeoutSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
acceptanceRequired
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ruleSetName

instance
  Data.ToHeaders
    CreateMatchmakingConfiguration
  where
  toHeaders :: CreateMatchmakingConfiguration -> 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.CreateMatchmakingConfiguration" ::
                          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 CreateMatchmakingConfiguration where
  toJSON :: CreateMatchmakingConfiguration -> Value
toJSON CreateMatchmakingConfiguration' {Bool
Natural
Maybe Natural
Maybe [Text]
Maybe [GameProperty]
Maybe [Tag]
Maybe Text
Maybe BackfillMode
Maybe FlexMatchMode
Text
ruleSetName :: Text
acceptanceRequired :: Bool
requestTimeoutSeconds :: Natural
name :: Text
tags :: Maybe [Tag]
notificationTarget :: Maybe Text
gameSessionQueueArns :: Maybe [Text]
gameSessionData :: Maybe Text
gameProperties :: Maybe [GameProperty]
flexMatchMode :: Maybe FlexMatchMode
description :: Maybe Text
customEventData :: Maybe Text
backfillMode :: Maybe BackfillMode
additionalPlayerCount :: Maybe Natural
acceptanceTimeoutSeconds :: Maybe Natural
$sel:ruleSetName:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Text
$sel:acceptanceRequired:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Bool
$sel:requestTimeoutSeconds:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Natural
$sel:name:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Text
$sel:tags:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe [Tag]
$sel:notificationTarget:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
$sel:gameSessionQueueArns:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe [Text]
$sel:gameSessionData:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
$sel:gameProperties:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe [GameProperty]
$sel:flexMatchMode:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe FlexMatchMode
$sel:description:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
$sel:customEventData:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Text
$sel:backfillMode:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe BackfillMode
$sel:additionalPlayerCount:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Natural
$sel:acceptanceTimeoutSeconds:CreateMatchmakingConfiguration' :: CreateMatchmakingConfiguration -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AcceptanceTimeoutSeconds" 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 Natural
acceptanceTimeoutSeconds,
            (Key
"AdditionalPlayerCount" 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 Natural
additionalPlayerCount,
            (Key
"BackfillMode" 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 BackfillMode
backfillMode,
            (Key
"CustomEventData" 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
customEventData,
            (Key
"Description" 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
description,
            (Key
"FlexMatchMode" 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 FlexMatchMode
flexMatchMode,
            (Key
"GameProperties" 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 [GameProperty]
gameProperties,
            (Key
"GameSessionData" 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
gameSessionData,
            (Key
"GameSessionQueueArns" 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]
gameSessionQueueArns,
            (Key
"NotificationTarget" 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
notificationTarget,
            (Key
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"RequestTimeoutSeconds"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
requestTimeoutSeconds
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AcceptanceRequired" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
acceptanceRequired),
            forall a. a -> Maybe a
Prelude.Just (Key
"RuleSetName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
ruleSetName)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateMatchmakingConfigurationResponse' 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:
--
-- 'configuration', 'createMatchmakingConfigurationResponse_configuration' - Object that describes the newly created matchmaking configuration.
--
-- 'httpStatus', 'createMatchmakingConfigurationResponse_httpStatus' - The response's http status code.
newCreateMatchmakingConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateMatchmakingConfigurationResponse
newCreateMatchmakingConfigurationResponse :: Int -> CreateMatchmakingConfigurationResponse
newCreateMatchmakingConfigurationResponse
  Int
pHttpStatus_ =
    CreateMatchmakingConfigurationResponse'
      { $sel:configuration:CreateMatchmakingConfigurationResponse' :: Maybe MatchmakingConfiguration
configuration =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateMatchmakingConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Object that describes the newly created matchmaking configuration.
createMatchmakingConfigurationResponse_configuration :: Lens.Lens' CreateMatchmakingConfigurationResponse (Prelude.Maybe MatchmakingConfiguration)
createMatchmakingConfigurationResponse_configuration :: Lens'
  CreateMatchmakingConfigurationResponse
  (Maybe MatchmakingConfiguration)
createMatchmakingConfigurationResponse_configuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMatchmakingConfigurationResponse' {Maybe MatchmakingConfiguration
configuration :: Maybe MatchmakingConfiguration
$sel:configuration:CreateMatchmakingConfigurationResponse' :: CreateMatchmakingConfigurationResponse
-> Maybe MatchmakingConfiguration
configuration} -> Maybe MatchmakingConfiguration
configuration) (\s :: CreateMatchmakingConfigurationResponse
s@CreateMatchmakingConfigurationResponse' {} Maybe MatchmakingConfiguration
a -> CreateMatchmakingConfigurationResponse
s {$sel:configuration:CreateMatchmakingConfigurationResponse' :: Maybe MatchmakingConfiguration
configuration = Maybe MatchmakingConfiguration
a} :: CreateMatchmakingConfigurationResponse)

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

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