{-# 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.DescribeGameSessionPlacement
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves information, including current status, about a game session
-- placement request.
--
-- To get game session placement details, specify the placement ID.
--
-- This operation is not designed to be continually called to track game
-- session status. This practice can cause you to exceed your API limit,
-- which results in errors. Instead, you must configure configure an Amazon
-- Simple Notification Service (SNS) topic to receive notifications from
-- FlexMatch or queues. Continuously polling with
-- @DescribeGameSessionPlacement@ should only be used for games in
-- development with low game session usage.
module Amazonka.GameLift.DescribeGameSessionPlacement
  ( -- * Creating a Request
    DescribeGameSessionPlacement (..),
    newDescribeGameSessionPlacement,

    -- * Request Lenses
    describeGameSessionPlacement_placementId,

    -- * Destructuring the Response
    DescribeGameSessionPlacementResponse (..),
    newDescribeGameSessionPlacementResponse,

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

-- |
-- Create a value of 'DescribeGameSessionPlacement' 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:
--
-- 'placementId', 'describeGameSessionPlacement_placementId' - A unique identifier for a game session placement to retrieve.
newDescribeGameSessionPlacement ::
  -- | 'placementId'
  Prelude.Text ->
  DescribeGameSessionPlacement
newDescribeGameSessionPlacement :: Text -> DescribeGameSessionPlacement
newDescribeGameSessionPlacement Text
pPlacementId_ =
  DescribeGameSessionPlacement'
    { $sel:placementId:DescribeGameSessionPlacement' :: Text
placementId =
        Text
pPlacementId_
    }

-- | A unique identifier for a game session placement to retrieve.
describeGameSessionPlacement_placementId :: Lens.Lens' DescribeGameSessionPlacement Prelude.Text
describeGameSessionPlacement_placementId :: Lens' DescribeGameSessionPlacement Text
describeGameSessionPlacement_placementId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGameSessionPlacement' {Text
placementId :: Text
$sel:placementId:DescribeGameSessionPlacement' :: DescribeGameSessionPlacement -> Text
placementId} -> Text
placementId) (\s :: DescribeGameSessionPlacement
s@DescribeGameSessionPlacement' {} Text
a -> DescribeGameSessionPlacement
s {$sel:placementId:DescribeGameSessionPlacement' :: Text
placementId = Text
a} :: DescribeGameSessionPlacement)

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

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

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

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

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

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

-- |
-- Create a value of 'DescribeGameSessionPlacementResponse' 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:
--
-- 'gameSessionPlacement', 'describeGameSessionPlacementResponse_gameSessionPlacement' - Object that describes the requested game session placement.
--
-- 'httpStatus', 'describeGameSessionPlacementResponse_httpStatus' - The response's http status code.
newDescribeGameSessionPlacementResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeGameSessionPlacementResponse
newDescribeGameSessionPlacementResponse :: Int -> DescribeGameSessionPlacementResponse
newDescribeGameSessionPlacementResponse Int
pHttpStatus_ =
  DescribeGameSessionPlacementResponse'
    { $sel:gameSessionPlacement:DescribeGameSessionPlacementResponse' :: Maybe GameSessionPlacement
gameSessionPlacement =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeGameSessionPlacementResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Object that describes the requested game session placement.
describeGameSessionPlacementResponse_gameSessionPlacement :: Lens.Lens' DescribeGameSessionPlacementResponse (Prelude.Maybe GameSessionPlacement)
describeGameSessionPlacementResponse_gameSessionPlacement :: Lens'
  DescribeGameSessionPlacementResponse (Maybe GameSessionPlacement)
describeGameSessionPlacementResponse_gameSessionPlacement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGameSessionPlacementResponse' {Maybe GameSessionPlacement
gameSessionPlacement :: Maybe GameSessionPlacement
$sel:gameSessionPlacement:DescribeGameSessionPlacementResponse' :: DescribeGameSessionPlacementResponse -> Maybe GameSessionPlacement
gameSessionPlacement} -> Maybe GameSessionPlacement
gameSessionPlacement) (\s :: DescribeGameSessionPlacementResponse
s@DescribeGameSessionPlacementResponse' {} Maybe GameSessionPlacement
a -> DescribeGameSessionPlacementResponse
s {$sel:gameSessionPlacement:DescribeGameSessionPlacementResponse' :: Maybe GameSessionPlacement
gameSessionPlacement = Maybe GameSessionPlacement
a} :: DescribeGameSessionPlacementResponse)

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

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