{-# 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.RedshiftServerLess.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)
--
-- Returns information about a specific snapshot.
module Amazonka.RedshiftServerLess.GetSnapshot
  ( -- * Creating a Request
    GetSnapshot (..),
    newGetSnapshot,

    -- * Request Lenses
    getSnapshot_ownerAccount,
    getSnapshot_snapshotArn,
    getSnapshot_snapshotName,

    -- * 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 qualified Amazonka.Prelude as Prelude
import Amazonka.RedshiftServerLess.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetSnapshot' smart constructor.
data GetSnapshot = GetSnapshot'
  { -- | The owner Amazon Web Services account of a snapshot shared with another
    -- user.
    GetSnapshot -> Maybe Text
ownerAccount :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the snapshot to return.
    GetSnapshot -> Maybe Text
snapshotArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the snapshot to return.
    GetSnapshot -> Maybe Text
snapshotName :: Prelude.Maybe 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:
--
-- 'ownerAccount', 'getSnapshot_ownerAccount' - The owner Amazon Web Services account of a snapshot shared with another
-- user.
--
-- 'snapshotArn', 'getSnapshot_snapshotArn' - The Amazon Resource Name (ARN) of the snapshot to return.
--
-- 'snapshotName', 'getSnapshot_snapshotName' - The name of the snapshot to return.
newGetSnapshot ::
  GetSnapshot
newGetSnapshot :: GetSnapshot
newGetSnapshot =
  GetSnapshot'
    { $sel:ownerAccount:GetSnapshot' :: Maybe Text
ownerAccount = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotArn:GetSnapshot' :: Maybe Text
snapshotArn = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotName:GetSnapshot' :: Maybe Text
snapshotName = forall a. Maybe a
Prelude.Nothing
    }

-- | The owner Amazon Web Services account of a snapshot shared with another
-- user.
getSnapshot_ownerAccount :: Lens.Lens' GetSnapshot (Prelude.Maybe Prelude.Text)
getSnapshot_ownerAccount :: Lens' GetSnapshot (Maybe Text)
getSnapshot_ownerAccount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshot' {Maybe Text
ownerAccount :: Maybe Text
$sel:ownerAccount:GetSnapshot' :: GetSnapshot -> Maybe Text
ownerAccount} -> Maybe Text
ownerAccount) (\s :: GetSnapshot
s@GetSnapshot' {} Maybe Text
a -> GetSnapshot
s {$sel:ownerAccount:GetSnapshot' :: Maybe Text
ownerAccount = Maybe Text
a} :: GetSnapshot)

-- | The Amazon Resource Name (ARN) of the snapshot to return.
getSnapshot_snapshotArn :: Lens.Lens' GetSnapshot (Prelude.Maybe Prelude.Text)
getSnapshot_snapshotArn :: Lens' GetSnapshot (Maybe Text)
getSnapshot_snapshotArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshot' {Maybe Text
snapshotArn :: Maybe Text
$sel:snapshotArn:GetSnapshot' :: GetSnapshot -> Maybe Text
snapshotArn} -> Maybe Text
snapshotArn) (\s :: GetSnapshot
s@GetSnapshot' {} Maybe Text
a -> GetSnapshot
s {$sel:snapshotArn:GetSnapshot' :: Maybe Text
snapshotArn = Maybe Text
a} :: GetSnapshot)

-- | The name of the snapshot to return.
getSnapshot_snapshotName :: Lens.Lens' GetSnapshot (Prelude.Maybe Prelude.Text)
getSnapshot_snapshotName :: Lens' GetSnapshot (Maybe Text)
getSnapshot_snapshotName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshot' {Maybe Text
snapshotName :: Maybe Text
$sel:snapshotName:GetSnapshot' :: GetSnapshot -> Maybe Text
snapshotName} -> Maybe Text
snapshotName) (\s :: GetSnapshot
s@GetSnapshot' {} Maybe Text
a -> GetSnapshot
s {$sel:snapshotName:GetSnapshot' :: Maybe Text
snapshotName = Maybe 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, ToJSON a) => Service -> a -> Request a
Request.postJSON (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 Snapshot -> 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 Text
snapshotName :: Maybe Text
snapshotArn :: Maybe Text
ownerAccount :: Maybe Text
$sel:snapshotName:GetSnapshot' :: GetSnapshot -> Maybe Text
$sel:snapshotArn:GetSnapshot' :: GetSnapshot -> Maybe Text
$sel:ownerAccount:GetSnapshot' :: GetSnapshot -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ownerAccount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotName

instance Prelude.NFData GetSnapshot where
  rnf :: GetSnapshot -> ()
rnf GetSnapshot' {Maybe Text
snapshotName :: Maybe Text
snapshotArn :: Maybe Text
ownerAccount :: Maybe Text
$sel:snapshotName:GetSnapshot' :: GetSnapshot -> Maybe Text
$sel:snapshotArn:GetSnapshot' :: GetSnapshot -> Maybe Text
$sel:ownerAccount:GetSnapshot' :: GetSnapshot -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ownerAccount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
snapshotArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
snapshotName

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
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"RedshiftServerless.GetSnapshot" ::
                          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 GetSnapshot where
  toJSON :: GetSnapshot -> Value
toJSON GetSnapshot' {Maybe Text
snapshotName :: Maybe Text
snapshotArn :: Maybe Text
ownerAccount :: Maybe Text
$sel:snapshotName:GetSnapshot' :: GetSnapshot -> Maybe Text
$sel:snapshotArn:GetSnapshot' :: GetSnapshot -> Maybe Text
$sel:ownerAccount:GetSnapshot' :: GetSnapshot -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ownerAccount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
ownerAccount,
            (Key
"snapshotArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
snapshotArn,
            (Key
"snapshotName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
snapshotName
          ]
      )

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

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

-- | /See:/ 'newGetSnapshotResponse' smart constructor.
data GetSnapshotResponse = GetSnapshotResponse'
  { -- | The returned snapshot object.
    GetSnapshotResponse -> Maybe Snapshot
snapshot :: Prelude.Maybe Snapshot,
    -- | 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' - The returned snapshot object.
--
-- '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 Snapshot
snapshot = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The returned snapshot object.
getSnapshotResponse_snapshot :: Lens.Lens' GetSnapshotResponse (Prelude.Maybe Snapshot)
getSnapshotResponse_snapshot :: Lens' GetSnapshotResponse (Maybe Snapshot)
getSnapshotResponse_snapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSnapshotResponse' {Maybe Snapshot
snapshot :: Maybe Snapshot
$sel:snapshot:GetSnapshotResponse' :: GetSnapshotResponse -> Maybe Snapshot
snapshot} -> Maybe Snapshot
snapshot) (\s :: GetSnapshotResponse
s@GetSnapshotResponse' {} Maybe Snapshot
a -> GetSnapshotResponse
s {$sel:snapshot:GetSnapshotResponse' :: Maybe Snapshot
snapshot = Maybe Snapshot
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 Snapshot
httpStatus :: Int
snapshot :: Maybe Snapshot
$sel:httpStatus:GetSnapshotResponse' :: GetSnapshotResponse -> Int
$sel:snapshot:GetSnapshotResponse' :: GetSnapshotResponse -> Maybe Snapshot
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Snapshot
snapshot
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus