{-# 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.RDS.DescribeDBSnapshotAttributes
-- 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 a list of DB snapshot attribute names and values for a manual DB
-- snapshot.
--
-- When sharing snapshots with other Amazon Web Services accounts,
-- @DescribeDBSnapshotAttributes@ returns the @restore@ attribute and a
-- list of IDs for the Amazon Web Services accounts that are authorized to
-- copy or restore the manual DB snapshot. If @all@ is included in the list
-- of values for the @restore@ attribute, then the manual DB snapshot is
-- public and can be copied or restored by all Amazon Web Services
-- accounts.
--
-- To add or remove access for an Amazon Web Services account to copy or
-- restore a manual DB snapshot, or to make the manual DB snapshot public
-- or private, use the @ModifyDBSnapshotAttribute@ API action.
module Amazonka.RDS.DescribeDBSnapshotAttributes
  ( -- * Creating a Request
    DescribeDBSnapshotAttributes (..),
    newDescribeDBSnapshotAttributes,

    -- * Request Lenses
    describeDBSnapshotAttributes_dbSnapshotIdentifier,

    -- * Destructuring the Response
    DescribeDBSnapshotAttributesResponse (..),
    newDescribeDBSnapshotAttributesResponse,

    -- * Response Lenses
    describeDBSnapshotAttributesResponse_dbSnapshotAttributesResult,
    describeDBSnapshotAttributesResponse_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.RDS.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newDescribeDBSnapshotAttributes' smart constructor.
data DescribeDBSnapshotAttributes = DescribeDBSnapshotAttributes'
  { -- | The identifier for the DB snapshot to describe the attributes for.
    DescribeDBSnapshotAttributes -> Text
dbSnapshotIdentifier :: Prelude.Text
  }
  deriving (DescribeDBSnapshotAttributes
-> DescribeDBSnapshotAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDBSnapshotAttributes
-> DescribeDBSnapshotAttributes -> Bool
$c/= :: DescribeDBSnapshotAttributes
-> DescribeDBSnapshotAttributes -> Bool
== :: DescribeDBSnapshotAttributes
-> DescribeDBSnapshotAttributes -> Bool
$c== :: DescribeDBSnapshotAttributes
-> DescribeDBSnapshotAttributes -> Bool
Prelude.Eq, ReadPrec [DescribeDBSnapshotAttributes]
ReadPrec DescribeDBSnapshotAttributes
Int -> ReadS DescribeDBSnapshotAttributes
ReadS [DescribeDBSnapshotAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDBSnapshotAttributes]
$creadListPrec :: ReadPrec [DescribeDBSnapshotAttributes]
readPrec :: ReadPrec DescribeDBSnapshotAttributes
$creadPrec :: ReadPrec DescribeDBSnapshotAttributes
readList :: ReadS [DescribeDBSnapshotAttributes]
$creadList :: ReadS [DescribeDBSnapshotAttributes]
readsPrec :: Int -> ReadS DescribeDBSnapshotAttributes
$creadsPrec :: Int -> ReadS DescribeDBSnapshotAttributes
Prelude.Read, Int -> DescribeDBSnapshotAttributes -> ShowS
[DescribeDBSnapshotAttributes] -> ShowS
DescribeDBSnapshotAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDBSnapshotAttributes] -> ShowS
$cshowList :: [DescribeDBSnapshotAttributes] -> ShowS
show :: DescribeDBSnapshotAttributes -> String
$cshow :: DescribeDBSnapshotAttributes -> String
showsPrec :: Int -> DescribeDBSnapshotAttributes -> ShowS
$cshowsPrec :: Int -> DescribeDBSnapshotAttributes -> ShowS
Prelude.Show, forall x.
Rep DescribeDBSnapshotAttributes x -> DescribeDBSnapshotAttributes
forall x.
DescribeDBSnapshotAttributes -> Rep DescribeDBSnapshotAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDBSnapshotAttributes x -> DescribeDBSnapshotAttributes
$cfrom :: forall x.
DescribeDBSnapshotAttributes -> Rep DescribeDBSnapshotAttributes x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDBSnapshotAttributes' 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:
--
-- 'dbSnapshotIdentifier', 'describeDBSnapshotAttributes_dbSnapshotIdentifier' - The identifier for the DB snapshot to describe the attributes for.
newDescribeDBSnapshotAttributes ::
  -- | 'dbSnapshotIdentifier'
  Prelude.Text ->
  DescribeDBSnapshotAttributes
newDescribeDBSnapshotAttributes :: Text -> DescribeDBSnapshotAttributes
newDescribeDBSnapshotAttributes
  Text
pDBSnapshotIdentifier_ =
    DescribeDBSnapshotAttributes'
      { $sel:dbSnapshotIdentifier:DescribeDBSnapshotAttributes' :: Text
dbSnapshotIdentifier =
          Text
pDBSnapshotIdentifier_
      }

-- | The identifier for the DB snapshot to describe the attributes for.
describeDBSnapshotAttributes_dbSnapshotIdentifier :: Lens.Lens' DescribeDBSnapshotAttributes Prelude.Text
describeDBSnapshotAttributes_dbSnapshotIdentifier :: Lens' DescribeDBSnapshotAttributes Text
describeDBSnapshotAttributes_dbSnapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBSnapshotAttributes' {Text
dbSnapshotIdentifier :: Text
$sel:dbSnapshotIdentifier:DescribeDBSnapshotAttributes' :: DescribeDBSnapshotAttributes -> Text
dbSnapshotIdentifier} -> Text
dbSnapshotIdentifier) (\s :: DescribeDBSnapshotAttributes
s@DescribeDBSnapshotAttributes' {} Text
a -> DescribeDBSnapshotAttributes
s {$sel:dbSnapshotIdentifier:DescribeDBSnapshotAttributes' :: Text
dbSnapshotIdentifier = Text
a} :: DescribeDBSnapshotAttributes)

