{-# 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.DescribeDBSnapshots
-- 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 snapshots. This API action supports
-- pagination.
--
-- This operation returns paginated results.
module Amazonka.RDS.DescribeDBSnapshots
  ( -- * Creating a Request
    DescribeDBSnapshots (..),
    newDescribeDBSnapshots,

    -- * Request Lenses
    describeDBSnapshots_dbInstanceIdentifier,
    describeDBSnapshots_dbSnapshotIdentifier,
    describeDBSnapshots_dbiResourceId,
    describeDBSnapshots_filters,
    describeDBSnapshots_includePublic,
    describeDBSnapshots_includeShared,
    describeDBSnapshots_marker,
    describeDBSnapshots_maxRecords,
    describeDBSnapshots_snapshotType,

    -- * Destructuring the Response
    DescribeDBSnapshotsResponse (..),
    newDescribeDBSnapshotsResponse,

    -- * Response Lenses
    describeDBSnapshotsResponse_dbSnapshots,
    describeDBSnapshotsResponse_marker,
    describeDBSnapshotsResponse_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:/ 'newDescribeDBSnapshots' smart constructor.
data DescribeDBSnapshots = DescribeDBSnapshots'
  { -- | The ID of the DB instance to retrieve the list of DB snapshots for. This
    -- parameter isn\'t case-sensitive.
    --
    -- Constraints:
    --
    -- -   If supplied, must match the identifier of an existing DBInstance.
    DescribeDBSnapshots -> Maybe Text
dbInstanceIdentifier :: Prelude.Maybe Prelude.Text,
    -- | A specific DB snapshot identifier to describe. This value is stored as a
    -- lowercase string.
    --
    -- Constraints:
    --
    -- -   If supplied, must match the identifier of an existing DBSnapshot.
    --
    -- -   If this identifier is for an automated snapshot, the @SnapshotType@
    --     parameter must also be specified.
    DescribeDBSnapshots -> Maybe Text
dbSnapshotIdentifier :: Prelude.Maybe Prelude.Text,
    -- | A specific DB resource ID to describe.
    DescribeDBSnapshots -> Maybe Text
dbiResourceId :: Prelude.Maybe Prelude.Text,
    -- | A filter that specifies one or more DB snapshots to describe.
    --
    -- Supported filters:
    --
    -- -   @db-instance-id@ - Accepts DB instance identifiers and DB instance
    --     Amazon Resource Names (ARNs).
    --
    -- -   @db-snapshot-id@ - Accepts DB snapshot identifiers.
    --
    -- -   @dbi-resource-id@ - Accepts identifiers of source DB instances.
    --
    -- -   @snapshot-type@ - Accepts types of DB snapshots.
    --
    -- -   @engine@ - Accepts names of database engines.
    DescribeDBSnapshots -> 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 snapshot as public by using the
    -- ModifyDBSnapshotAttribute API.
    --
    -- This setting doesn\'t apply to RDS Custom.
    DescribeDBSnapshots -> 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 snapshot from another Amazon Web Services account by using the
    -- @ModifyDBSnapshotAttribute@ API action.
    --
    -- This setting doesn\'t apply to RDS Custom.
    DescribeDBSnapshots -> Maybe Bool
includeShared :: Prelude.Maybe Prelude.Bool,
    -- | An optional pagination token provided by a previous
    -- @DescribeDBSnapshots@ request. If this parameter is specified, the
    -- response includes only records beyond the marker, up to the value
    -- specified by @MaxRecords@.
    DescribeDBSnapshots -> 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 that you can retrieve the
    -- remaining results.
    --
    -- Default: 100
    --
    -- Constraints: Minimum 20, maximum 100.
    DescribeDBSnapshots -> Maybe Int
maxRecords :: Prelude.Maybe Prelude.Int,
    -- | The type of snapshots to be returned. You can specify one of the
    -- following values:
    --
    -- -   @automated@ - Return all DB snapshots that have been automatically
    --     taken by Amazon RDS for my Amazon Web Services account.
    --
    -- -   @manual@ - Return all DB snapshots that have been taken by my Amazon
    --     Web Services account.
    --
    -- -   @shared@ - Return all manual DB snapshots that have been shared to
    --     my Amazon Web Services account.
    --
    -- -   @public@ - Return all DB snapshots that have been marked as public.
    --
    -- -   @awsbackup@ - Return the DB snapshots managed by the Amazon Web
    --     Services Backup service.
    --
    --     For information about Amazon Web Services Backup, see the
    --     <https://docs.aws.amazon.com/aws-backup/latest/devguide/whatisbackup.html Amazon Web Services Backup Developer Guide.>
    --
    --     The @awsbackup@ type does not apply to Aurora.
    --
    -- If you don\'t specify a @SnapshotType@ value, then both automated and
    -- manual snapshots are returned. Shared and public DB snapshots are not
    -- included in the returned results by default. You can include shared
    -- snapshots with these results by enabling the @IncludeShared@ parameter.
    -- You can include public 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@.
    DescribeDBSnapshots -> Maybe Text
snapshotType :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeDBSnapshots -> DescribeDBSnapshots -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDBSnapshots -> DescribeDBSnapshots -> Bool
$c/= :: DescribeDBSnapshots -> DescribeDBSnapshots -> Bool
== :: DescribeDBSnapshots -> DescribeDBSnapshots -> Bool
$c== :: DescribeDBSnapshots -> DescribeDBSnapshots -> Bool
Prelude.Eq, ReadPrec [DescribeDBSnapshots]
ReadPrec DescribeDBSnapshots
Int -> ReadS DescribeDBSnapshots
ReadS [DescribeDBSnapshots]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDBSnapshots]
$creadListPrec :: ReadPrec [DescribeDBSnapshots]
readPrec :: ReadPrec DescribeDBSnapshots
$creadPrec :: ReadPrec DescribeDBSnapshots
readList :: ReadS [DescribeDBSnapshots]
$creadList :: ReadS [DescribeDBSnapshots]
readsPrec :: Int -> ReadS DescribeDBSnapshots
$creadsPrec :: Int -> ReadS DescribeDBSnapshots
Prelude.Read, Int -> DescribeDBSnapshots -> ShowS
[DescribeDBSnapshots] -> ShowS
DescribeDBSnapshots -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDBSnapshots] -> ShowS
$cshowList :: [DescribeDBSnapshots] -> ShowS
show :: DescribeDBSnapshots -> String
$cshow :: DescribeDBSnapshots -> String
showsPrec :: Int -> DescribeDBSnapshots -> ShowS
$cshowsPrec :: Int -> DescribeDBSnapshots -> ShowS
Prelude.Show, forall x. Rep DescribeDBSnapshots x -> DescribeDBSnapshots
forall x. DescribeDBSnapshots -> Rep DescribeDBSnapshots x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeDBSnapshots x -> DescribeDBSnapshots
$cfrom :: forall x. DescribeDBSnapshots -> Rep DescribeDBSnapshots x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDBSnapshots' 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:
--
-- 'dbInstanceIdentifier', 'describeDBSnapshots_dbInstanceIdentifier' - The ID of the DB instance to retrieve the list of DB snapshots for. This
-- parameter isn\'t case-sensitive.
--
-- Constraints:
--
-- -   If supplied, must match the identifier of an existing DBInstance.
--
-- 'dbSnapshotIdentifier', 'describeDBSnapshots_dbSnapshotIdentifier' - A specific DB snapshot identifier to describe. This value is stored as a
-- lowercase string.
--
-- Constraints:
--
-- -   If supplied, must match the identifier of an existing DBSnapshot.
--
-- -   If this identifier is for an automated snapshot, the @SnapshotType@
--     parameter must also be specified.
--
-- 'dbiResourceId', 'describeDBSnapshots_dbiResourceId' - A specific DB resource ID to describe.
--
-- 'filters', 'describeDBSnapshots_filters' - A filter that specifies one or more DB snapshots to describe.
--
-- Supported filters:
--
-- -   @db-instance-id@ - Accepts DB instance identifiers and DB instance
--     Amazon Resource Names (ARNs).
--
-- -   @db-snapshot-id@ - Accepts DB snapshot identifiers.
--
-- -   @dbi-resource-id@ - Accepts identifiers of source DB instances.
--
-- -   @snapshot-type@ - Accepts types of DB snapshots.
--
-- -   @engine@ - Accepts names of database engines.
--
-- 'includePublic', 'describeDBSnapshots_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 snapshot as public by using the
-- ModifyDBSnapshotAttribute API.
--
-- This setting doesn\'t apply to RDS Custom.
--
-- 'includeShared', 'describeDBSnapshots_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 snapshot from another Amazon Web Services account by using the
-- @ModifyDBSnapshotAttribute@ API action.
--
-- This setting doesn\'t apply to RDS Custom.
--
-- 'marker', 'describeDBSnapshots_marker' - An optional pagination token provided by a previous
-- @DescribeDBSnapshots@ request. If this parameter is specified, the
-- response includes only records beyond the marker, up to the value
-- specified by @MaxRecords@.
--
-- 'maxRecords', 'describeDBSnapshots_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 that you can retrieve the
-- remaining results.
--
-- Default: 100
--
-- Constraints: Minimum 20, maximum 100.
--
-- 'snapshotType', 'describeDBSnapshots_snapshotType' - The type of snapshots to be returned. You can specify one of the
-- following values:
--
-- -   @automated@ - Return all DB snapshots that have been automatically
--     taken by Amazon RDS for my Amazon Web Services account.
--
-- -   @manual@ - Return all DB snapshots that have been taken by my Amazon
--     Web Services account.
--
-- -   @shared@ - Return all manual DB snapshots that have been shared to
--     my Amazon Web Services account.
--
-- -   @public@ - Return all DB snapshots that have been marked as public.
--
-- -   @awsbackup@ - Return the DB snapshots managed by the Amazon Web
--     Services Backup service.
--
--     For information about Amazon Web Services Backup, see the
--     <https://docs.aws.amazon.com/aws-backup/latest/devguide/whatisbackup.html Amazon Web Services Backup Developer Guide.>
--
--     The @awsbackup@ type does not apply to Aurora.
--
-- If you don\'t specify a @SnapshotType@ value, then both automated and
-- manual snapshots are returned. Shared and public DB snapshots are not
-- included in the returned results by default. You can include shared
-- snapshots with these results by enabling the @IncludeShared@ parameter.
-- You can include public 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@.
newDescribeDBSnapshots ::
  DescribeDBSnapshots
newDescribeDBSnapshots :: DescribeDBSnapshots
newDescribeDBSnapshots =
  DescribeDBSnapshots'
    { $sel:dbInstanceIdentifier:DescribeDBSnapshots' :: Maybe Text
dbInstanceIdentifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dbSnapshotIdentifier:DescribeDBSnapshots' :: Maybe Text
dbSnapshotIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:dbiResourceId:DescribeDBSnapshots' :: Maybe Text
dbiResourceId = forall a. Maybe a
Prelude.Nothing,
      $sel:filters:DescribeDBSnapshots' :: Maybe [Filter]
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:includePublic:DescribeDBSnapshots' :: Maybe Bool
includePublic = forall a. Maybe a
Prelude.Nothing,
      $sel:includeShared:DescribeDBSnapshots' :: Maybe Bool
includeShared = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:DescribeDBSnapshots' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxRecords:DescribeDBSnapshots' :: Maybe Int
maxRecords = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotType:DescribeDBSnapshots' :: Maybe Text
snapshotType = forall a. Maybe a
Prelude.Nothing
    }

-- | The ID of the DB instance to retrieve the list of DB snapshots for. This
-- parameter isn\'t case-sensitive.
--
-- Constraints:
--
-- -   If supplied, must match the identifier of an existing DBInstance.
describeDBSnapshots_dbInstanceIdentifier :: Lens.Lens' DescribeDBSnapshots (Prelude.Maybe Prelude.Text)
describeDBSnapshots_dbInstanceIdentifier :: Lens' DescribeDBSnapshots (Maybe Text)
describeDBSnapshots_dbInstanceIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBSnapshots' {Maybe Text
dbInstanceIdentifier :: Maybe Text
$sel:dbInstanceIdentifier:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
dbInstanceIdentifier} -> Maybe Text
dbInstanceIdentifier) (\s :: DescribeDBSnapshots
s@DescribeDBSnapshots' {} Maybe Text
a -> DescribeDBSnapshots
s {$sel:dbInstanceIdentifier:DescribeDBSnapshots' :: Maybe Text
dbInstanceIdentifier = Maybe Text
a} :: DescribeDBSnapshots)

-- | A specific DB snapshot identifier to describe. This value is stored as a
-- lowercase string.
--
-- Constraints:
--
-- -   If supplied, must match the identifier of an existing DBSnapshot.
--
-- -   If this identifier is for an automated snapshot, the @SnapshotType@
--     parameter must also be specified.
describeDBSnapshots_dbSnapshotIdentifier :: Lens.Lens' DescribeDBSnapshots (Prelude.Maybe Prelude.Text)
describeDBSnapshots_dbSnapshotIdentifier :: Lens' DescribeDBSnapshots (Maybe Text)
describeDBSnapshots_dbSnapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBSnapshots' {Maybe Text
dbSnapshotIdentifier :: Maybe Text
$sel:dbSnapshotIdentifier:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
dbSnapshotIdentifier} -> Maybe Text
dbSnapshotIdentifier) (\s :: DescribeDBSnapshots
s@DescribeDBSnapshots' {} Maybe Text
a -> DescribeDBSnapshots
s {$sel:dbSnapshotIdentifier:DescribeDBSnapshots' :: Maybe Text
dbSnapshotIdentifier = Maybe Text
a} :: DescribeDBSnapshots)

-- | A specific DB resource ID to describe.
describeDBSnapshots_dbiResourceId :: Lens.Lens' DescribeDBSnapshots (Prelude.Maybe Prelude.Text)
describeDBSnapshots_dbiResourceId :: Lens' DescribeDBSnapshots (Maybe Text)
describeDBSnapshots_dbiResourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBSnapshots' {Maybe Text
dbiResourceId :: Maybe Text
$sel:dbiResourceId:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
dbiResourceId} -> Maybe Text
dbiResourceId) (\s :: DescribeDBSnapshots
s@DescribeDBSnapshots' {} Maybe Text
a -> DescribeDBSnapshots
s {$sel:dbiResourceId:DescribeDBSnapshots' :: Maybe Text
dbiResourceId = Maybe Text
a} :: DescribeDBSnapshots)

-- | A filter that specifies one or more DB snapshots to describe.
--
-- Supported filters:
--
-- -   @db-instance-id@ - Accepts DB instance identifiers and DB instance
--     Amazon Resource Names (ARNs).
--
-- -   @db-snapshot-id@ - Accepts DB snapshot identifiers.
--
-- -   @dbi-resource-id@ - Accepts identifiers of source DB instances.
--
-- -   @snapshot-type@ - Accepts types of DB snapshots.
--
-- -   @engine@ - Accepts names of database engines.
describeDBSnapshots_filters :: Lens.Lens' DescribeDBSnapshots (Prelude.Maybe [Filter])
describeDBSnapshots_filters :: Lens' DescribeDBSnapshots (Maybe [Filter])
describeDBSnapshots_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBSnapshots' {Maybe [Filter]
filters :: Maybe [Filter]
$sel:filters:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe [Filter]
filters} -> Maybe [Filter]
filters) (\s :: DescribeDBSnapshots
s@DescribeDBSnapshots' {} Maybe [Filter]
a -> DescribeDBSnapshots
s {$sel:filters:DescribeDBSnapshots' :: Maybe [Filter]
filters = Maybe [Filter]
a} :: DescribeDBSnapshots) 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 snapshot as public by using the
-- ModifyDBSnapshotAttribute API.
--
-- This setting doesn\'t apply to RDS Custom.
describeDBSnapshots_includePublic :: Lens.Lens' DescribeDBSnapshots (Prelude.Maybe Prelude.Bool)
describeDBSnapshots_includePublic :: Lens' DescribeDBSnapshots (Maybe Bool)
describeDBSnapshots_includePublic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBSnapshots' {Maybe Bool
includePublic :: Maybe Bool
$sel:includePublic:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Bool
includePublic} -> Maybe Bool
includePublic) (\s :: DescribeDBSnapshots
s@DescribeDBSnapshots' {} Maybe Bool
a -> DescribeDBSnapshots
s {$sel:includePublic:DescribeDBSnapshots' :: Maybe Bool
includePublic = Maybe Bool
a} :: DescribeDBSnapshots)

-- | 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 snapshot from another Amazon Web Services account by using the
-- @ModifyDBSnapshotAttribute@ API action.
--
-- This setting doesn\'t apply to RDS Custom.
describeDBSnapshots_includeShared :: Lens.Lens' DescribeDBSnapshots (Prelude.Maybe Prelude.Bool)
describeDBSnapshots_includeShared :: Lens' DescribeDBSnapshots (Maybe Bool)
describeDBSnapshots_includeShared = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBSnapshots' {Maybe Bool
includeShared :: Maybe Bool
$sel:includeShared:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Bool
includeShared} -> Maybe Bool
includeShared) (\s :: DescribeDBSnapshots
s@DescribeDBSnapshots' {} Maybe Bool
a -> DescribeDBSnapshots
s {$sel:includeShared:DescribeDBSnapshots' :: Maybe Bool
includeShared = Maybe Bool
a} :: DescribeDBSnapshots)

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

-- | 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 that you can retrieve the
-- remaining results.
--
-- Default: 100
--
-- Constraints: Minimum 20, maximum 100.
describeDBSnapshots_maxRecords :: Lens.Lens' DescribeDBSnapshots (Prelude.Maybe Prelude.Int)
describeDBSnapshots_maxRecords :: Lens' DescribeDBSnapshots (Maybe Int)
describeDBSnapshots_maxRecords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBSnapshots' {Maybe Int
maxRecords :: Maybe Int
$sel:maxRecords:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Int
maxRecords} -> Maybe Int
maxRecords) (\s :: DescribeDBSnapshots
s@DescribeDBSnapshots' {} Maybe Int
a -> DescribeDBSnapshots
s {$sel:maxRecords:DescribeDBSnapshots' :: Maybe Int
maxRecords = Maybe Int
a} :: DescribeDBSnapshots)

-- | The type of snapshots to be returned. You can specify one of the
-- following values:
--
-- -   @automated@ - Return all DB snapshots that have been automatically
--     taken by Amazon RDS for my Amazon Web Services account.
--
-- -   @manual@ - Return all DB snapshots that have been taken by my Amazon
--     Web Services account.
--
-- -   @shared@ - Return all manual DB snapshots that have been shared to
--     my Amazon Web Services account.
--
-- -   @public@ - Return all DB snapshots that have been marked as public.
--
-- -   @awsbackup@ - Return the DB snapshots managed by the Amazon Web
--     Services Backup service.
--
--     For information about Amazon Web Services Backup, see the
--     <https://docs.aws.amazon.com/aws-backup/latest/devguide/whatisbackup.html Amazon Web Services Backup Developer Guide.>
--
--     The @awsbackup@ type does not apply to Aurora.
--
-- If you don\'t specify a @SnapshotType@ value, then both automated and
-- manual snapshots are returned. Shared and public DB snapshots are not
-- included in the returned results by default. You can include shared
-- snapshots with these results by enabling the @IncludeShared@ parameter.
-- You can include public 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@.
describeDBSnapshots_snapshotType :: Lens.Lens' DescribeDBSnapshots (Prelude.Maybe Prelude.Text)
describeDBSnapshots_snapshotType :: Lens' DescribeDBSnapshots (Maybe Text)
describeDBSnapshots_snapshotType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBSnapshots' {Maybe Text
snapshotType :: Maybe Text
$sel:snapshotType:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
snapshotType} -> Maybe Text
snapshotType) (\s :: DescribeDBSnapshots
s@DescribeDBSnapshots' {} Maybe Text
a -> DescribeDBSnapshots
s {$sel:snapshotType:DescribeDBSnapshots' :: Maybe Text
snapshotType = Maybe Text
a} :: DescribeDBSnapshots)

instance Core.AWSPager DescribeDBSnapshots where
  page :: DescribeDBSnapshots
-> AWSResponse DescribeDBSnapshots -> Maybe DescribeDBSnapshots
page DescribeDBSnapshots
rq AWSResponse DescribeDBSnapshots
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeDBSnapshots
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeDBSnapshotsResponse (Maybe Text)
describeDBSnapshotsResponse_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 DescribeDBSnapshots
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeDBSnapshotsResponse (Maybe [DBSnapshot])
describeDBSnapshotsResponse_dbSnapshots
            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.$ DescribeDBSnapshots
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeDBSnapshots (Maybe Text)
describeDBSnapshots_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeDBSnapshots
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeDBSnapshotsResponse (Maybe Text)
describeDBSnapshotsResponse_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 DescribeDBSnapshots where
  type
    AWSResponse DescribeDBSnapshots =
      DescribeDBSnapshotsResponse
  request :: (Service -> Service)
-> DescribeDBSnapshots -> Request DescribeDBSnapshots
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 DescribeDBSnapshots
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeDBSnapshots)))
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
"DescribeDBSnapshotsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [DBSnapshot]
-> Maybe Text -> Int -> DescribeDBSnapshotsResponse
DescribeDBSnapshotsResponse'
            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
"DBSnapshots"
                            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
"DBSnapshot")
                        )
            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 DescribeDBSnapshots where
  hashWithSalt :: Int -> DescribeDBSnapshots -> Int
hashWithSalt Int
_salt DescribeDBSnapshots' {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]
dbiResourceId :: Maybe Text
dbSnapshotIdentifier :: Maybe Text
dbInstanceIdentifier :: Maybe Text
$sel:snapshotType:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
$sel:maxRecords:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Int
$sel:marker:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
$sel:includeShared:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Bool
$sel:includePublic:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Bool
$sel:filters:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe [Filter]
$sel:dbiResourceId:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
$sel:dbSnapshotIdentifier:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
$sel:dbInstanceIdentifier:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbInstanceIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbSnapshotIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbiResourceId
      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 DescribeDBSnapshots where
  rnf :: DescribeDBSnapshots -> ()
rnf DescribeDBSnapshots' {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]
dbiResourceId :: Maybe Text
dbSnapshotIdentifier :: Maybe Text
dbInstanceIdentifier :: Maybe Text
$sel:snapshotType:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
$sel:maxRecords:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Int
$sel:marker:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
$sel:includeShared:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Bool
$sel:includePublic:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Bool
$sel:filters:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe [Filter]
$sel:dbiResourceId:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
$sel:dbSnapshotIdentifier:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
$sel:dbInstanceIdentifier:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbInstanceIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbSnapshotIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbiResourceId
      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 DescribeDBSnapshots where
  toHeaders :: DescribeDBSnapshots -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DescribeDBSnapshots where
  toQuery :: DescribeDBSnapshots -> QueryString
toQuery DescribeDBSnapshots' {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]
dbiResourceId :: Maybe Text
dbSnapshotIdentifier :: Maybe Text
dbInstanceIdentifier :: Maybe Text
$sel:snapshotType:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
$sel:maxRecords:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Int
$sel:marker:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
$sel:includeShared:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Bool
$sel:includePublic:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Bool
$sel:filters:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe [Filter]
$sel:dbiResourceId:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
$sel:dbSnapshotIdentifier:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
$sel:dbInstanceIdentifier:DescribeDBSnapshots' :: DescribeDBSnapshots -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DescribeDBSnapshots" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"DBInstanceIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbInstanceIdentifier,
        ByteString
"DBSnapshotIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbSnapshotIdentifier,
        ByteString
"DbiResourceId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbiResourceId,
        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
      ]

