{-# 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.GetGameSessionLogUrl
-- 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 the location of stored game session logs for a specified game
-- session. When a game session is terminated, GameLift automatically
-- stores the logs in Amazon S3 and retains them for 14 days. Use this URL
-- to download the logs.
--
-- See the
-- <https://docs.aws.amazon.com/general/latest/gr/aws_service_limits.html#limits_gamelift Amazon Web Services Service Limits>
-- page for maximum log file sizes. Log files that exceed this limit are
-- not saved.
--
-- <https://docs.aws.amazon.com/gamelift/latest/developerguide/reference-awssdk.html#reference-awssdk-resources-fleets All APIs by task>
module Amazonka.GameLift.GetGameSessionLogUrl
  ( -- * Creating a Request
    GetGameSessionLogUrl (..),
    newGetGameSessionLogUrl,

    -- * Request Lenses
    getGameSessionLogUrl_gameSessionId,

    -- * Destructuring the Response
    GetGameSessionLogUrlResponse (..),
    newGetGameSessionLogUrlResponse,

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

-- |
-- Create a value of 'GetGameSessionLogUrl' 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:
--
-- 'gameSessionId', 'getGameSessionLogUrl_gameSessionId' - A unique identifier for the game session to get logs for.
newGetGameSessionLogUrl ::
  -- | 'gameSessionId'
  Prelude.Text ->
  GetGameSessionLogUrl
newGetGameSessionLogUrl :: Text -> GetGameSessionLogUrl
newGetGameSessionLogUrl Text
pGameSessionId_ =
  GetGameSessionLogUrl'
    { $sel:gameSessionId:GetGameSessionLogUrl' :: Text
gameSessionId =
        Text
pGameSessionId_
    }

-- | A unique identifier for the game session to get logs for.
getGameSessionLogUrl_gameSessionId :: Lens.Lens' GetGameSessionLogUrl Prelude.Text
getGameSessionLogUrl_gameSessionId :: Lens' GetGameSessionLogUrl Text
getGameSessionLogUrl_gameSessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGameSessionLogUrl' {Text
gameSessionId :: Text
$sel:gameSessionId:GetGameSessionLogUrl' :: GetGameSessionLogUrl -> Text
gameSessionId} -> Text
gameSessionId) (\s :: GetGameSessionLogUrl
s@GetGameSessionLogUrl' {} Text
a -> GetGameSessionLogUrl
s {$sel:gameSessionId:GetGameSessionLogUrl' :: Text
gameSessionId = Text
a} :: GetGameSessionLogUrl)

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

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

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

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

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

-- | /See:/ 'newGetGameSessionLogUrlResponse' smart constructor.
data GetGameSessionLogUrlResponse = GetGameSessionLogUrlResponse'
  { -- | Location of the requested game session logs, available for download.
    -- This URL is valid for 15 minutes, after which S3 will reject any
    -- download request using this URL. You can request a new URL any time
    -- within the 14-day period that the logs are retained.
    GetGameSessionLogUrlResponse -> Maybe Text
preSignedUrl :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetGameSessionLogUrlResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetGameSessionLogUrlResponse
-> GetGameSessionLogUrlResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetGameSessionLogUrlResponse
-> GetGameSessionLogUrlResponse -> Bool
$c/= :: GetGameSessionLogUrlResponse
-> GetGameSessionLogUrlResponse -> Bool
== :: GetGameSessionLogUrlResponse
-> GetGameSessionLogUrlResponse -> Bool
$c== :: GetGameSessionLogUrlResponse
-> GetGameSessionLogUrlResponse -> Bool
Prelude.Eq, ReadPrec [GetGameSessionLogUrlResponse]
ReadPrec GetGameSessionLogUrlResponse
Int -> ReadS GetGameSessionLogUrlResponse
ReadS [GetGameSessionLogUrlResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetGameSessionLogUrlResponse]
$creadListPrec :: ReadPrec [GetGameSessionLogUrlResponse]
readPrec :: ReadPrec GetGameSessionLogUrlResponse
$creadPrec :: ReadPrec GetGameSessionLogUrlResponse
readList :: ReadS [GetGameSessionLogUrlResponse]
$creadList :: ReadS [GetGameSessionLogUrlResponse]
readsPrec :: Int -> ReadS GetGameSessionLogUrlResponse
$creadsPrec :: Int -> ReadS GetGameSessionLogUrlResponse
Prelude.Read, Int -> GetGameSessionLogUrlResponse -> ShowS
[GetGameSessionLogUrlResponse] -> ShowS
GetGameSessionLogUrlResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetGameSessionLogUrlResponse] -> ShowS
$cshowList :: [GetGameSessionLogUrlResponse] -> ShowS
show :: GetGameSessionLogUrlResponse -> String
$cshow :: GetGameSessionLogUrlResponse -> String
showsPrec :: Int -> GetGameSessionLogUrlResponse -> ShowS
$cshowsPrec :: Int -> GetGameSessionLogUrlResponse -> ShowS
Prelude.Show, forall x.
Rep GetGameSessionLogUrlResponse x -> GetGameSessionLogUrlResponse
forall x.
GetGameSessionLogUrlResponse -> Rep GetGameSessionLogUrlResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetGameSessionLogUrlResponse x -> GetGameSessionLogUrlResponse
$cfrom :: forall x.
GetGameSessionLogUrlResponse -> Rep GetGameSessionLogUrlResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetGameSessionLogUrlResponse' 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:
--
-- 'preSignedUrl', 'getGameSessionLogUrlResponse_preSignedUrl' - Location of the requested game session logs, available for download.
-- This URL is valid for 15 minutes, after which S3 will reject any
-- download request using this URL. You can request a new URL any time
-- within the 14-day period that the logs are retained.
--
-- 'httpStatus', 'getGameSessionLogUrlResponse_httpStatus' - The response's http status code.
newGetGameSessionLogUrlResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetGameSessionLogUrlResponse
newGetGameSessionLogUrlResponse :: Int -> GetGameSessionLogUrlResponse
newGetGameSessionLogUrlResponse Int
pHttpStatus_ =
  GetGameSessionLogUrlResponse'
    { $sel:preSignedUrl:GetGameSessionLogUrlResponse' :: Maybe Text
preSignedUrl =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetGameSessionLogUrlResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Location of the requested game session logs, available for download.
-- This URL is valid for 15 minutes, after which S3 will reject any
-- download request using this URL. You can request a new URL any time
-- within the 14-day period that the logs are retained.
getGameSessionLogUrlResponse_preSignedUrl :: Lens.Lens' GetGameSessionLogUrlResponse (Prelude.Maybe Prelude.Text)
getGameSessionLogUrlResponse_preSignedUrl :: Lens' GetGameSessionLogUrlResponse (Maybe Text)
getGameSessionLogUrlResponse_preSignedUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGameSessionLogUrlResponse' {Maybe Text
preSignedUrl :: Maybe Text
$sel:preSignedUrl:GetGameSessionLogUrlResponse' :: GetGameSessionLogUrlResponse -> Maybe Text
preSignedUrl} -> Maybe Text
preSignedUrl) (\s :: GetGameSessionLogUrlResponse
s@GetGameSessionLogUrlResponse' {} Maybe Text
a -> GetGameSessionLogUrlResponse
s {$sel:preSignedUrl:GetGameSessionLogUrlResponse' :: Maybe Text
preSignedUrl = Maybe Text
a} :: GetGameSessionLogUrlResponse)

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

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