{-# 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.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 DB cluster snapshots. This API action supports
-- pagination.
--
-- For more information on Amazon Aurora DB clusters, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/CHAP_AuroraOverview.html What is Amazon Aurora?>
-- in the /Amazon Aurora User Guide/.
--
-- For more information on Multi-AZ DB clusters, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/multi-az-db-clusters-concepts.html Multi-AZ deployments with two readable standby DB instances>
-- in the /Amazon RDS User Guide/.
--
-- This operation returns paginated results.
module Amazonka.RDS.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 qualified Amazonka.Prelude as Prelude
import Amazonka.RDS.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newDescribeDBClusterSnapshots' smart constructor.
data DescribeDBClusterSnapshots = DescribeDBClusterSnapshots'
  { -- | The ID of the DB cluster to retrieve the list of DB cluster snapshots
    -- for. This parameter can\'t be used in conjunction with the
    -- @DBClusterSnapshotIdentifier@ parameter. This parameter isn\'t
    -- case-sensitive.
    --
    -- Constraints:
    --
    -- -   If supplied, must match the identifier of an existing DBCluster.
    DescribeDBClusterSnapshots -> Maybe Text
dbClusterIdentifier :: Prelude.Maybe Prelude.Text,
    -- | A specific DB cluster snapshot identifier to describe. This parameter
    -- can\'t be used in conjunction with the @DBClusterIdentifier@ parameter.
    -- This value is stored as a lowercase string.
    --
    -- Constraints:
    --
    -- -   If supplied, 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,
    -- | A filter that specifies one or more DB cluster snapshots to describe.
    --
    -- Supported filters:
    --
    -- -   @db-cluster-id@ - Accepts DB cluster identifiers and DB cluster
    --     Amazon Resource Names (ARNs).
    --
    -- -   @db-cluster-snapshot-id@ - Accepts DB cluster snapshot identifiers.
    --
    -- -   @snapshot-type@ - Accepts types of DB cluster snapshots.
    --
    -- -   @engine@ - Accepts names of database engines.
    DescribeDBClusterSnapshots -> Maybe [Filter]
filters :: Prelude.Maybe [Filter],
    -- | A value that indicates whether to include manual DB cluster snapshots
    -- that are public and can be copied or restored by any Amazon Web Services
    -- account. By default, the public snapshots are not included.
    --
    -- You can share a manual DB cluster snapshot as public by using the
    -- ModifyDBClusterSnapshotAttribute API action.
    DescribeDBClusterSnapshots -> Maybe Bool
includePublic :: Prelude.Maybe Prelude.Bool,
    -- | A value that indicates whether to include shared manual DB cluster
    -- snapshots from other Amazon Web Services accounts that this Amazon Web
    -- Services account has been given permission to copy or restore. By
    -- default, these snapshots are not included.
    --
    -- You can give an Amazon Web Services account permission to restore a
    -- manual DB cluster snapshot from another Amazon Web Services account by
    -- the @ModifyDBClusterSnapshotAttribute@ API action.
    DescribeDBClusterSnapshots -> Maybe Bool
includeShared :: Prelude.Maybe Prelude.Bool,
    -- | An optional pagination token provided by a previous
    -- @DescribeDBClusterSnapshots@ 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
    -- called a marker is included in the response so you can retrieve the
    -- remaining results.
    --
    -- Default: 100
    --
    -- Constraints: Minimum 20, maximum 100.
    DescribeDBClusterSnapshots -> Maybe Int
maxRecords :: Prelude.Maybe Prelude.Int,
    -- | The type of DB cluster snapshots to be returned. You can specify one of
    -- the following values:
    --
    -- -   @automated@ - Return all DB cluster snapshots that have been
    --     automatically taken by Amazon RDS for my Amazon Web Services
    --     account.
    --
    -- -   @manual@ - Return all DB cluster snapshots that have been taken by
    --     my Amazon Web Services account.
    --
    -- -   @shared@ - Return all manual DB cluster snapshots that have been
    --     shared to my Amazon Web Services account.
    --
    -- -   @public@ - Return all DB cluster snapshots that have been marked as
    --     public.
    --
    -- If you don\'t specify a @SnapshotType@ value, then both automated and
    -- manual DB cluster snapshots are returned. You can include shared DB
    -- cluster snapshots with these results by enabling the @IncludeShared@
    -- parameter. You can include public DB cluster snapshots with these
    -- results by enabling the @IncludePublic@ parameter.
    --
    -- 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 DB cluster to retrieve the list of DB cluster snapshots
-- for. This parameter can\'t be used in conjunction with the
-- @DBClusterSnapshotIdentifier@ parameter. This parameter isn\'t
-- case-sensitive.
--
-- Constraints:
--
-- -   If supplied, must match the identifier of an existing DBCluster.
--
-- 'dbClusterSnapshotIdentifier', 'describeDBClusterSnapshots_dbClusterSnapshotIdentifier' - A specific DB cluster snapshot identifier to describe. This parameter
-- can\'t be used in conjunction with the @DBClusterIdentifier@ parameter.
-- This value is stored as a lowercase string.
--
-- Constraints:
--
-- -   If supplied, 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' - A filter that specifies one or more DB cluster snapshots to describe.
--
-- Supported filters:
--
-- -   @db-cluster-id@ - Accepts DB cluster identifiers and DB cluster
--     Amazon Resource Names (ARNs).
--
-- -   @db-cluster-snapshot-id@ - Accepts DB cluster snapshot identifiers.
--
-- -   @snapshot-type@ - Accepts types of DB cluster snapshots.
--
-- -   @engine@ - Accepts names of database engines.
--
-- 'includePublic', 'describeDBClusterSnapshots_includePublic' - A value that indicates whether to include manual DB cluster snapshots
-- that are public and can be copied or restored by any Amazon Web Services
-- account. By default, the public snapshots are not included.
--
-- You can share a manual DB cluster snapshot as public by using the
-- ModifyDBClusterSnapshotAttribute API action.
--
-- 'includeShared', 'describeDBClusterSnapshots_includeShared' - A value that indicates whether to include shared manual DB cluster
-- snapshots from other Amazon Web Services accounts that this Amazon Web
-- Services account has been given permission to copy or restore. By
-- default, these snapshots are not included.
--
-- You can give an Amazon Web Services account permission to restore a
-- manual DB cluster snapshot from another Amazon Web Services account by
-- the @ModifyDBClusterSnapshotAttribute@ API action.
--
-- 'marker', 'describeDBClusterSnapshots_marker' - An optional pagination token provided by a previous
-- @DescribeDBClusterSnapshots@ 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
-- called a marker is included in the response so you can retrieve the
-- remaining results.
--
-- Default: 100
--
-- Constraints: Minimum 20, maximum 100.
--
-- 'snapshotType', 'describeDBClusterSnapshots_snapshotType' - The type of DB cluster snapshots to be returned. You can specify one of
-- the following values:
--
-- -   @automated@ - Return all DB cluster snapshots that have been
--     automatically taken by Amazon RDS for my Amazon Web Services
--     account.
--
-- -   @manual@ - Return all DB cluster snapshots that have been taken by
--     my Amazon Web Services account.
--
-- -   @shared@ - Return all manual DB cluster snapshots that have been
--     shared to my Amazon Web Services account.
--
-- -   @public@ - Return all DB cluster snapshots that have been marked as
--     public.
--
-- If you don\'t specify a @SnapshotType@ value, then both automated and
-- manual DB cluster snapshots are returned. You can include shared DB
-- cluster snapshots with these results by enabling the @IncludeShared@
-- parameter. You can include public DB cluster snapshots with these
-- results by enabling the @IncludePublic@ parameter.
--
-- 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 DB cluster to retrieve the list of DB cluster snapshots
-- for. This parameter can\'t be used in conjunction with the
-- @DBClusterSnapshotIdentifier@ parameter. This parameter isn\'t
-- case-sensitive.
--
-- Constraints:
--
-- -   If supplied, 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 DB cluster snapshot identifier to describe. This parameter
-- can\'t be used in conjunction with the @DBClusterIdentifier@ parameter.
-- This value is stored as a lowercase string.
--
-- Constraints:
--
-- -   If supplied, 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)

-- | A filter that specifies one or more DB cluster snapshots to describe.
--
-- Supported filters:
--
-- -   @db-cluster-id@ - Accepts DB cluster identifiers and DB cluster
--     Amazon Resource Names (ARNs).
--
-- -   @db-cluster-snapshot-id@ - Accepts DB cluster snapshot identifiers.
--
-- -   @snapshot-type@ - Accepts types of DB cluster snapshots.
--
-- -   @engine@ - Accepts names of database engines.
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

-- | A value that indicates whether to include manual DB cluster snapshots
-- that are public and can be copied or restored by any Amazon Web Services
-- account. By default, the public snapshots are not included.
--
-- You can share a manual DB cluster snapshot as public by using the
-- ModifyDBClusterSnapshotAttribute API action.
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)

-- | A value that indicates whether to include shared manual DB cluster
-- snapshots from other Amazon Web Services accounts that this Amazon Web
-- Services account has been given permission to copy or restore. By
-- default, these snapshots are not included.
--
-- You can give an Amazon Web Services account permission to restore a
-- manual DB cluster snapshot from another Amazon Web Services account by
-- the @ModifyDBClusterSnapshotAttribute@ API action.
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
-- @DescribeDBClusterSnapshots@ 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
-- called a marker is included in the response so you can retrieve the
-- remaining results.
--
-- 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 DB cluster snapshots to be returned. You can specify one of
-- the following values:
--
-- -   @automated@ - Return all DB cluster snapshots that have been
--     automatically taken by Amazon RDS for my Amazon Web Services
--     account.
--
-- -   @manual@ - Return all DB cluster snapshots that have been taken by
--     my Amazon Web Services account.
--
-- -   @shared@ - Return all manual DB cluster snapshots that have been
--     shared to my Amazon Web Services account.
--
-- -   @public@ - Return all DB cluster snapshots that have been marked as
--     public.
--
-- If you don\'t specify a @SnapshotType@ value, then both automated and
-- manual DB cluster snapshots are returned. You can include shared DB
-- cluster snapshots with these results by enabling the @IncludeShared@
-- parameter. You can include public DB cluster snapshots with these
-- results by enabling the @IncludePublic@ parameter.
--
-- 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
      ]

-- | Provides a list of DB cluster snapshots for the user as the result of a
-- call to the @DescribeDBClusterSnapshots@ action.
--
-- /See:/ 'newDescribeDBClusterSnapshotsResponse' smart constructor.
data DescribeDBClusterSnapshotsResponse = DescribeDBClusterSnapshotsResponse'
  { -- | Provides a list of DB cluster snapshots for the user.
    DescribeDBClusterSnapshotsResponse -> Maybe [DBClusterSnapshot]
dbClusterSnapshots :: Prelude.Maybe [DBClusterSnapshot],
    -- | An optional pagination token provided by a previous
    -- @DescribeDBClusterSnapshots@ 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 DB cluster snapshots for the user.
--
-- 'marker', 'describeDBClusterSnapshotsResponse_marker' - An optional pagination token provided by a previous
-- @DescribeDBClusterSnapshots@ 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 DB cluster snapshots for the user.
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
-- @DescribeDBClusterSnapshots@ 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