-- | Contains the result of a successful invocation of the
-- @DescribeDBSnapshots@ action.
--
-- /See:/ 'newDescribeDBSnapshotsResponse' smart constructor.
data DescribeDBSnapshotsResponse = DescribeDBSnapshotsResponse'
  { -- | A list of @DBSnapshot@ instances.
    DescribeDBSnapshotsResponse -> Maybe [DBSnapshot]
dbSnapshots :: Prelude.Maybe [DBSnapshot],
    -- | 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@.
    DescribeDBSnapshotsResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeDBSnapshotsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeDBSnapshotsResponse -> DescribeDBSnapshotsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDBSnapshotsResponse -> DescribeDBSnapshotsResponse -> Bool
$c/= :: DescribeDBSnapshotsResponse -> DescribeDBSnapshotsResponse -> Bool
== :: DescribeDBSnapshotsResponse -> DescribeDBSnapshotsResponse -> Bool
$c== :: DescribeDBSnapshotsResponse -> DescribeDBSnapshotsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeDBSnapshotsResponse]
ReadPrec DescribeDBSnapshotsResponse
Int -> ReadS DescribeDBSnapshotsResponse
ReadS [DescribeDBSnapshotsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDBSnapshotsResponse]
$creadListPrec :: ReadPrec [DescribeDBSnapshotsResponse]
readPrec :: ReadPrec DescribeDBSnapshotsResponse
$creadPrec :: ReadPrec DescribeDBSnapshotsResponse
readList :: ReadS [DescribeDBSnapshotsResponse]
$creadList :: ReadS [DescribeDBSnapshotsResponse]
readsPrec :: Int -> ReadS DescribeDBSnapshotsResponse
$creadsPrec :: Int -> ReadS DescribeDBSnapshotsResponse
Prelude.Read, Int -> DescribeDBSnapshotsResponse -> ShowS
[DescribeDBSnapshotsResponse] -> ShowS
DescribeDBSnapshotsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDBSnapshotsResponse] -> ShowS
$cshowList :: [DescribeDBSnapshotsResponse] -> ShowS
show :: DescribeDBSnapshotsResponse -> String
$cshow :: DescribeDBSnapshotsResponse -> String
showsPrec :: Int -> DescribeDBSnapshotsResponse -> ShowS
$cshowsPrec :: Int -> DescribeDBSnapshotsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeDBSnapshotsResponse x -> DescribeDBSnapshotsResponse
forall x.
DescribeDBSnapshotsResponse -> Rep DescribeDBSnapshotsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDBSnapshotsResponse x -> DescribeDBSnapshotsResponse
$cfrom :: forall x.
DescribeDBSnapshotsResponse -> Rep DescribeDBSnapshotsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDBSnapshotsResponse' 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:
--
-- 'dbSnapshots', 'describeDBSnapshotsResponse_dbSnapshots' - A list of @DBSnapshot@ instances.
--
-- 'marker', 'describeDBSnapshotsResponse_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', 'describeDBSnapshotsResponse_httpStatus' - The response's http status code.
newDescribeDBSnapshotsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeDBSnapshotsResponse
newDescribeDBSnapshotsResponse :: Int -> DescribeDBSnapshotsResponse
newDescribeDBSnapshotsResponse Int
pHttpStatus_ =
  DescribeDBSnapshotsResponse'
    { $sel:dbSnapshots:DescribeDBSnapshotsResponse' :: Maybe [DBSnapshot]
dbSnapshots =
        forall a. Maybe a
Prelude.Nothing,
      $sel:marker:DescribeDBSnapshotsResponse' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeDBSnapshotsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of @DBSnapshot@ instances.
describeDBSnapshotsResponse_dbSnapshots :: Lens.Lens' DescribeDBSnapshotsResponse (Prelude.Maybe [DBSnapshot])
describeDBSnapshotsResponse_dbSnapshots :: Lens' DescribeDBSnapshotsResponse (Maybe [DBSnapshot])
describeDBSnapshotsResponse_dbSnapshots = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBSnapshotsResponse' {Maybe [DBSnapshot]
dbSnapshots :: Maybe [DBSnapshot]
$sel:dbSnapshots:DescribeDBSnapshotsResponse' :: DescribeDBSnapshotsResponse -> Maybe [DBSnapshot]
dbSnapshots} -> Maybe [DBSnapshot]
dbSnapshots) (\s :: DescribeDBSnapshotsResponse
s@DescribeDBSnapshotsResponse' {} Maybe [DBSnapshot]
a -> DescribeDBSnapshotsResponse
s {$sel:dbSnapshots:DescribeDBSnapshotsResponse' :: Maybe [DBSnapshot]
dbSnapshots = Maybe [DBSnapshot]
a} :: DescribeDBSnapshotsResponse) 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@.
describeDBSnapshotsResponse_marker :: Lens.Lens' DescribeDBSnapshotsResponse (Prelude.Maybe Prelude.Text)
describeDBSnapshotsResponse_marker :: Lens' DescribeDBSnapshotsResponse (Maybe Text)
describeDBSnapshotsResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDBSnapshotsResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:DescribeDBSnapshotsResponse' :: DescribeDBSnapshotsResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: DescribeDBSnapshotsResponse
s@DescribeDBSnapshotsResponse' {} Maybe Text
a -> DescribeDBSnapshotsResponse
s {$sel:marker:DescribeDBSnapshotsResponse' :: Maybe Text
marker = Maybe Text
a} :: DescribeDBSnapshotsResponse)

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

instance Prelude.NFData DescribeDBSnapshotsResponse where
  rnf :: DescribeDBSnapshotsResponse -> ()
rnf DescribeDBSnapshotsResponse' {Int
Maybe [DBSnapshot]
Maybe Text
httpStatus :: Int
marker :: Maybe Text
dbSnapshots :: Maybe [DBSnapshot]
$sel:httpStatus:DescribeDBSnapshotsResponse' :: DescribeDBSnapshotsResponse -> Int
$sel:marker:DescribeDBSnapshotsResponse' :: DescribeDBSnapshotsResponse -> Maybe Text
$sel:dbSnapshots:DescribeDBSnapshotsResponse' :: DescribeDBSnapshotsResponse -> Maybe [DBSnapshot]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DBSnapshot]
dbSnapshots
      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