{-# 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.AcceptMatch
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Registers a player\'s acceptance or rejection of a proposed FlexMatch
-- match. A matchmaking configuration may require player acceptance; if so,
-- then matches built with that configuration cannot be completed unless
-- all players accept the proposed match within a specified time limit.
--
-- When FlexMatch builds a match, all the matchmaking tickets involved in
-- the proposed match are placed into status @REQUIRES_ACCEPTANCE@. This is
-- a trigger for your game to get acceptance from all players in the
-- ticket. Acceptances are only valid for tickets when they are in this
-- status; all other acceptances result in an error.
--
-- To register acceptance, specify the ticket ID, a response, and one or
-- more players. Once all players have registered acceptance, the
-- matchmaking tickets advance to status @PLACING@, where a new game
-- session is created for the match.
--
-- If any player rejects the match, or if acceptances are not received
-- before a specified timeout, the proposed match is dropped. The
-- matchmaking tickets are then handled in one of two ways: For tickets
-- where one or more players rejected the match or failed to respond, the
-- ticket status is set to @CANCELLED@, and processing is terminated. For
-- tickets where players have accepted or not yet responded, the ticket
-- status is returned to @SEARCHING@ to find a new match. A new matchmaking
-- request for these players can be submitted as needed.
--
-- __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-events.html FlexMatch events>
-- (reference)
module Amazonka.GameLift.AcceptMatch
  ( -- * Creating a Request
    AcceptMatch (..),
    newAcceptMatch,

    -- * Request Lenses
    acceptMatch_ticketId,
    acceptMatch_playerIds,
    acceptMatch_acceptanceType,

    -- * Destructuring the Response
    AcceptMatchResponse (..),
    newAcceptMatchResponse,

    -- * Response Lenses
    acceptMatchResponse_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:/ 'newAcceptMatch' smart constructor.
data AcceptMatch = AcceptMatch'
  { -- | A unique identifier for a matchmaking ticket. The ticket must be in
    -- status @REQUIRES_ACCEPTANCE@; otherwise this request will fail.
    AcceptMatch -> Text
ticketId :: Prelude.Text,
    -- | A unique identifier for a player delivering the response. This parameter
    -- can include one or multiple player IDs.
    AcceptMatch -> [Text]
playerIds :: [Prelude.Text],
    -- | Player response to the proposed match.
    AcceptMatch -> AcceptanceType
acceptanceType :: AcceptanceType
  }
  deriving (AcceptMatch -> AcceptMatch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AcceptMatch -> AcceptMatch -> Bool
$c/= :: AcceptMatch -> AcceptMatch -> Bool
== :: AcceptMatch -> AcceptMatch -> Bool
$c== :: AcceptMatch -> AcceptMatch -> Bool
Prelude.Eq, ReadPrec [AcceptMatch]
ReadPrec AcceptMatch
Int -> ReadS AcceptMatch
ReadS [AcceptMatch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AcceptMatch]
$creadListPrec :: ReadPrec [AcceptMatch]
readPrec :: ReadPrec AcceptMatch
$creadPrec :: ReadPrec AcceptMatch
readList :: ReadS [AcceptMatch]
$creadList :: ReadS [AcceptMatch]
readsPrec :: Int -> ReadS AcceptMatch
$creadsPrec :: Int -> ReadS AcceptMatch
Prelude.Read, Int -> AcceptMatch -> ShowS
[AcceptMatch] -> ShowS
AcceptMatch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AcceptMatch] -> ShowS
$cshowList :: [AcceptMatch] -> ShowS
show :: AcceptMatch -> String
$cshow :: AcceptMatch -> String
showsPrec :: Int -> AcceptMatch -> ShowS
$cshowsPrec :: Int -> AcceptMatch -> ShowS
Prelude.Show, forall x. Rep AcceptMatch x -> AcceptMatch
forall x. AcceptMatch -> Rep AcceptMatch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AcceptMatch x -> AcceptMatch
$cfrom :: forall x. AcceptMatch -> Rep AcceptMatch x
Prelude.Generic)

-- |
-- Create a value of 'AcceptMatch' 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', 'acceptMatch_ticketId' - A unique identifier for a matchmaking ticket. The ticket must be in
-- status @REQUIRES_ACCEPTANCE@; otherwise this request will fail.
--
-- 'playerIds', 'acceptMatch_playerIds' - A unique identifier for a player delivering the response. This parameter
-- can include one or multiple player IDs.
--
-- 'acceptanceType', 'acceptMatch_acceptanceType' - Player response to the proposed match.
newAcceptMatch ::
  -- | 'ticketId'
  Prelude.Text ->
  -- | 'acceptanceType'
  AcceptanceType ->
  AcceptMatch
newAcceptMatch :: Text -> AcceptanceType -> AcceptMatch
newAcceptMatch Text
pTicketId_ AcceptanceType
pAcceptanceType_ =
  AcceptMatch'
    { $sel:ticketId:AcceptMatch' :: Text
ticketId = Text
pTicketId_,
      $sel:playerIds:AcceptMatch' :: [Text]
playerIds = forall a. Monoid a => a
Prelude.mempty,
      $sel:acceptanceType:AcceptMatch' :: AcceptanceType
acceptanceType = AcceptanceType
pAcceptanceType_
    }

-- | A unique identifier for a matchmaking ticket. The ticket must be in
-- status @REQUIRES_ACCEPTANCE@; otherwise this request will fail.
acceptMatch_ticketId :: Lens.Lens' AcceptMatch Prelude.Text
acceptMatch_ticketId :: Lens' AcceptMatch Text
acceptMatch_ticketId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptMatch' {Text
ticketId :: Text
$sel:ticketId:AcceptMatch' :: AcceptMatch -> Text
ticketId} -> Text
ticketId) (\s :: AcceptMatch
s@AcceptMatch' {} Text
a -> AcceptMatch
s {$sel:ticketId:AcceptMatch' :: Text
ticketId = Text
a} :: AcceptMatch)

