{-# 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.GamesParks.GetSnapshot
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets a copy of the game configuration in a snapshot.
module Amazonka.GamesParks.GetSnapshot
  ( -- * Creating a Request
    GetSnapshot (..),
    newGetSnapshot,

    -- * Request Lenses
    getSnapshot_sections,
    getSnapshot_gameName,
    getSnapshot_snapshotId,

    -- * Destructuring the Response
    GetSnapshotResponse (..),
    newGetSnapshotResponse,

    -- * Response Lenses
    getSnapshotResponse_snapshot,
    getSnapshotResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.GamesParks.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetSnapshot' smart constructor.
data GetSnapshot = GetSnapshot'
  { -- | The list of game configuration sections to be described.
    GetSnapshot -> Maybe (NonEmpty Text)
sections :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The name of the game.
    GetSnapshot -> Text
gameName :: Prelude.Text,
    -- | The identifier of the snapshot.
    GetSnapshot -> Text
snapshotId :: Prelude.Text
  }
  deriving (GetSnapshot -> GetSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSnapshot -> GetSnapshot -> Bool
$c/= :: GetSnapshot -> GetSnapshot -> Bool
== :: GetSnapshot -> GetSnapshot -> Bool
$c== :: GetSnapshot -> GetSnapshot -> Bool
Prelude.Eq, ReadPrec [GetSnapshot]
ReadPrec GetSnapshot
Int -> ReadS GetSnapshot
ReadS [GetSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSnapshot]
$creadListPrec :: ReadPrec [GetSnapshot]
readPrec :: ReadPrec GetSnapshot
$creadPrec :: ReadPrec GetSnapshot
readList :: ReadS [GetSnapshot]
$creadList :: ReadS [GetSnapshot]
readsPrec :: Int -> ReadS GetSnapshot
$creadsPrec :: Int -> ReadS GetSnapshot
Prelude.Read, Int -> GetSnapshot -> ShowS
[GetSnapshot] -> ShowS
GetSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSnapshot] -> ShowS
$cshowList :: [GetSnapshot] -> ShowS
show :: GetSnapshot -> String
$cshow :: GetSnapshot -> String
showsPrec :: Int -> GetSnapshot -> ShowS
$cshowsPrec :: Int -> GetSnapshot -> ShowS
Prelude.Show, forall x. Rep GetSnapshot x -> GetSnapshot
forall x. GetSnapshot -> Rep GetSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSnapshot x -> GetSnapshot
$cfrom :: forall x. GetSnapshot -> Rep GetSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'GetSnapshot' 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:
--
-- 'sections', 'getSnapshot_sections' - The list of game configuration sections to be described.
--
-- 'gameName', 'getSnapshot_gameName' - The name of the game.
--
-- 'snapshotId', 'getSnapshot_snapshotId' - The identifier of the snapshot.
newGetSnapshot ::
  -- | 'gameName'
  Prelude.Text ->
  -- | 'snapshotId'
  Prelude.Text ->
  GetSnapshot
newGetSnapshot :: Text -> Text -> GetSnapshot
newGetSnapshot Text
pGameName_ Text
pSnapshotId_ =
  GetSnapshot'
    { $sel:sections:GetSnapshot' :: Maybe (NonEmpty Text)
sections = forall a. Maybe a
Prelude.Nothing,
      $sel:gameName:GetSnapshot' :: Text
gameName = Text
pGameName_,
      $sel:snapshotId:GetSnapshot' :: Text
snapshotId = Text
pSnapshotId_
    }

-- | The list of game configuration sections to be described.
getSnapshot_sections :: Lens.Lens' GetSnapshot (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
getSnapshot_sections :: Lens' GetSnapshot (Maybe (NonEmpty Text))
getSnapshot_sections = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshot' {Maybe (NonEmpty Text)
sections :: Maybe (NonEmpty Text)
$sel:sections:GetSnapshot' :: GetSnapshot -> Maybe (NonEmpty Text)
sections} -> Maybe (NonEmpty Text)
sections) (\s :: GetSnapshot
s@GetSnapshot' {} Maybe (NonEmpty Text)
a -> GetSnapshot
s {$sel:sections:GetSnapshot' :: Maybe (NonEmpty Text)
sections = Maybe (NonEmpty Text)
a} :: GetSnapshot) 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

-- | The name of the game.
getSnapshot_gameName :: Lens.Lens' GetSnapshot Prelude.Text
getSnapshot_gameName :: Lens' GetSnapshot Text
getSnapshot_gameName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshot' {Text
gameName :: Text
$sel:gameName:GetSnapshot' :: GetSnapshot -> Text
gameName} -> Text
gameName) (\s :: GetSnapshot
s@GetSnapshot' {} Text
a -> GetSnapshot
s {$sel:gameName:GetSnapshot' :: Text
gameName = Text
a} :: GetSnapshot)

-- | The identifier of the snapshot.
getSnapshot_snapshotId :: Lens.Lens' GetSnapshot Prelude.Text
getSnapshot_snapshotId :: Lens' GetSnapshot Text
getSnapshot_snapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshot' {Text
snapshotId :: Text
$sel:snapshotId:GetSnapshot' :: GetSnapshot -> Text
snapshotId} -> Text
snapshotId) (\s :: GetSnapshot
s@GetSnapshot' {} Text
a -> GetSnapshot
s {$sel:snapshotId:GetSnapshot' :: Text
snapshotId = Text
a} :: GetSnapshot)

instance Core.AWSRequest GetSnapshot where
  type AWSResponse GetSnapshot = GetSnapshotResponse
  request :: (Service -> Service) -> GetSnapshot -> Request GetSnapshot
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetSnapshot
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetSnapshot)))
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 SnapshotDetails -> Int -> GetSnapshotResponse
GetSnapshotResponse'
            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
"Snapshot")
            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 GetSnapshot where
  hashWithSalt :: Int -> GetSnapshot -> Int
hashWithSalt Int
_salt GetSnapshot' {Maybe (NonEmpty Text)
Text
snapshotId :: Text
gameName :: Text
sections :: Maybe (NonEmpty Text)
$sel:snapshotId:GetSnapshot' :: GetSnapshot -> Text
$sel:gameName:GetSnapshot' :: GetSnapshot -> Text
$sel:sections:GetSnapshot' :: GetSnapshot -> Maybe (NonEmpty Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
sections
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gameName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
snapshotId

instance Prelude.NFData GetSnapshot where
  rnf :: GetSnapshot -> ()
rnf GetSnapshot' {Maybe (NonEmpty Text)
Text
snapshotId :: Text
gameName :: Text
sections :: Maybe (NonEmpty Text)
$sel:snapshotId:GetSnapshot' :: GetSnapshot -> Text
$sel:gameName:GetSnapshot' :: GetSnapshot -> Text
$sel:sections:GetSnapshot' :: GetSnapshot -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
sections
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gameName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
snapshotId

instance Data.ToHeaders GetSnapshot where
  toHeaders :: GetSnapshot -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetSnapshot where
  toPath :: GetSnapshot -> ByteString
toPath GetSnapshot' {Maybe (NonEmpty Text)
Text
snapshotId :: Text
gameName :: Text
sections :: Maybe (NonEmpty Text)
$sel:snapshotId:GetSnapshot' :: GetSnapshot -> Text
$sel:gameName:GetSnapshot' :: GetSnapshot -> Text
$sel:sections:GetSnapshot' :: GetSnapshot -> Maybe (NonEmpty Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/game/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
gameName,
        ByteString
"/snapshot/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
snapshotId
      ]

instance Data.ToQuery GetSnapshot where
  toQuery :: GetSnapshot -> QueryString
toQuery GetSnapshot' {Maybe (NonEmpty Text)
Text
snapshotId :: Text
gameName :: Text
sections :: Maybe (NonEmpty Text)
$sel:snapshotId:GetSnapshot' :: GetSnapshot -> Text
$sel:gameName:GetSnapshot' :: GetSnapshot -> Text
$sel:sections:GetSnapshot' :: GetSnapshot -> Maybe (NonEmpty Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Sections"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Text)
sections)
      ]

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

-- |
-- Create a value of 'GetSnapshotResponse' 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:
--
-- 'snapshot', 'getSnapshotResponse_snapshot' - Properties that provide details of the snapshot.
--
-- 'httpStatus', 'getSnapshotResponse_httpStatus' - The response's http status code.
newGetSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSnapshotResponse
newGetSnapshotResponse :: Int -> GetSnapshotResponse
newGetSnapshotResponse Int
pHttpStatus_ =
  GetSnapshotResponse'
    { $sel:snapshot:GetSnapshotResponse' :: Maybe SnapshotDetails
snapshot = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Properties that provide details of the snapshot.
getSnapshotResponse_snapshot :: Lens.Lens' GetSnapshotResponse (Prelude.Maybe SnapshotDetails)
getSnapshotResponse_snapshot :: Lens' GetSnapshotResponse (Maybe SnapshotDetails)
getSnapshotResponse_snapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshotResponse' {Maybe SnapshotDetails
snapshot :: Maybe SnapshotDetails
$sel:snapshot:GetSnapshotResponse' :: GetSnapshotResponse -> Maybe SnapshotDetails
snapshot} -> Maybe SnapshotDetails
snapshot) (\s :: GetSnapshotResponse
s@GetSnapshotResponse' {} Maybe SnapshotDetails
a -> GetSnapshotResponse
s {$sel:snapshot:GetSnapshotResponse' :: Maybe SnapshotDetails
snapshot = Maybe SnapshotDetails
a} :: GetSnapshotResponse)

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

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