instance Core.AWSRequest DescribeDBSnapshotAttributes where
  type
    AWSResponse DescribeDBSnapshotAttributes =
      DescribeDBSnapshotAttributesResponse
  request :: (Service -> Service)
-> DescribeDBSnapshotAttributes
-> Request DescribeDBSnapshotAttributes
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeDBSnapshotAttributes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeDBSnapshotAttributes)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"DescribeDBSnapshotAttributesResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBSnapshotAttributesResult
-> Int -> DescribeDBSnapshotAttributesResponse
DescribeDBSnapshotAttributesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DBSnapshotAttributesResult")
            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
    DescribeDBSnapshotAttributes
  where
  hashWithSalt :: Int -> DescribeDBSnapshotAttributes -> Int
hashWithSalt Int
_salt DescribeDBSnapshotAttributes' {Text
dbSnapshotIdentifier :: Text
$sel:dbSnapshotIdentifier:DescribeDBSnapshotAttributes' :: DescribeDBSnapshotAttributes -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbSnapshotIdentifier

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

instance Data.ToHeaders DescribeDBSnapshotAttributes where
  toHeaders :: DescribeDBSnapshotAttributes -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DescribeDBSnapshotAttributes where
  toQuery :: DescribeDBSnapshotAttributes -> QueryString
toQuery DescribeDBSnapshotAttributes' {Text
dbSnapshotIdentifier :: Text
$sel:dbSnapshotIdentifier:DescribeDBSnapshotAttributes' :: DescribeDBSnapshotAttributes -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"DescribeDBSnapshotAttributes" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"DBSnapshotIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbSnapshotIdentifier
      ]

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

-- |
-- Create a value of 'DescribeDBSnapshotAttributesResponse' 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:
--
-- 'dbSnapshotAttributesResult', 'describeDBSnapshotAttributesResponse_dbSnapshotAttributesResult' - Undocumented member.
--
-- 'httpStatus', 'describeDBSnapshotAttributesResponse_httpStatus' - The response's http status code.
newDescribeDBSnapshotAttributesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeDBSnapshotAttributesResponse
newDescribeDBSnapshotAttributesResponse :: Int -> DescribeDBSnapshotAttributesResponse
newDescribeDBSnapshotAttributesResponse Int
pHttpStatus_ =
  DescribeDBSnapshotAttributesResponse'
    { $sel:dbSnapshotAttributesResult:DescribeDBSnapshotAttributesResponse' :: Maybe DBSnapshotAttributesResult
dbSnapshotAttributesResult =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeDBSnapshotAttributesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
describeDBSnapshotAttributesResponse_dbSnapshotAttributesResult :: Lens.Lens' DescribeDBSnapshotAttributesResponse (Prelude.Maybe DBSnapshotAttributesResult)
describeDBSnapshotAttributesResponse_dbSnapshotAttributesResult :: Lens'
  DescribeDBSnapshotAttributesResponse
  (Maybe DBSnapshotAttributesResult)
describeDBSnapshotAttributesResponse_dbSnapshotAttributesResult = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBSnapshotAttributesResponse' {Maybe DBSnapshotAttributesResult
dbSnapshotAttributesResult :: Maybe DBSnapshotAttributesResult
$sel:dbSnapshotAttributesResult:DescribeDBSnapshotAttributesResponse' :: DescribeDBSnapshotAttributesResponse
-> Maybe DBSnapshotAttributesResult
dbSnapshotAttributesResult} -> Maybe DBSnapshotAttributesResult
dbSnapshotAttributesResult) (\s :: DescribeDBSnapshotAttributesResponse
s@DescribeDBSnapshotAttributesResponse' {} Maybe DBSnapshotAttributesResult
a -> DescribeDBSnapshotAttributesResponse
s {$sel:dbSnapshotAttributesResult:DescribeDBSnapshotAttributesResponse' :: Maybe DBSnapshotAttributesResult
dbSnapshotAttributesResult = Maybe DBSnapshotAttributesResult
a} :: DescribeDBSnapshotAttributesResponse)

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

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