-- | A unique identifier for a player delivering the response. This parameter
-- can include one or multiple player IDs.
acceptMatch_playerIds :: Lens.Lens' AcceptMatch [Prelude.Text]
acceptMatch_playerIds :: Lens' AcceptMatch [Text]
acceptMatch_playerIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptMatch' {[Text]
playerIds :: [Text]
$sel:playerIds:AcceptMatch' :: AcceptMatch -> [Text]
playerIds} -> [Text]
playerIds) (\s :: AcceptMatch
s@AcceptMatch' {} [Text]
a -> AcceptMatch
s {$sel:playerIds:AcceptMatch' :: [Text]
playerIds = [Text]
a} :: AcceptMatch) 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

-- | Player response to the proposed match.
acceptMatch_acceptanceType :: Lens.Lens' AcceptMatch AcceptanceType
acceptMatch_acceptanceType :: Lens' AcceptMatch AcceptanceType
acceptMatch_acceptanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AcceptMatch' {AcceptanceType
acceptanceType :: AcceptanceType
$sel:acceptanceType:AcceptMatch' :: AcceptMatch -> AcceptanceType
acceptanceType} -> AcceptanceType
acceptanceType) (\s :: AcceptMatch
s@AcceptMatch' {} AcceptanceType
a -> AcceptMatch
s {$sel:acceptanceType:AcceptMatch' :: AcceptanceType
acceptanceType = AcceptanceType
a} :: AcceptMatch)

instance Core.AWSRequest AcceptMatch where
  type AWSResponse AcceptMatch = AcceptMatchResponse
  request :: (Service -> Service) -> AcceptMatch -> Request AcceptMatch
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 AcceptMatch
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AcceptMatch)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AcceptMatchResponse
AcceptMatchResponse'
            forall (f :: * -> *) a b. Functor 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 AcceptMatch where
  hashWithSalt :: Int -> AcceptMatch -> Int
hashWithSalt Int
_salt AcceptMatch' {[Text]
Text
AcceptanceType
acceptanceType :: AcceptanceType
playerIds :: [Text]
ticketId :: Text
$sel:acceptanceType:AcceptMatch' :: AcceptMatch -> AcceptanceType
$sel:playerIds:AcceptMatch' :: AcceptMatch -> [Text]
$sel:ticketId:AcceptMatch' :: AcceptMatch -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ticketId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
playerIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AcceptanceType
acceptanceType

instance Prelude.NFData AcceptMatch where
  rnf :: AcceptMatch -> ()
rnf AcceptMatch' {[Text]
Text
AcceptanceType
acceptanceType :: AcceptanceType
playerIds :: [Text]
ticketId :: Text
$sel:acceptanceType:AcceptMatch' :: AcceptMatch -> AcceptanceType
$sel:playerIds:AcceptMatch' :: AcceptMatch -> [Text]
$sel:ticketId:AcceptMatch' :: AcceptMatch -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
ticketId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
playerIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AcceptanceType
acceptanceType

instance Data.ToHeaders AcceptMatch where
  toHeaders :: AcceptMatch -> 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.AcceptMatch" :: 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 AcceptMatch where
  toJSON :: AcceptMatch -> Value
toJSON AcceptMatch' {[Text]
Text
AcceptanceType
acceptanceType :: AcceptanceType
playerIds :: [Text]
ticketId :: Text
$sel:acceptanceType:AcceptMatch' :: AcceptMatch -> AcceptanceType
$sel:playerIds:AcceptMatch' :: AcceptMatch -> [Text]
$sel:ticketId:AcceptMatch' :: AcceptMatch -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"TicketId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
ticketId),
            forall a. a -> Maybe a
Prelude.Just (Key
"PlayerIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
playerIds),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AcceptanceType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AcceptanceType
acceptanceType)
          ]
      )

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

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

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

-- |
-- Create a value of 'AcceptMatchResponse' 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:
--
-- 'httpStatus', 'acceptMatchResponse_httpStatus' - The response's http status code.
newAcceptMatchResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AcceptMatchResponse
newAcceptMatchResponse :: Int -> AcceptMatchResponse
newAcceptMatchResponse Int
pHttpStatus_ =
  AcceptMatchResponse' {$sel:httpStatus:AcceptMatchResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData AcceptMatchResponse where
  rnf :: AcceptMatchResponse -> ()
rnf AcceptMatchResponse' {Int
httpStatus :: Int
$sel:httpStatus:AcceptMatchResponse' :: AcceptMatchResponse -> Int
..} = forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus