{-# 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.DocumentDB.DescribeDBClusterSnapshots
-- 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 cluster snapshots. This API operation supports
-- pagination.
--
-- This operation returns paginated results.
module Amazonka.DocumentDB.DescribeDBClusterSnapshots
  ( -- * Creating a Request
    DescribeDBClusterSnapshots (..),
    newDescribeDBClusterSnapshots,

    -- * Request Lenses
    describeDBClusterSnapshots_dbClusterIdentifier,
    describeDBClusterSnapshots_dbClusterSnapshotIdentifier,
    describeDBClusterSnapshots_filters,
    describeDBClusterSnapshots_includePublic,
    describeDBClusterSnapshots_includeShared,
    describeDBClusterSnapshots_marker,
    describeDBClusterSnapshots_maxRecords,
    describeDBClusterSnapshots_snapshotType,

    -- * Destructuring the Response
    DescribeDBClusterSnapshotsResponse (..),
    newDescribeDBClusterSnapshotsResponse,

    -- * Response Lenses
    describeDBClusterSnapshotsResponse_dbClusterSnapshots,
    describeDBClusterSnapshotsResponse_marker,
    describeDBClusterSnapshotsResponse_httpStatus,
  )
where

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

-- | Represents the input to DescribeDBClusterSnapshots.
--
-- /See:/ 'newDescribeDBClusterSnapshots' smart constructor.
data DescribeDBClusterSnapshots = DescribeDBClusterSnapshots'
  { -- | The ID of the cluster to retrieve the list of cluster snapshots for.
    -- This parameter can\'t be used with the @DBClusterSnapshotIdentifier@
    -- parameter. This parameter is not case sensitive.
    --
    -- Constraints:
    --
    -- -   If provided, must match the identifier of an existing @DBCluster@.
    DescribeDBClusterSnapshots -> Maybe Text
dbClusterIdentifier :: Prelude.Maybe Prelude.Text,
    -- | A specific cluster snapshot identifier to describe. This parameter
    -- can\'t be used with the @DBClusterIdentifier@ parameter. This value is
    -- stored as a lowercase string.
    --
    -- Constraints:
    --
    -- -   If provided, must match the identifier of an existing
    --     @DBClusterSnapshot@.
    --
    -- -   If this identifier is for an automated snapshot, the @SnapshotType@
    --     parameter must also be specified.
    DescribeDBClusterSnapshots -> Maybe Text
dbClusterSnapshotIdentifier :: Prelude.Maybe Prelude.Text,
    -- | This parameter is not currently supported.
    DescribeDBClusterSnapshots -> Maybe [Filter]
filters :: Prelude.Maybe [Filter],
    -- | Set to @true@ to include manual cluster snapshots that are public and
    -- can be copied or restored by any Amazon Web Services account, and
    -- otherwise @false@. The default is @false@.
    DescribeDBClusterSnapshots -> Maybe Bool
includePublic :: Prelude.Maybe Prelude.Bool,
    -- | Set to @true@ to include shared manual cluster snapshots from other
    -- Amazon Web Services accounts that this Amazon Web Services account has
    -- been given permission to copy or restore, and otherwise @false@. The
    -- default is @false@.
    DescribeDBClusterSnapshots -> Maybe Bool
includeShared :: Prelude.Maybe Prelude.Bool,
    -- | An optional pagination token provided by a previous request. If this
    -- parameter is specified, the response includes only records beyond the
    -- marker, up to the value specified by @MaxRecords@.
    DescribeDBClusterSnapshots -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of records to include in the response. If more
    -- records exist than the specified @MaxRecords@ value, a pagination token
    -- (marker) is included in the response so that the remaining results can
    -- be retrieved.
    --
    -- Default: 100
    --
    -- Constraints: Minimum 20, maximum 100.
    DescribeDBClusterSnapshots -> Maybe Int
maxRecords :: Prelude.Maybe Prelude.Int,
    -- | The type of cluster snapshots to be returned. You can specify one of the
    -- following values:
    --
    -- -   @automated@ - Return all cluster snapshots that Amazon DocumentDB
    --     has automatically created for your Amazon Web Services account.
    --
    -- -   @manual@ - Return all cluster snapshots that you have manually
    --     created for your Amazon Web Services account.
    --
    -- -   @shared@ - Return all manual cluster snapshots that have been shared
    --     to your Amazon Web Services account.
    --
    -- -   @public@ - Return all cluster snapshots that have been marked as
    --     public.
    --
    -- If you don\'t specify a @SnapshotType@ value, then both automated and
    -- manual cluster snapshots are returned. You can include shared cluster
    -- snapshots with these results by setting the @IncludeShared@ parameter to
    -- @true@. You can include public cluster snapshots with these results by
    -- setting the@IncludePublic@ parameter to @true@.
    --
    -- The @IncludeShared@ and @IncludePublic@ parameters don\'t apply for
    -- @SnapshotType@ values of @manual@ or @automated@. The @IncludePublic@
    -- parameter doesn\'t apply when @SnapshotType@ is set to @shared@. The
    -- @IncludeShared@ parameter doesn\'t apply when @SnapshotType@ is set to
    -- @public@.
    DescribeDBClusterSnapshots -> Maybe Text
snapshotType :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeDBClusterSnapshots -> DescribeDBClusterSnapshots -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDBClusterSnapshots -> DescribeDBClusterSnapshots -> Bool
$c/= :: DescribeDBClusterSnapshots -> DescribeDBClusterSnapshots -> Bool
== :: DescribeDBClusterSnapshots -> DescribeDBClusterSnapshots -> Bool
$c== :: DescribeDBClusterSnapshots -> DescribeDBClusterSnapshots -> Bool
Prelude.Eq, ReadPrec [DescribeDBClusterSnapshots]
ReadPrec DescribeDBClusterSnapshots
Int -> ReadS DescribeDBClusterSnapshots
ReadS [DescribeDBClusterSnapshots]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDBClusterSnapshots]
$creadListPrec :: ReadPrec [DescribeDBClusterSnapshots]
readPrec :: ReadPrec DescribeDBClusterSnapshots
$creadPrec :: ReadPrec DescribeDBClusterSnapshots
readList :: ReadS [DescribeDBClusterSnapshots]
$creadList :: ReadS [DescribeDBClusterSnapshots]
readsPrec :: Int -> ReadS DescribeDBClusterSnapshots
$creadsPrec :: Int -> ReadS DescribeDBClusterSnapshots
Prelude.Read, Int -> DescribeDBClusterSnapshots -> ShowS
[DescribeDBClusterSnapshots] -> ShowS
DescribeDBClusterSnapshots -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDBClusterSnapshots] -> ShowS
$cshowList :: [DescribeDBClusterSnapshots] -> ShowS
show :: DescribeDBClusterSnapshots -> String
$cshow :: DescribeDBClusterSnapshots -> String
showsPrec :: Int -> DescribeDBClusterSnapshots -> ShowS
$cshowsPrec :: Int -> DescribeDBClusterSnapshots -> ShowS
Prelude.Show, forall x.
Rep DescribeDBClusterSnapshots x -> DescribeDBClusterSnapshots
forall x.
DescribeDBClusterSnapshots -> Rep DescribeDBClusterSnapshots x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDBClusterSnapshots x -> DescribeDBClusterSnapshots
$cfrom :: forall x.
DescribeDBClusterSnapshots -> Rep DescribeDBClusterSnapshots x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDBClusterSnapshots' 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:
--
-- 'dbClusterIdentifier', 'describeDBClusterSnapshots_dbClusterIdentifier' - The ID of the cluster to retrieve the list of cluster snapshots for.
-- This parameter can\'t be used with the @DBClusterSnapshotIdentifier@
-- parameter. This parameter is not case sensitive.
--
-- Constraints:
--
-- -   If provided, must match the identifier of an existing @DBCluster@.
--
-- 'dbClusterSnapshotIdentifier', 'describeDBClusterSnapshots_dbClusterSnapshotIdentifier' - A specific cluster snapshot identifier to describe. This parameter
-- can\'t be used with the @DBClusterIdentifier@ parameter. This value is
-- stored as a lowercase string.
--
-- Constraints:
--
-- -   If provided, must match the identifier of an existing
--     @DBClusterSnapshot@.
--
-- -   If this identifier is for an automated snapshot, the @SnapshotType@
--     parameter must also be specified.
--
-- 'filters', 'describeDBClusterSnapshots_filters' - This parameter is not currently supported.
--
-- 'includePublic', 'describeDBClusterSnapshots_includePublic' - Set to @true@ to include manual cluster snapshots that are public and
-- can be copied or restored by any Amazon Web Services account, and
-- otherwise @false@. The default is @false@.
--
-- 'includeShared', 'describeDBClusterSnapshots_includeShared' - Set to @true@ to include shared manual cluster snapshots from other
-- Amazon Web Services accounts that this Amazon Web Services account has
-- been given permission to copy or restore, and otherwise @false@. The
-- default is @false@.
--
-- 'marker', 'describeDBClusterSnapshots_marker' - An optional pagination token provided by a previous request. If this
-- parameter is specified, the response includes only records beyond the
-- marker, up to the value specified by @MaxRecords@.
--
-- 'maxRecords', 'describeDBClusterSnapshots_maxRecords' - The maximum number of records to include in the response. If more
-- records exist than the specified @MaxRecords@ value, a pagination token
-- (marker) is included in the response so that the remaining results can
-- be retrieved.
--
-- Default: 100
--
-- Constraints: Minimum 20, maximum 100.
--
-- 'snapshotType', 'describeDBClusterSnapshots_snapshotType' - The type of cluster snapshots to be returned. You can specify one of the
-- following values:
--
-- -   @automated@ - Return all cluster snapshots that Amazon DocumentDB
--     has automatically created for your Amazon Web Services account.
--
-- -   @manual@ - Return all cluster snapshots that you have manually
--     created for your Amazon Web Services account.
--
-- -   @shared@ - Return all manual cluster snapshots that have been shared
--     to your Amazon Web Services account.
--
-- -   @public@ - Return all cluster snapshots that have been marked as
--     public.
--
-- If you don\'t specify a @SnapshotType@ value, then both automated and
-- manual cluster snapshots are returned. You can include shared cluster
-- snapshots with these results by setting the @IncludeShared@ parameter to
-- @true@. You can include public cluster snapshots with these results by
-- setting the@IncludePublic@ parameter to @true@.
--
-- The @IncludeShared@ and @IncludePublic@ parameters don\'t apply for
-- @SnapshotType@ values of @manual@ or @automated@. The @IncludePublic@
-- parameter doesn\'t apply when @SnapshotType@ is set to @shared@. The
-- @IncludeShared@ parameter doesn\'t apply when @SnapshotType@ is set to
-- @public@.
newDescribeDBClusterSnapshots ::
  DescribeDBClusterSnapshots
newDescribeDBClusterSnapshots :: DescribeDBClusterSnapshots
newDescribeDBClusterSnapshots =
  DescribeDBClusterSnapshots'
    { $sel:dbClusterIdentifier:DescribeDBClusterSnapshots' :: Maybe Text
dbClusterIdentifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dbClusterSnapshotIdentifier:DescribeDBClusterSnapshots' :: Maybe Text
dbClusterSnapshotIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:filters:DescribeDBClusterSnapshots' :: Maybe [Filter]
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:includePublic:DescribeDBClusterSnapshots' :: Maybe Bool
includePublic = forall a. Maybe a
Prelude.Nothing,
      $sel:includeShared:DescribeDBClusterSnapshots' :: Maybe Bool
includeShared = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:DescribeDBClusterSnapshots' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxRecords:DescribeDBClusterSnapshots' :: Maybe Int
maxRecords = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotType:DescribeDBClusterSnapshots' :: Maybe Text
snapshotType = forall a. Maybe a
Prelude.Nothing
    }

-- | The ID of the cluster to retrieve the list of cluster snapshots for.
-- This parameter can\'t be used with the @DBClusterSnapshotIdentifier@
-- parameter. This parameter is not case sensitive.
--
-- Constraints:
--
-- -   If provided, must match the identifier of an existing @DBCluster@.
describeDBClusterSnapshots_dbClusterIdentifier :: Lens.Lens' DescribeDBClusterSnapshots (Prelude.Maybe Prelude.Text)
describeDBClusterSnapshots_dbClusterIdentifier :: Lens' DescribeDBClusterSnapshots (Maybe Text)
describeDBClusterSnapshots_dbClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBClusterSnapshots' {Maybe Text
dbClusterIdentifier :: Maybe Text
$sel:dbClusterIdentifier:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
dbClusterIdentifier} -> Maybe Text
dbClusterIdentifier) (\s :: DescribeDBClusterSnapshots
s@DescribeDBClusterSnapshots' {} Maybe Text
a -> DescribeDBClusterSnapshots
s {$sel:dbClusterIdentifier:DescribeDBClusterSnapshots' :: Maybe Text
dbClusterIdentifier = Maybe Text
a} :: DescribeDBClusterSnapshots)

-- | A specific cluster snapshot identifier to describe. This parameter
-- can\'t be used with the @DBClusterIdentifier@ parameter. This value is
-- stored as a lowercase string.
--
-- Constraints:
--
-- -   If provided, must match the identifier of an existing
--     @DBClusterSnapshot@.
--
-- -   If this identifier is for an automated snapshot, the @SnapshotType@
--     parameter must also be specified.
describeDBClusterSnapshots_dbClusterSnapshotIdentifier :: Lens.Lens' DescribeDBClusterSnapshots (Prelude.Maybe Prelude.Text)
describeDBClusterSnapshots_dbClusterSnapshotIdentifier :: Lens' DescribeDBClusterSnapshots (Maybe Text)
describeDBClusterSnapshots_dbClusterSnapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBClusterSnapshots' {Maybe Text
dbClusterSnapshotIdentifier :: Maybe Text
$sel:dbClusterSnapshotIdentifier:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
dbClusterSnapshotIdentifier} -> Maybe Text
dbClusterSnapshotIdentifier) (\s :: DescribeDBClusterSnapshots
s@DescribeDBClusterSnapshots' {} Maybe Text
a -> DescribeDBClusterSnapshots
s {$sel:dbClusterSnapshotIdentifier:DescribeDBClusterSnapshots' :: Maybe Text
dbClusterSnapshotIdentifier = Maybe Text
a} :: DescribeDBClusterSnapshots)

-- | This parameter is not currently supported.
describeDBClusterSnapshots_filters :: Lens.Lens' DescribeDBClusterSnapshots (Prelude.Maybe [Filter])
describeDBClusterSnapshots_filters :: Lens' DescribeDBClusterSnapshots (Maybe [Filter])
describeDBClusterSnapshots_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBClusterSnapshots' {Maybe [Filter]
filters :: Maybe [Filter]
$sel:filters:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe [Filter]
filters} -> Maybe [Filter]
filters) (\s :: DescribeDBClusterSnapshots
s@DescribeDBClusterSnapshots' {} Maybe [Filter]
a -> DescribeDBClusterSnapshots
s {$sel:filters:DescribeDBClusterSnapshots' :: Maybe [Filter]
filters = Maybe [Filter]
a} :: DescribeDBClusterSnapshots) 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

-- | Set to @true@ to include manual cluster snapshots that are public and
-- can be copied or restored by any Amazon Web Services account, and
-- otherwise @false@. The default is @false@.
describeDBClusterSnapshots_includePublic :: Lens.Lens' DescribeDBClusterSnapshots (Prelude.Maybe Prelude.Bool)
describeDBClusterSnapshots_includePublic :: Lens' DescribeDBClusterSnapshots (Maybe Bool)
describeDBClusterSnapshots_includePublic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBClusterSnapshots' {Maybe Bool
includePublic :: Maybe Bool
$sel:includePublic:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Bool
includePublic} -> Maybe Bool
includePublic) (\s :: DescribeDBClusterSnapshots
s@DescribeDBClusterSnapshots' {} Maybe Bool
a -> DescribeDBClusterSnapshots
s {$sel:includePublic:DescribeDBClusterSnapshots' :: Maybe Bool
includePublic = Maybe Bool
a} :: DescribeDBClusterSnapshots)

-- | Set to @true@ to include shared manual cluster snapshots from other
-- Amazon Web Services accounts that this Amazon Web Services account has
-- been given permission to copy or restore, and otherwise @false@. The
-- default is @false@.
describeDBClusterSnapshots_includeShared :: Lens.Lens' DescribeDBClusterSnapshots (Prelude.Maybe Prelude.Bool)
describeDBClusterSnapshots_includeShared :: Lens' DescribeDBClusterSnapshots (Maybe Bool)
describeDBClusterSnapshots_includeShared = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBClusterSnapshots' {Maybe Bool
includeShared :: Maybe Bool
$sel:includeShared:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Bool
includeShared} -> Maybe Bool
includeShared) (\s :: DescribeDBClusterSnapshots
s@DescribeDBClusterSnapshots' {} Maybe Bool
a -> DescribeDBClusterSnapshots
s {$sel:includeShared:DescribeDBClusterSnapshots' :: Maybe Bool
includeShared = Maybe Bool
a} :: DescribeDBClusterSnapshots)

-- | An optional pagination token provided by a previous request. If this
-- parameter is specified, the response includes only records beyond the
-- marker, up to the value specified by @MaxRecords@.
describeDBClusterSnapshots_marker :: Lens.Lens' DescribeDBClusterSnapshots (Prelude.Maybe Prelude.Text)
describeDBClusterSnapshots_marker :: Lens' DescribeDBClusterSnapshots (Maybe Text)
describeDBClusterSnapshots_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBClusterSnapshots' {Maybe Text
marker :: Maybe Text
$sel:marker:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
marker} -> Maybe Text
marker) (\s :: DescribeDBClusterSnapshots
s@DescribeDBClusterSnapshots' {} Maybe Text
a -> DescribeDBClusterSnapshots
s {$sel:marker:DescribeDBClusterSnapshots' :: Maybe Text
marker = Maybe Text
a} :: DescribeDBClusterSnapshots)

-- | The maximum number of records to include in the response. If more
-- records exist than the specified @MaxRecords@ value, a pagination token
-- (marker) is included in the response so that the remaining results can
-- be retrieved.
--
-- Default: 100
--
-- Constraints: Minimum 20, maximum 100.
describeDBClusterSnapshots_maxRecords :: Lens.Lens' DescribeDBClusterSnapshots (Prelude.Maybe Prelude.Int)
describeDBClusterSnapshots_maxRecords :: Lens' DescribeDBClusterSnapshots (Maybe Int)
describeDBClusterSnapshots_maxRecords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBClusterSnapshots' {Maybe Int
maxRecords :: Maybe Int
$sel:maxRecords:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Int
maxRecords} -> Maybe Int
maxRecords) (\s :: DescribeDBClusterSnapshots
s@DescribeDBClusterSnapshots' {} Maybe Int
a -> DescribeDBClusterSnapshots
s {$sel:maxRecords:DescribeDBClusterSnapshots' :: Maybe Int
maxRecords = Maybe Int
a} :: DescribeDBClusterSnapshots)

-- | The type of cluster snapshots to be returned. You can specify one of the
-- following values:
--
-- -   @automated@ - Return all cluster snapshots that Amazon DocumentDB
--     has automatically created for your Amazon Web Services account.
--
-- -   @manual@ - Return all cluster snapshots that you have manually
--     created for your Amazon Web Services account.
--
-- -   @shared@ - Return all manual cluster snapshots that have been shared
--     to your Amazon Web Services account.
--
-- -   @public@ - Return all cluster snapshots that have been marked as
--     public.
--
-- If you don\'t specify a @SnapshotType@ value, then both automated and
-- manual cluster snapshots are returned. You can include shared cluster
-- snapshots with these results by setting the @IncludeShared@ parameter to
-- @true@. You can include public cluster snapshots with these results by
-- setting the@IncludePublic@ parameter to @true@.
--
-- The @IncludeShared@ and @IncludePublic@ parameters don\'t apply for
-- @SnapshotType@ values of @manual@ or @automated@. The @IncludePublic@
-- parameter doesn\'t apply when @SnapshotType@ is set to @shared@. The
-- @IncludeShared@ parameter doesn\'t apply when @SnapshotType@ is set to
-- @public@.
describeDBClusterSnapshots_snapshotType :: Lens.Lens' DescribeDBClusterSnapshots (Prelude.Maybe Prelude.Text)
describeDBClusterSnapshots_snapshotType :: Lens' DescribeDBClusterSnapshots (Maybe Text)
describeDBClusterSnapshots_snapshotType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBClusterSnapshots' {Maybe Text
snapshotType :: Maybe Text
$sel:snapshotType:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
snapshotType} -> Maybe Text
snapshotType) (\s :: DescribeDBClusterSnapshots
s@DescribeDBClusterSnapshots' {} Maybe Text
a -> DescribeDBClusterSnapshots
s {$sel:snapshotType:DescribeDBClusterSnapshots' :: Maybe Text
snapshotType = Maybe Text
a} :: DescribeDBClusterSnapshots)

