{-# 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.StopMatchmaking
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Cancels a matchmaking ticket or match backfill ticket that is currently
-- being processed. To stop the matchmaking operation, specify the ticket
-- ID. If successful, work on the ticket is stopped, and the ticket status
-- is changed to @CANCELLED@.
--
-- This call is also used to turn off automatic backfill for an individual
-- game session. This is for game sessions that are created with a
-- matchmaking configuration that has automatic backfill enabled. The
-- ticket ID is included in the @MatchmakerData@ of an updated game session
-- object, which is provided to the game server.
--
-- If the operation is successful, the service sends back an empty JSON
-- struct with the HTTP 200 response (not an empty HTTP body).
--
-- __Learn more__
--
-- <https://docs.aws.amazon.com/gamelift/latest/flexmatchguide/match-client.html Add FlexMatch to a game client>
module Amazonka.GameLift.StopMatchmaking
  ( -- * Creating a Request
    StopMatchmaking (..),
    newStopMatchmaking,

    -- * Request Lenses
    stopMatchmaking_ticketId,

    -- * Destructuring the Response
    StopMatchmakingResponse (..),
    newStopMatchmakingResponse,

    -- * Response Lenses
    stopMatchmakingResponse_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:/ 'newStopMatchmaking' smart constructor.
data StopMatchmaking = StopMatchmaking'
  { -- | A unique identifier for a matchmaking ticket.
    StopMatchmaking -> Text
ticketId :: Prelude.Text
  }
  deriving (StopMatchmaking -> StopMatchmaking -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopMatchmaking -> StopMatchmaking -> Bool
$c/= :: StopMatchmaking -> StopMatchmaking -> Bool
== :: StopMatchmaking -> StopMatchmaking -> Bool
$c== :: StopMatchmaking -> StopMatchmaking -> Bool
Prelude.Eq, ReadPrec [StopMatchmaking]
ReadPrec StopMatchmaking
Int -> ReadS StopMatchmaking
ReadS [StopMatchmaking]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopMatchmaking]
$creadListPrec :: ReadPrec [StopMatchmaking]
readPrec :: ReadPrec StopMatchmaking
$creadPrec :: ReadPrec StopMatchmaking
readList :: ReadS [StopMatchmaking]
$creadList :: ReadS [StopMatchmaking]
readsPrec :: Int -> ReadS StopMatchmaking
$creadsPrec :: Int -> ReadS StopMatchmaking
Prelude.Read, Int -> StopMatchmaking -> ShowS
[StopMatchmaking] -> ShowS
StopMatchmaking -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopMatchmaking] -> ShowS
$cshowList :: [StopMatchmaking] -> ShowS
show :: StopMatchmaking -> String
$cshow :: StopMatchmaking -> String
showsPrec :: Int -> StopMatchmaking -> ShowS
$cshowsPrec :: Int -> StopMatchmaking -> ShowS
Prelude.Show, forall x. Rep StopMatchmaking x -> StopMatchmaking
forall x. StopMatchmaking -> Rep StopMatchmaking x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopMatchmaking x -> StopMatchmaking
$cfrom :: forall x. StopMatchmaking -> Rep StopMatchmaking x
Prelude.Generic)

-- |
-- Create a value of 'StopMatchmaking' 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', 'stopMatchmaking_ticketId' - A unique identifier for a matchmaking ticket.
newStopMatchmaking ::
  -- | 'ticketId'
  Prelude.Text ->
  StopMatchmaking
newStopMatchmaking :: Text -> StopMatchmaking
newStopMatchmaking Text
pTicketId_ =
  StopMatchmaking' {$sel:ticketId:StopMatchmaking' :: Text
ticketId = Text
pTicketId_}

-- | A unique identifier for a matchmaking ticket.
stopMatchmaking_ticketId :: Lens.Lens' StopMatchmaking Prelude.Text
stopMatchmaking_ticketId :: Lens' StopMatchmaking Text
stopMatchmaking_ticketId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopMatchmaking' {Text
ticketId :: Text
$sel:ticketId:StopMatchmaking' :: StopMatchmaking -> Text
ticketId} -> Text
ticketId) (\s :: StopMatchmaking
s@StopMatchmaking' {} Text
a -> StopMatchmaking
s {$sel:ticketId:StopMatchmaking' :: Text
ticketId = Text
a} :: StopMatchmaking)

instance Core.AWSRequest StopMatchmaking where
  type
    AWSResponse StopMatchmaking =
      StopMatchmakingResponse
  request :: (Service -> Service) -> StopMatchmaking -> Request StopMatchmaking
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 StopMatchmaking
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StopMatchmaking)))
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 -> StopMatchmakingResponse
StopMatchmakingResponse'
            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 StopMatchmaking where
  hashWithSalt :: Int -> StopMatchmaking -> Int
hashWithSalt Int
_salt StopMatchmaking' {Text
ticketId :: Text
$sel:ticketId:StopMatchmaking' :: StopMatchmaking -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ticketId

instance Prelude.NFData StopMatchmaking where
  rnf :: StopMatchmaking -> ()
rnf StopMatchmaking' {Text
ticketId :: Text
$sel:ticketId:StopMatchmaking' :: StopMatchmaking -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
ticketId

instance Data.ToHeaders StopMatchmaking where
  toHeaders :: StopMatchmaking -> 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.StopMatchmaking" :: 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 StopMatchmaking where
  toJSON :: StopMatchmaking -> Value
toJSON StopMatchmaking' {Text
ticketId :: Text
$sel:ticketId:StopMatchmaking' :: StopMatchmaking -> 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)]
      )

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

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

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

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

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

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