instance Core.AWSPager DescribeDBClusterSnapshots where
  page :: DescribeDBClusterSnapshots
-> AWSResponse DescribeDBClusterSnapshots
-> Maybe DescribeDBClusterSnapshots
page DescribeDBClusterSnapshots
rq AWSResponse DescribeDBClusterSnapshots
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeDBClusterSnapshots
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeDBClusterSnapshotsResponse (Maybe Text)
describeDBClusterSnapshotsResponse_marker
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeDBClusterSnapshots
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  DescribeDBClusterSnapshotsResponse (Maybe [DBClusterSnapshot])
describeDBClusterSnapshotsResponse_dbClusterSnapshots
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ DescribeDBClusterSnapshots
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeDBClusterSnapshots (Maybe Text)
describeDBClusterSnapshots_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeDBClusterSnapshots
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeDBClusterSnapshotsResponse (Maybe Text)
describeDBClusterSnapshotsResponse_marker
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest DescribeDBClusterSnapshots where
  type
    AWSResponse DescribeDBClusterSnapshots =
      DescribeDBClusterSnapshotsResponse
  request :: (Service -> Service)
-> DescribeDBClusterSnapshots -> Request DescribeDBClusterSnapshots
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 DescribeDBClusterSnapshots
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeDBClusterSnapshots)))
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
"DescribeDBClusterSnapshotsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [DBClusterSnapshot]
-> Maybe Text -> Int -> DescribeDBClusterSnapshotsResponse
DescribeDBClusterSnapshotsResponse'
            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
"DBClusterSnapshots"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"DBClusterSnapshot")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Marker")
            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 DescribeDBClusterSnapshots where
  hashWithSalt :: Int -> DescribeDBClusterSnapshots -> Int
hashWithSalt Int
_salt DescribeDBClusterSnapshots' {Maybe Bool
Maybe Int
Maybe [Filter]
Maybe Text
snapshotType :: Maybe Text
maxRecords :: Maybe Int
marker :: Maybe Text
includeShared :: Maybe Bool
includePublic :: Maybe Bool
filters :: Maybe [Filter]
dbClusterSnapshotIdentifier :: Maybe Text
dbClusterIdentifier :: Maybe Text
$sel:snapshotType:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
$sel:maxRecords:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Int
$sel:marker:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
$sel:includeShared:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Bool
$sel:includePublic:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Bool
$sel:filters:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe [Filter]
$sel:dbClusterSnapshotIdentifier:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
$sel:dbClusterIdentifier:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbClusterIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbClusterSnapshotIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Filter]
filters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includePublic
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeShared
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxRecords
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotType

instance Prelude.NFData DescribeDBClusterSnapshots where
  rnf :: DescribeDBClusterSnapshots -> ()
rnf DescribeDBClusterSnapshots' {Maybe Bool
Maybe Int
Maybe [Filter]
Maybe Text
snapshotType :: Maybe Text
maxRecords :: Maybe Int
marker :: Maybe Text
includeShared :: Maybe Bool
includePublic :: Maybe Bool
filters :: Maybe [Filter]
dbClusterSnapshotIdentifier :: Maybe Text
dbClusterIdentifier :: Maybe Text
$sel:snapshotType:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
$sel:maxRecords:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Int
$sel:marker:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
$sel:includeShared:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Bool
$sel:includePublic:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Bool
$sel:filters:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe [Filter]
$sel:dbClusterSnapshotIdentifier:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
$sel:dbClusterIdentifier:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbClusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbClusterSnapshotIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Filter]
filters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includePublic
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeShared
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxRecords
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
snapshotType

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

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

instance Data.ToQuery DescribeDBClusterSnapshots where
  toQuery :: DescribeDBClusterSnapshots -> QueryString
toQuery DescribeDBClusterSnapshots' {Maybe Bool
Maybe Int
Maybe [Filter]
Maybe Text
snapshotType :: Maybe Text
maxRecords :: Maybe Int
marker :: Maybe Text
includeShared :: Maybe Bool
includePublic :: Maybe Bool
filters :: Maybe [Filter]
dbClusterSnapshotIdentifier :: Maybe Text
dbClusterIdentifier :: Maybe Text
$sel:snapshotType:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
$sel:maxRecords:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Int
$sel:marker:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
$sel:includeShared:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Bool
$sel:includePublic:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Bool
$sel:filters:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe [Filter]
$sel:dbClusterSnapshotIdentifier:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
$sel:dbClusterIdentifier:DescribeDBClusterSnapshots' :: DescribeDBClusterSnapshots -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DescribeDBClusterSnapshots" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"DBClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbClusterIdentifier,
        ByteString
"DBClusterSnapshotIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbClusterSnapshotIdentifier,
        ByteString
"Filters"
          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
"Filter" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Filter]
filters),
        ByteString
"IncludePublic" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
includePublic,
        ByteString
"IncludeShared" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
includeShared,
        ByteString
"Marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
marker,
        ByteString
"MaxRecords" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxRecords,
        ByteString
"SnapshotType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
snapshotType
      ]

-- | Represents the output of DescribeDBClusterSnapshots.
--
-- /See:/ 'newDescribeDBClusterSnapshotsResponse' smart constructor.
data DescribeDBClusterSnapshotsResponse = DescribeDBClusterSnapshotsResponse'
  { -- | Provides a list of cluster snapshots.
    DescribeDBClusterSnapshotsResponse -> Maybe [DBClusterSnapshot]
dbClusterSnapshots :: Prelude.Maybe [DBClusterSnapshot],
    -- | An optional pagination token provided by a previous request. If this
    -- parameter is specified, the response includes only records beyond the
    -- marker, up to the value specified by @MaxRecords@.
    DescribeDBClusterSnapshotsResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeDBClusterSnapshotsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeDBClusterSnapshotsResponse
-> DescribeDBClusterSnapshotsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDBClusterSnapshotsResponse
-> DescribeDBClusterSnapshotsResponse -> Bool
$c/= :: DescribeDBClusterSnapshotsResponse
-> DescribeDBClusterSnapshotsResponse -> Bool
== :: DescribeDBClusterSnapshotsResponse
-> DescribeDBClusterSnapshotsResponse -> Bool
$c== :: DescribeDBClusterSnapshotsResponse
-> DescribeDBClusterSnapshotsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeDBClusterSnapshotsResponse]
ReadPrec DescribeDBClusterSnapshotsResponse
Int -> ReadS DescribeDBClusterSnapshotsResponse
ReadS [DescribeDBClusterSnapshotsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDBClusterSnapshotsResponse]
$creadListPrec :: ReadPrec [DescribeDBClusterSnapshotsResponse]
readPrec :: ReadPrec DescribeDBClusterSnapshotsResponse
$creadPrec :: ReadPrec DescribeDBClusterSnapshotsResponse
readList :: ReadS [DescribeDBClusterSnapshotsResponse]
$creadList :: ReadS [DescribeDBClusterSnapshotsResponse]
readsPrec :: Int -> ReadS DescribeDBClusterSnapshotsResponse
$creadsPrec :: Int -> ReadS DescribeDBClusterSnapshotsResponse
Prelude.Read, Int -> DescribeDBClusterSnapshotsResponse -> ShowS
[DescribeDBClusterSnapshotsResponse] -> ShowS
DescribeDBClusterSnapshotsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDBClusterSnapshotsResponse] -> ShowS
$cshowList :: [DescribeDBClusterSnapshotsResponse] -> ShowS
show :: DescribeDBClusterSnapshotsResponse -> String
$cshow :: DescribeDBClusterSnapshotsResponse -> String
showsPrec :: Int -> DescribeDBClusterSnapshotsResponse -> ShowS
$cshowsPrec :: Int -> DescribeDBClusterSnapshotsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeDBClusterSnapshotsResponse x
-> DescribeDBClusterSnapshotsResponse
forall x.
DescribeDBClusterSnapshotsResponse
-> Rep DescribeDBClusterSnapshotsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDBClusterSnapshotsResponse x
-> DescribeDBClusterSnapshotsResponse
$cfrom :: forall x.
DescribeDBClusterSnapshotsResponse
-> Rep DescribeDBClusterSnapshotsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDBClusterSnapshotsResponse' 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:
--
-- 'dbClusterSnapshots', 'describeDBClusterSnapshotsResponse_dbClusterSnapshots' - Provides a list of cluster snapshots.
--
-- 'marker', 'describeDBClusterSnapshotsResponse_marker' - An optional pagination token provided by a previous request. If this
-- parameter is specified, the response includes only records beyond the
-- marker, up to the value specified by @MaxRecords@.
--
-- 'httpStatus', 'describeDBClusterSnapshotsResponse_httpStatus' - The response's http status code.
newDescribeDBClusterSnapshotsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeDBClusterSnapshotsResponse
newDescribeDBClusterSnapshotsResponse :: Int -> DescribeDBClusterSnapshotsResponse
newDescribeDBClusterSnapshotsResponse Int
pHttpStatus_ =
  DescribeDBClusterSnapshotsResponse'
    { $sel:dbClusterSnapshots:DescribeDBClusterSnapshotsResponse' :: Maybe [DBClusterSnapshot]
dbClusterSnapshots =
        forall a. Maybe a
Prelude.Nothing,
      $sel:marker:DescribeDBClusterSnapshotsResponse' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeDBClusterSnapshotsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Provides a list of cluster snapshots.
describeDBClusterSnapshotsResponse_dbClusterSnapshots :: Lens.Lens' DescribeDBClusterSnapshotsResponse (Prelude.Maybe [DBClusterSnapshot])
describeDBClusterSnapshotsResponse_dbClusterSnapshots :: Lens'
  DescribeDBClusterSnapshotsResponse (Maybe [DBClusterSnapshot])
describeDBClusterSnapshotsResponse_dbClusterSnapshots = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBClusterSnapshotsResponse' {Maybe [DBClusterSnapshot]
dbClusterSnapshots :: Maybe [DBClusterSnapshot]
$sel:dbClusterSnapshots:DescribeDBClusterSnapshotsResponse' :: DescribeDBClusterSnapshotsResponse -> Maybe [DBClusterSnapshot]
dbClusterSnapshots} -> Maybe [DBClusterSnapshot]
dbClusterSnapshots) (\s :: DescribeDBClusterSnapshotsResponse
s@DescribeDBClusterSnapshotsResponse' {} Maybe [DBClusterSnapshot]
a -> DescribeDBClusterSnapshotsResponse
s {$sel:dbClusterSnapshots:DescribeDBClusterSnapshotsResponse' :: Maybe [DBClusterSnapshot]
dbClusterSnapshots = Maybe [DBClusterSnapshot]
a} :: DescribeDBClusterSnapshotsResponse) 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

-- | An optional pagination token provided by a previous request. If this
-- parameter is specified, the response includes only records beyond the
-- marker, up to the value specified by @MaxRecords@.
describeDBClusterSnapshotsResponse_marker :: Lens.Lens' DescribeDBClusterSnapshotsResponse (Prelude.Maybe Prelude.Text)
describeDBClusterSnapshotsResponse_marker :: Lens' DescribeDBClusterSnapshotsResponse (Maybe Text)
describeDBClusterSnapshotsResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBClusterSnapshotsResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:DescribeDBClusterSnapshotsResponse' :: DescribeDBClusterSnapshotsResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: DescribeDBClusterSnapshotsResponse
s@DescribeDBClusterSnapshotsResponse' {} Maybe Text
a -> DescribeDBClusterSnapshotsResponse
s {$sel:marker:DescribeDBClusterSnapshotsResponse' :: Maybe Text
marker = Maybe Text
a} :: DescribeDBClusterSnapshotsResponse)

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

instance
  Prelude.NFData
    DescribeDBClusterSnapshotsResponse
  where
  rnf :: DescribeDBClusterSnapshotsResponse -> ()
rnf DescribeDBClusterSnapshotsResponse' {Int
Maybe [DBClusterSnapshot]
Maybe Text
httpStatus :: Int
marker :: Maybe Text
dbClusterSnapshots :: Maybe [DBClusterSnapshot]
$sel:httpStatus:DescribeDBClusterSnapshotsResponse' :: DescribeDBClusterSnapshotsResponse -> Int
$sel:marker:DescribeDBClusterSnapshotsResponse' :: DescribeDBClusterSnapshotsResponse -> Maybe Text
$sel:dbClusterSnapshots:DescribeDBClusterSnapshotsResponse' :: DescribeDBClusterSnapshotsResponse -> Maybe [DBClusterSnapshot]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DBClusterSnapshot]
dbClusterSnapshots
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus