{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Redshift.Types.Snapshot
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Redshift.Types.Snapshot 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.Redshift.Internal
import Amazonka.Redshift.Types.AccountWithRestoreAccess
import Amazonka.Redshift.Types.Tag

-- | Describes a snapshot.
--
-- /See:/ 'newSnapshot' smart constructor.
data Snapshot = Snapshot'
  { -- | A list of the Amazon Web Services accounts authorized to restore the
    -- snapshot. Returns @null@ if no accounts are authorized. Visible only to
    -- the snapshot owner.
    Snapshot -> Maybe [AccountWithRestoreAccess]
accountsWithRestoreAccess :: Prelude.Maybe [AccountWithRestoreAccess],
    -- | The size of the incremental backup.
    Snapshot -> Maybe Double
actualIncrementalBackupSizeInMegaBytes :: Prelude.Maybe Prelude.Double,
    -- | The Availability Zone in which the cluster was created.
    Snapshot -> Maybe Text
availabilityZone :: Prelude.Maybe Prelude.Text,
    -- | The number of megabytes that have been transferred to the snapshot
    -- backup.
    Snapshot -> Maybe Double
backupProgressInMegaBytes :: Prelude.Maybe Prelude.Double,
    -- | The time (UTC) when the cluster was originally created.
    Snapshot -> Maybe ISO8601
clusterCreateTime :: Prelude.Maybe Data.ISO8601,
    -- | The identifier of the cluster for which the snapshot was taken.
    Snapshot -> Maybe Text
clusterIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The version ID of the Amazon Redshift engine that is running on the
    -- cluster.
    Snapshot -> Maybe Text
clusterVersion :: Prelude.Maybe Prelude.Text,
    -- | The number of megabytes per second being transferred to the snapshot
    -- backup. Returns @0@ for a completed backup.
    Snapshot -> Maybe Double
currentBackupRateInMegaBytesPerSecond :: Prelude.Maybe Prelude.Double,
    -- | The name of the database that was created when the cluster was created.
    Snapshot -> Maybe Text
dbName :: Prelude.Maybe Prelude.Text,
    -- | The amount of time an in-progress snapshot backup has been running, or
    -- the amount of time it took a completed backup to finish.
    Snapshot -> Maybe Integer
elapsedTimeInSeconds :: Prelude.Maybe Prelude.Integer,
    -- | If @true@, the data in the snapshot is encrypted at rest.
    Snapshot -> Maybe Bool
encrypted :: Prelude.Maybe Prelude.Bool,
    -- | A boolean that indicates whether the snapshot data is encrypted using
    -- the HSM keys of the source cluster. @true@ indicates that the data is
    -- encrypted using HSM keys.
    Snapshot -> Maybe Bool
encryptedWithHSM :: Prelude.Maybe Prelude.Bool,
    -- | The cluster version of the cluster used to create the snapshot. For
    -- example, 1.0.15503.
    Snapshot -> Maybe Text
engineFullVersion :: Prelude.Maybe Prelude.Text,
    -- | An option that specifies whether to create the cluster with enhanced VPC
    -- routing enabled. To create a cluster that uses enhanced VPC routing, the
    -- cluster must be in a VPC. For more information, see
    -- <https://docs.aws.amazon.com/redshift/latest/mgmt/enhanced-vpc-routing.html Enhanced VPC Routing>
    -- in the Amazon Redshift Cluster Management Guide.
    --
    -- If this option is @true@, enhanced VPC routing is enabled.
    --
    -- Default: false
    Snapshot -> Maybe Bool
enhancedVpcRouting :: Prelude.Maybe Prelude.Bool,
    -- | The estimate of the time remaining before the snapshot backup will
    -- complete. Returns @0@ for a completed backup.
    Snapshot -> Maybe Integer
estimatedSecondsToCompletion :: Prelude.Maybe Prelude.Integer,
    -- | The Key Management Service (KMS) key ID of the encryption key that was
    -- used to encrypt data in the cluster from which the snapshot was taken.
    Snapshot -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The name of the maintenance track for the snapshot.
    Snapshot -> Maybe Text
maintenanceTrackName :: Prelude.Maybe Prelude.Text,
    -- | The number of days until a manual snapshot will pass its retention
    -- period.
    Snapshot -> Maybe Int
manualSnapshotRemainingDays :: Prelude.Maybe Prelude.Int,
    -- | The number of days that a manual snapshot is retained. If the value is
    -- -1, the manual snapshot is retained indefinitely.
    --
    -- The value must be either -1 or an integer between 1 and 3,653.
    Snapshot -> Maybe Int
manualSnapshotRetentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | The admin user name for the cluster.
    Snapshot -> Maybe Text
masterUsername :: Prelude.Maybe Prelude.Text,
    -- | The node type of the nodes in the cluster.
    Snapshot -> Maybe Text
nodeType :: Prelude.Maybe Prelude.Text,
    -- | The number of nodes in the cluster.
    Snapshot -> Maybe Int
numberOfNodes :: Prelude.Maybe Prelude.Int,
    -- | For manual snapshots, the Amazon Web Services account used to create or
    -- copy the snapshot. For automatic snapshots, the owner of the cluster.
    -- The owner can perform all snapshot actions, such as sharing a manual
    -- snapshot.
    Snapshot -> Maybe Text
ownerAccount :: Prelude.Maybe Prelude.Text,
    -- | The port that the cluster is listening on.
    Snapshot -> Maybe Int
port :: Prelude.Maybe Prelude.Int,
    -- | The list of node types that this cluster snapshot is able to restore
    -- into.
    Snapshot -> Maybe [Text]
restorableNodeTypes :: Prelude.Maybe [Prelude.Text],
    -- | The time (in UTC format) when Amazon Redshift began the snapshot. A
    -- snapshot contains a copy of the cluster data as of this exact time.
    Snapshot -> Maybe ISO8601
snapshotCreateTime :: Prelude.Maybe Data.ISO8601,
    -- | The snapshot identifier that is provided in the request.
    Snapshot -> Maybe Text
snapshotIdentifier :: Prelude.Maybe Prelude.Text,
    -- | A timestamp representing the start of the retention period for the
    -- snapshot.
    Snapshot -> Maybe ISO8601
snapshotRetentionStartTime :: Prelude.Maybe Data.ISO8601,
    -- | The snapshot type. Snapshots created using CreateClusterSnapshot and
    -- CopyClusterSnapshot are of type \"manual\".
    Snapshot -> Maybe Text
snapshotType :: Prelude.Maybe Prelude.Text,
    -- | The source region from which the snapshot was copied.
    Snapshot -> Maybe Text
sourceRegion :: Prelude.Maybe Prelude.Text,
    -- | The snapshot status. The value of the status depends on the API
    -- operation used:
    --
    -- -   CreateClusterSnapshot and CopyClusterSnapshot returns status as
    --     \"creating\".
    --
    -- -   DescribeClusterSnapshots returns status as \"creating\",
    --     \"available\", \"final snapshot\", or \"failed\".
    --
    -- -   DeleteClusterSnapshot returns status as \"deleted\".
    Snapshot -> Maybe Text
status :: Prelude.Maybe Prelude.Text,
    -- | The list of tags for the cluster snapshot.
    Snapshot -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The size of the complete set of backup data that would be used to
    -- restore the cluster.
    Snapshot -> Maybe Double
totalBackupSizeInMegaBytes :: Prelude.Maybe Prelude.Double,
    -- | The VPC identifier of the cluster if the snapshot is from a cluster in a
    -- VPC. Otherwise, this field is not in the output.
    Snapshot -> Maybe Text
vpcId :: Prelude.Maybe Prelude.Text
  }
  deriving (Snapshot -> Snapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Snapshot -> Snapshot -> Bool
$c/= :: Snapshot -> Snapshot -> Bool
== :: Snapshot -> Snapshot -> Bool
$c== :: Snapshot -> Snapshot -> Bool
Prelude.Eq, ReadPrec [Snapshot]
ReadPrec Snapshot
Int -> ReadS Snapshot
ReadS [Snapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Snapshot]
$creadListPrec :: ReadPrec [Snapshot]
readPrec :: ReadPrec Snapshot
$creadPrec :: ReadPrec Snapshot
readList :: ReadS [Snapshot]
$creadList :: ReadS [Snapshot]
readsPrec :: Int -> ReadS Snapshot
$creadsPrec :: Int -> ReadS Snapshot
Prelude.Read, Int -> Snapshot -> ShowS
[Snapshot] -> ShowS
Snapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Snapshot] -> ShowS
$cshowList :: [Snapshot] -> ShowS
show :: Snapshot -> String
$cshow :: Snapshot -> String
showsPrec :: Int -> Snapshot -> ShowS
$cshowsPrec :: Int -> Snapshot -> ShowS
Prelude.Show, forall x. Rep Snapshot x -> Snapshot
forall x. Snapshot -> Rep Snapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Snapshot x -> Snapshot
$cfrom :: forall x. Snapshot -> Rep Snapshot x
Prelude.Generic)

-- |
-- Create a value of 'Snapshot' 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:
--
-- 'accountsWithRestoreAccess', 'snapshot_accountsWithRestoreAccess' - A list of the Amazon Web Services accounts authorized to restore the
-- snapshot. Returns @null@ if no accounts are authorized. Visible only to
-- the snapshot owner.
--
-- 'actualIncrementalBackupSizeInMegaBytes', 'snapshot_actualIncrementalBackupSizeInMegaBytes' - The size of the incremental backup.
--
-- 'availabilityZone', 'snapshot_availabilityZone' - The Availability Zone in which the cluster was created.
--
-- 'backupProgressInMegaBytes', 'snapshot_backupProgressInMegaBytes' - The number of megabytes that have been transferred to the snapshot
-- backup.
--
-- 'clusterCreateTime', 'snapshot_clusterCreateTime' - The time (UTC) when the cluster was originally created.
--
-- 'clusterIdentifier', 'snapshot_clusterIdentifier' - The identifier of the cluster for which the snapshot was taken.
--
-- 'clusterVersion', 'snapshot_clusterVersion' - The version ID of the Amazon Redshift engine that is running on the
-- cluster.
--
-- 'currentBackupRateInMegaBytesPerSecond', 'snapshot_currentBackupRateInMegaBytesPerSecond' - The number of megabytes per second being transferred to the snapshot
-- backup. Returns @0@ for a completed backup.
--
-- 'dbName', 'snapshot_dbName' - The name of the database that was created when the cluster was created.
--
-- 'elapsedTimeInSeconds', 'snapshot_elapsedTimeInSeconds' - The amount of time an in-progress snapshot backup has been running, or
-- the amount of time it took a completed backup to finish.
--
-- 'encrypted', 'snapshot_encrypted' - If @true@, the data in the snapshot is encrypted at rest.
--
-- 'encryptedWithHSM', 'snapshot_encryptedWithHSM' - A boolean that indicates whether the snapshot data is encrypted using
-- the HSM keys of the source cluster. @true@ indicates that the data is
-- encrypted using HSM keys.
--
-- 'engineFullVersion', 'snapshot_engineFullVersion' - The cluster version of the cluster used to create the snapshot. For
-- example, 1.0.15503.
--
-- 'enhancedVpcRouting', 'snapshot_enhancedVpcRouting' - An option that specifies whether to create the cluster with enhanced VPC
-- routing enabled. To create a cluster that uses enhanced VPC routing, the
-- cluster must be in a VPC. For more information, see
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/enhanced-vpc-routing.html Enhanced VPC Routing>
-- in the Amazon Redshift Cluster Management Guide.
--
-- If this option is @true@, enhanced VPC routing is enabled.
--
-- Default: false
--
-- 'estimatedSecondsToCompletion', 'snapshot_estimatedSecondsToCompletion' - The estimate of the time remaining before the snapshot backup will
-- complete. Returns @0@ for a completed backup.
--
-- 'kmsKeyId', 'snapshot_kmsKeyId' - The Key Management Service (KMS) key ID of the encryption key that was
-- used to encrypt data in the cluster from which the snapshot was taken.
--
-- 'maintenanceTrackName', 'snapshot_maintenanceTrackName' - The name of the maintenance track for the snapshot.
--
-- 'manualSnapshotRemainingDays', 'snapshot_manualSnapshotRemainingDays' - The number of days until a manual snapshot will pass its retention
-- period.
--
-- 'manualSnapshotRetentionPeriod', 'snapshot_manualSnapshotRetentionPeriod' - The number of days that a manual snapshot is retained. If the value is
-- -1, the manual snapshot is retained indefinitely.
--
-- The value must be either -1 or an integer between 1 and 3,653.
--
-- 'masterUsername', 'snapshot_masterUsername' - The admin user name for the cluster.
--
-- 'nodeType', 'snapshot_nodeType' - The node type of the nodes in the cluster.
--
-- 'numberOfNodes', 'snapshot_numberOfNodes' - The number of nodes in the cluster.
--
-- 'ownerAccount', 'snapshot_ownerAccount' - For manual snapshots, the Amazon Web Services account used to create or
-- copy the snapshot. For automatic snapshots, the owner of the cluster.
-- The owner can perform all snapshot actions, such as sharing a manual
-- snapshot.
--
-- 'port', 'snapshot_port' - The port that the cluster is listening on.
--
-- 'restorableNodeTypes', 'snapshot_restorableNodeTypes' - The list of node types that this cluster snapshot is able to restore
-- into.
--
-- 'snapshotCreateTime', 'snapshot_snapshotCreateTime' - The time (in UTC format) when Amazon Redshift began the snapshot. A
-- snapshot contains a copy of the cluster data as of this exact time.
--
-- 'snapshotIdentifier', 'snapshot_snapshotIdentifier' - The snapshot identifier that is provided in the request.
--
-- 'snapshotRetentionStartTime', 'snapshot_snapshotRetentionStartTime' - A timestamp representing the start of the retention period for the
-- snapshot.
--
-- 'snapshotType', 'snapshot_snapshotType' - The snapshot type. Snapshots created using CreateClusterSnapshot and
-- CopyClusterSnapshot are of type \"manual\".
--
-- 'sourceRegion', 'snapshot_sourceRegion' - The source region from which the snapshot was copied.
--
-- 'status', 'snapshot_status' - The snapshot status. The value of the status depends on the API
-- operation used:
--
-- -   CreateClusterSnapshot and CopyClusterSnapshot returns status as
--     \"creating\".
--
-- -   DescribeClusterSnapshots returns status as \"creating\",
--     \"available\", \"final snapshot\", or \"failed\".
--
-- -   DeleteClusterSnapshot returns status as \"deleted\".
--
-- 'tags', 'snapshot_tags' - The list of tags for the cluster snapshot.
--
-- 'totalBackupSizeInMegaBytes', 'snapshot_totalBackupSizeInMegaBytes' - The size of the complete set of backup data that would be used to
-- restore the cluster.
--
-- 'vpcId', 'snapshot_vpcId' - The VPC identifier of the cluster if the snapshot is from a cluster in a
-- VPC. Otherwise, this field is not in the output.
newSnapshot ::
  Snapshot
newSnapshot :: Snapshot
newSnapshot =
  Snapshot'
    { $sel:accountsWithRestoreAccess:Snapshot' :: Maybe [AccountWithRestoreAccess]
accountsWithRestoreAccess =
        forall a. Maybe a
Prelude.Nothing,
      $sel:actualIncrementalBackupSizeInMegaBytes:Snapshot' :: Maybe Double
actualIncrementalBackupSizeInMegaBytes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZone:Snapshot' :: Maybe Text
availabilityZone = forall a. Maybe a
Prelude.Nothing,
      $sel:backupProgressInMegaBytes:Snapshot' :: Maybe Double
backupProgressInMegaBytes = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterCreateTime:Snapshot' :: Maybe ISO8601
clusterCreateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterIdentifier:Snapshot' :: Maybe Text
clusterIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterVersion:Snapshot' :: Maybe Text
clusterVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:currentBackupRateInMegaBytesPerSecond:Snapshot' :: Maybe Double
currentBackupRateInMegaBytesPerSecond =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dbName:Snapshot' :: Maybe Text
dbName = forall a. Maybe a
Prelude.Nothing,
      $sel:elapsedTimeInSeconds:Snapshot' :: Maybe Integer
elapsedTimeInSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:encrypted:Snapshot' :: Maybe Bool
encrypted = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptedWithHSM:Snapshot' :: Maybe Bool
encryptedWithHSM = forall a. Maybe a
Prelude.Nothing,
      $sel:engineFullVersion:Snapshot' :: Maybe Text
engineFullVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:enhancedVpcRouting:Snapshot' :: Maybe Bool
enhancedVpcRouting = forall a. Maybe a
Prelude.Nothing,
      $sel:estimatedSecondsToCompletion:Snapshot' :: Maybe Integer
estimatedSecondsToCompletion = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:Snapshot' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:maintenanceTrackName:Snapshot' :: Maybe Text
maintenanceTrackName = forall a. Maybe a
Prelude.Nothing,
      $sel:manualSnapshotRemainingDays:Snapshot' :: Maybe Int
manualSnapshotRemainingDays = forall a. Maybe a
Prelude.Nothing,
      $sel:manualSnapshotRetentionPeriod:Snapshot' :: Maybe Int
manualSnapshotRetentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:masterUsername:Snapshot' :: Maybe Text
masterUsername = forall a. Maybe a
Prelude.Nothing,
      $sel:nodeType:Snapshot' :: Maybe Text
nodeType = forall a. Maybe a
Prelude.Nothing,
      $sel:numberOfNodes:Snapshot' :: Maybe Int
numberOfNodes = forall a. Maybe a
Prelude.Nothing,
      $sel:ownerAccount:Snapshot' :: Maybe Text
ownerAccount = forall a. Maybe a
Prelude.Nothing,
      $sel:port:Snapshot' :: Maybe Int
port = forall a. Maybe a
Prelude.Nothing,
      $sel:restorableNodeTypes:Snapshot' :: Maybe [Text]
restorableNodeTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotCreateTime:Snapshot' :: Maybe ISO8601
snapshotCreateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotIdentifier:Snapshot' :: Maybe Text
snapshotIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotRetentionStartTime:Snapshot' :: Maybe ISO8601
snapshotRetentionStartTime = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotType:Snapshot' :: Maybe Text
snapshotType = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceRegion:Snapshot' :: Maybe Text
sourceRegion = forall a. Maybe a
Prelude.Nothing,
      $sel:status:Snapshot' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:Snapshot' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:totalBackupSizeInMegaBytes:Snapshot' :: Maybe Double
totalBackupSizeInMegaBytes = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcId:Snapshot' :: Maybe Text
vpcId = forall a. Maybe a
Prelude.Nothing
    }

-- | A list of the Amazon Web Services accounts authorized to restore the
-- snapshot. Returns @null@ if no accounts are authorized. Visible only to
-- the snapshot owner.
snapshot_accountsWithRestoreAccess :: Lens.Lens' Snapshot (Prelude.Maybe [AccountWithRestoreAccess])
snapshot_accountsWithRestoreAccess :: Lens' Snapshot (Maybe [AccountWithRestoreAccess])
snapshot_accountsWithRestoreAccess = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe [AccountWithRestoreAccess]
accountsWithRestoreAccess :: Maybe [AccountWithRestoreAccess]
$sel:accountsWithRestoreAccess:Snapshot' :: Snapshot -> Maybe [AccountWithRestoreAccess]
accountsWithRestoreAccess} -> Maybe [AccountWithRestoreAccess]
accountsWithRestoreAccess) (\s :: Snapshot
s@Snapshot' {} Maybe [AccountWithRestoreAccess]
a -> Snapshot
s {$sel:accountsWithRestoreAccess:Snapshot' :: Maybe [AccountWithRestoreAccess]
accountsWithRestoreAccess = Maybe [AccountWithRestoreAccess]
a} :: Snapshot) 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

-- | The size of the incremental backup.
snapshot_actualIncrementalBackupSizeInMegaBytes :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Double)
snapshot_actualIncrementalBackupSizeInMegaBytes :: Lens' Snapshot (Maybe Double)
snapshot_actualIncrementalBackupSizeInMegaBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Double
actualIncrementalBackupSizeInMegaBytes :: Maybe Double
$sel:actualIncrementalBackupSizeInMegaBytes:Snapshot' :: Snapshot -> Maybe Double
actualIncrementalBackupSizeInMegaBytes} -> Maybe Double
actualIncrementalBackupSizeInMegaBytes) (\s :: Snapshot
s@Snapshot' {} Maybe Double
a -> Snapshot
s {$sel:actualIncrementalBackupSizeInMegaBytes:Snapshot' :: Maybe Double
actualIncrementalBackupSizeInMegaBytes = Maybe Double
a} :: Snapshot)

-- | The Availability Zone in which the cluster was created.
snapshot_availabilityZone :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_availabilityZone :: Lens' Snapshot (Maybe Text)
snapshot_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
availabilityZone :: Maybe Text
$sel:availabilityZone:Snapshot' :: Snapshot -> Maybe Text
availabilityZone} -> Maybe Text
availabilityZone) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:availabilityZone:Snapshot' :: Maybe Text
availabilityZone = Maybe Text
a} :: Snapshot)

-- | The number of megabytes that have been transferred to the snapshot
-- backup.
snapshot_backupProgressInMegaBytes :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Double)
snapshot_backupProgressInMegaBytes :: Lens' Snapshot (Maybe Double)
snapshot_backupProgressInMegaBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Double
backupProgressInMegaBytes :: Maybe Double
$sel:backupProgressInMegaBytes:Snapshot' :: Snapshot -> Maybe Double
backupProgressInMegaBytes} -> Maybe Double
backupProgressInMegaBytes) (\s :: Snapshot
s@Snapshot' {} Maybe Double
a -> Snapshot
s {$sel:backupProgressInMegaBytes:Snapshot' :: Maybe Double
backupProgressInMegaBytes = Maybe Double
a} :: Snapshot)

-- | The time (UTC) when the cluster was originally created.
snapshot_clusterCreateTime :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.UTCTime)
snapshot_clusterCreateTime :: Lens' Snapshot (Maybe UTCTime)
snapshot_clusterCreateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe ISO8601
clusterCreateTime :: Maybe ISO8601
$sel:clusterCreateTime:Snapshot' :: Snapshot -> Maybe ISO8601
clusterCreateTime} -> Maybe ISO8601
clusterCreateTime) (\s :: Snapshot
s@Snapshot' {} Maybe ISO8601
a -> Snapshot
s {$sel:clusterCreateTime:Snapshot' :: Maybe ISO8601
clusterCreateTime = Maybe ISO8601
a} :: Snapshot) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The identifier of the cluster for which the snapshot was taken.
snapshot_clusterIdentifier :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_clusterIdentifier :: Lens' Snapshot (Maybe Text)
snapshot_clusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
clusterIdentifier :: Maybe Text
$sel:clusterIdentifier:Snapshot' :: Snapshot -> Maybe Text
clusterIdentifier} -> Maybe Text
clusterIdentifier) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:clusterIdentifier:Snapshot' :: Maybe Text
clusterIdentifier = Maybe Text
a} :: Snapshot)

-- | The version ID of the Amazon Redshift engine that is running on the
-- cluster.
snapshot_clusterVersion :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_clusterVersion :: Lens' Snapshot (Maybe Text)
snapshot_clusterVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
clusterVersion :: Maybe Text
$sel:clusterVersion:Snapshot' :: Snapshot -> Maybe Text
clusterVersion} -> Maybe Text
clusterVersion) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:clusterVersion:Snapshot' :: Maybe Text
clusterVersion = Maybe Text
a} :: Snapshot)

-- | The number of megabytes per second being transferred to the snapshot
-- backup. Returns @0@ for a completed backup.
snapshot_currentBackupRateInMegaBytesPerSecond :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Double)
snapshot_currentBackupRateInMegaBytesPerSecond :: Lens' Snapshot (Maybe Double)
snapshot_currentBackupRateInMegaBytesPerSecond = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Double
currentBackupRateInMegaBytesPerSecond :: Maybe Double
$sel:currentBackupRateInMegaBytesPerSecond:Snapshot' :: Snapshot -> Maybe Double
currentBackupRateInMegaBytesPerSecond} -> Maybe Double
currentBackupRateInMegaBytesPerSecond) (\s :: Snapshot
s@Snapshot' {} Maybe Double
a -> Snapshot
s {$sel:currentBackupRateInMegaBytesPerSecond:Snapshot' :: Maybe Double
currentBackupRateInMegaBytesPerSecond = Maybe Double
a} :: Snapshot)

-- | The name of the database that was created when the cluster was created.
snapshot_dbName :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_dbName :: Lens' Snapshot (Maybe Text)
snapshot_dbName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
dbName :: Maybe Text
$sel:dbName:Snapshot' :: Snapshot -> Maybe Text
dbName} -> Maybe Text
dbName) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:dbName:Snapshot' :: Maybe Text
dbName = Maybe Text
a} :: Snapshot)

-- | The amount of time an in-progress snapshot backup has been running, or
-- the amount of time it took a completed backup to finish.
snapshot_elapsedTimeInSeconds :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Integer)
snapshot_elapsedTimeInSeconds :: Lens' Snapshot (Maybe Integer)
snapshot_elapsedTimeInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Integer
elapsedTimeInSeconds :: Maybe Integer
$sel:elapsedTimeInSeconds:Snapshot' :: Snapshot -> Maybe Integer
elapsedTimeInSeconds} -> Maybe Integer
elapsedTimeInSeconds) (\s :: Snapshot
s@Snapshot' {} Maybe Integer
a -> Snapshot
s {$sel:elapsedTimeInSeconds:Snapshot' :: Maybe Integer
elapsedTimeInSeconds = Maybe Integer
a} :: Snapshot)

-- | If @true@, the data in the snapshot is encrypted at rest.
snapshot_encrypted :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Bool)
snapshot_encrypted :: Lens' Snapshot (Maybe Bool)
snapshot_encrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Bool
encrypted :: Maybe Bool
$sel:encrypted:Snapshot' :: Snapshot -> Maybe Bool
encrypted} -> Maybe Bool
encrypted) (\s :: Snapshot
s@Snapshot' {} Maybe Bool
a -> Snapshot
s {$sel:encrypted:Snapshot' :: Maybe Bool
encrypted = Maybe Bool
a} :: Snapshot)

-- | A boolean that indicates whether the snapshot data is encrypted using
-- the HSM keys of the source cluster. @true@ indicates that the data is
-- encrypted using HSM keys.
snapshot_encryptedWithHSM :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Bool)
snapshot_encryptedWithHSM :: Lens' Snapshot (Maybe Bool)
snapshot_encryptedWithHSM = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Bool
encryptedWithHSM :: Maybe Bool
$sel:encryptedWithHSM:Snapshot' :: Snapshot -> Maybe Bool
encryptedWithHSM} -> Maybe Bool
encryptedWithHSM) (\s :: Snapshot
s@Snapshot' {} Maybe Bool
a -> Snapshot
s {$sel:encryptedWithHSM:Snapshot' :: Maybe Bool
encryptedWithHSM = Maybe Bool
a} :: Snapshot)

-- | The cluster version of the cluster used to create the snapshot. For
-- example, 1.0.15503.
snapshot_engineFullVersion :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_engineFullVersion :: Lens' Snapshot (Maybe Text)
snapshot_engineFullVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
engineFullVersion :: Maybe Text
$sel:engineFullVersion:Snapshot' :: Snapshot -> Maybe Text
engineFullVersion} -> Maybe Text
engineFullVersion) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:engineFullVersion:Snapshot' :: Maybe Text
engineFullVersion = Maybe Text
a} :: Snapshot)

-- | An option that specifies whether to create the cluster with enhanced VPC
-- routing enabled. To create a cluster that uses enhanced VPC routing, the
-- cluster must be in a VPC. For more information, see
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/enhanced-vpc-routing.html Enhanced VPC Routing>
-- in the Amazon Redshift Cluster Management Guide.
--
-- If this option is @true@, enhanced VPC routing is enabled.
--
-- Default: false
snapshot_enhancedVpcRouting :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Bool)
snapshot_enhancedVpcRouting :: Lens' Snapshot (Maybe Bool)
snapshot_enhancedVpcRouting = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Bool
enhancedVpcRouting :: Maybe Bool
$sel:enhancedVpcRouting:Snapshot' :: Snapshot -> Maybe Bool
enhancedVpcRouting} -> Maybe Bool
enhancedVpcRouting) (\s :: Snapshot
s@Snapshot' {} Maybe Bool
a -> Snapshot
s {$sel:enhancedVpcRouting:Snapshot' :: Maybe Bool
enhancedVpcRouting = Maybe Bool
a} :: Snapshot)

-- | The estimate of the time remaining before the snapshot backup will
-- complete. Returns @0@ for a completed backup.
snapshot_estimatedSecondsToCompletion :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Integer)
snapshot_estimatedSecondsToCompletion :: Lens' Snapshot (Maybe Integer)
snapshot_estimatedSecondsToCompletion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Integer
estimatedSecondsToCompletion :: Maybe Integer
$sel:estimatedSecondsToCompletion:Snapshot' :: Snapshot -> Maybe Integer
estimatedSecondsToCompletion} -> Maybe Integer
estimatedSecondsToCompletion) (\s :: Snapshot
s@Snapshot' {} Maybe Integer
a -> Snapshot
s {$sel:estimatedSecondsToCompletion:Snapshot' :: Maybe Integer
estimatedSecondsToCompletion = Maybe Integer
a} :: Snapshot)

-- | The Key Management Service (KMS) key ID of the encryption key that was
-- used to encrypt data in the cluster from which the snapshot was taken.
snapshot_kmsKeyId :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_kmsKeyId :: Lens' Snapshot (Maybe Text)
snapshot_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:Snapshot' :: Snapshot -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:kmsKeyId:Snapshot' :: Maybe Text
kmsKeyId = Maybe Text
a} :: Snapshot)

-- | The name of the maintenance track for the snapshot.
snapshot_maintenanceTrackName :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_maintenanceTrackName :: Lens' Snapshot (Maybe Text)
snapshot_maintenanceTrackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
maintenanceTrackName :: Maybe Text
$sel:maintenanceTrackName:Snapshot' :: Snapshot -> Maybe Text
maintenanceTrackName} -> Maybe Text
maintenanceTrackName) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:maintenanceTrackName:Snapshot' :: Maybe Text
maintenanceTrackName = Maybe Text
a} :: Snapshot)

-- | The number of days until a manual snapshot will pass its retention
-- period.
snapshot_manualSnapshotRemainingDays :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Int)
snapshot_manualSnapshotRemainingDays :: Lens' Snapshot (Maybe Int)
snapshot_manualSnapshotRemainingDays = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Int
manualSnapshotRemainingDays :: Maybe Int
$sel:manualSnapshotRemainingDays:Snapshot' :: Snapshot -> Maybe Int
manualSnapshotRemainingDays} -> Maybe Int
manualSnapshotRemainingDays) (\s :: Snapshot
s@Snapshot' {} Maybe Int
a -> Snapshot
s {$sel:manualSnapshotRemainingDays:Snapshot' :: Maybe Int
manualSnapshotRemainingDays = Maybe Int
a} :: Snapshot)

-- | The number of days that a manual snapshot is retained. If the value is
-- -1, the manual snapshot is retained indefinitely.
--
-- The value must be either -1 or an integer between 1 and 3,653.
snapshot_manualSnapshotRetentionPeriod :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Int)
snapshot_manualSnapshotRetentionPeriod :: Lens' Snapshot (Maybe Int)
snapshot_manualSnapshotRetentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Int
manualSnapshotRetentionPeriod :: Maybe Int
$sel:manualSnapshotRetentionPeriod:Snapshot' :: Snapshot -> Maybe Int
manualSnapshotRetentionPeriod} -> Maybe Int
manualSnapshotRetentionPeriod) (\s :: Snapshot
s@Snapshot' {} Maybe Int
a -> Snapshot
s {$sel:manualSnapshotRetentionPeriod:Snapshot' :: Maybe Int
manualSnapshotRetentionPeriod = Maybe Int
a} :: Snapshot)

-- | The admin user name for the cluster.
snapshot_masterUsername :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_masterUsername :: Lens' Snapshot (Maybe Text)
snapshot_masterUsername = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
masterUsername :: Maybe Text
$sel:masterUsername:Snapshot' :: Snapshot -> Maybe Text
masterUsername} -> Maybe Text
masterUsername) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:masterUsername:Snapshot' :: Maybe Text
masterUsername = Maybe Text
a} :: Snapshot)

-- | The node type of the nodes in the cluster.
snapshot_nodeType :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_nodeType :: Lens' Snapshot (Maybe Text)
snapshot_nodeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
nodeType :: Maybe Text
$sel:nodeType:Snapshot' :: Snapshot -> Maybe Text
nodeType} -> Maybe Text
nodeType) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:nodeType:Snapshot' :: Maybe Text
nodeType = Maybe Text
a} :: Snapshot)

-- | The number of nodes in the cluster.
snapshot_numberOfNodes :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Int)
snapshot_numberOfNodes :: Lens' Snapshot (Maybe Int)
snapshot_numberOfNodes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Int
numberOfNodes :: Maybe Int
$sel:numberOfNodes:Snapshot' :: Snapshot -> Maybe Int
numberOfNodes} -> Maybe Int
numberOfNodes) (\s :: Snapshot
s@Snapshot' {} Maybe Int
a -> Snapshot
s {$sel:numberOfNodes:Snapshot' :: Maybe Int
numberOfNodes = Maybe Int
a} :: Snapshot)

-- | For manual snapshots, the Amazon Web Services account used to create or
-- copy the snapshot. For automatic snapshots, the owner of the cluster.
-- The owner can perform all snapshot actions, such as sharing a manual
-- snapshot.
snapshot_ownerAccount :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_ownerAccount :: Lens' Snapshot (Maybe Text)
snapshot_ownerAccount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
ownerAccount :: Maybe Text
$sel:ownerAccount:Snapshot' :: Snapshot -> Maybe Text
ownerAccount} -> Maybe Text
ownerAccount) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:ownerAccount:Snapshot' :: Maybe Text
ownerAccount = Maybe Text
a} :: Snapshot)

-- | The port that the cluster is listening on.
snapshot_port :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Int)
snapshot_port :: Lens' Snapshot (Maybe Int)
snapshot_port = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Int
port :: Maybe Int
$sel:port:Snapshot' :: Snapshot -> Maybe Int
port} -> Maybe Int
port) (\s :: Snapshot
s@Snapshot' {} Maybe Int
a -> Snapshot
s {$sel:port:Snapshot' :: Maybe Int
port = Maybe Int
a} :: Snapshot)

-- | The list of node types that this cluster snapshot is able to restore
-- into.
snapshot_restorableNodeTypes :: Lens.Lens' Snapshot (Prelude.Maybe [Prelude.Text])
snapshot_restorableNodeTypes :: Lens' Snapshot (Maybe [Text])
snapshot_restorableNodeTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe [Text]
restorableNodeTypes :: Maybe [Text]
$sel:restorableNodeTypes:Snapshot' :: Snapshot -> Maybe [Text]
restorableNodeTypes} -> Maybe [Text]
restorableNodeTypes) (\s :: Snapshot
s@Snapshot' {} Maybe [Text]
a -> Snapshot
s {$sel:restorableNodeTypes:Snapshot' :: Maybe [Text]
restorableNodeTypes = Maybe [Text]
a} :: Snapshot) 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

-- | The time (in UTC format) when Amazon Redshift began the snapshot. A
-- snapshot contains a copy of the cluster data as of this exact time.
snapshot_snapshotCreateTime :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.UTCTime)
snapshot_snapshotCreateTime :: Lens' Snapshot (Maybe UTCTime)
snapshot_snapshotCreateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe ISO8601
snapshotCreateTime :: Maybe ISO8601
$sel:snapshotCreateTime:Snapshot' :: Snapshot -> Maybe ISO8601
snapshotCreateTime} -> Maybe ISO8601
snapshotCreateTime) (\s :: Snapshot
s@Snapshot' {} Maybe ISO8601
a -> Snapshot
s {$sel:snapshotCreateTime:Snapshot' :: Maybe ISO8601
snapshotCreateTime = Maybe ISO8601
a} :: Snapshot) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The snapshot identifier that is provided in the request.
snapshot_snapshotIdentifier :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_snapshotIdentifier :: Lens' Snapshot (Maybe Text)
snapshot_snapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
snapshotIdentifier :: Maybe Text
$sel:snapshotIdentifier:Snapshot' :: Snapshot -> Maybe Text
snapshotIdentifier} -> Maybe Text
snapshotIdentifier) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:snapshotIdentifier:Snapshot' :: Maybe Text
snapshotIdentifier = Maybe Text
a} :: Snapshot)

-- | A timestamp representing the start of the retention period for the
-- snapshot.
snapshot_snapshotRetentionStartTime :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.UTCTime)
snapshot_snapshotRetentionStartTime :: Lens' Snapshot (Maybe UTCTime)
snapshot_snapshotRetentionStartTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe ISO8601
snapshotRetentionStartTime :: Maybe ISO8601
$sel:snapshotRetentionStartTime:Snapshot' :: Snapshot -> Maybe ISO8601
snapshotRetentionStartTime} -> Maybe ISO8601
snapshotRetentionStartTime) (\s :: Snapshot
s@Snapshot' {} Maybe ISO8601
a -> Snapshot
s {$sel:snapshotRetentionStartTime:Snapshot' :: Maybe ISO8601
snapshotRetentionStartTime = Maybe ISO8601
a} :: Snapshot) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The snapshot type. Snapshots created using CreateClusterSnapshot and
-- CopyClusterSnapshot are of type \"manual\".
snapshot_snapshotType :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_snapshotType :: Lens' Snapshot (Maybe Text)
snapshot_snapshotType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
snapshotType :: Maybe Text
$sel:snapshotType:Snapshot' :: Snapshot -> Maybe Text
snapshotType} -> Maybe Text
snapshotType) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:snapshotType:Snapshot' :: Maybe Text
snapshotType = Maybe Text
a} :: Snapshot)

-- | The source region from which the snapshot was copied.
snapshot_sourceRegion :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_sourceRegion :: Lens' Snapshot (Maybe Text)
snapshot_sourceRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
sourceRegion :: Maybe Text
$sel:sourceRegion:Snapshot' :: Snapshot -> Maybe Text
sourceRegion} -> Maybe Text
sourceRegion) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:sourceRegion:Snapshot' :: Maybe Text
sourceRegion = Maybe Text
a} :: Snapshot)

-- | The snapshot status. The value of the status depends on the API
-- operation used:
--
-- -   CreateClusterSnapshot and CopyClusterSnapshot returns status as
--     \"creating\".
--
-- -   DescribeClusterSnapshots returns status as \"creating\",
--     \"available\", \"final snapshot\", or \"failed\".
--
-- -   DeleteClusterSnapshot returns status as \"deleted\".
snapshot_status :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_status :: Lens' Snapshot (Maybe Text)
snapshot_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
status :: Maybe Text
$sel:status:Snapshot' :: Snapshot -> Maybe Text
status} -> Maybe Text
status) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:status:Snapshot' :: Maybe Text
status = Maybe Text
a} :: Snapshot)

-- | The list of tags for the cluster snapshot.
snapshot_tags :: Lens.Lens' Snapshot (Prelude.Maybe [Tag])
snapshot_tags :: Lens' Snapshot (Maybe [Tag])
snapshot_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:Snapshot' :: Snapshot -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: Snapshot
s@Snapshot' {} Maybe [Tag]
a -> Snapshot
s {$sel:tags:Snapshot' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: Snapshot) 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

-- | The size of the complete set of backup data that would be used to
-- restore the cluster.
snapshot_totalBackupSizeInMegaBytes :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Double)
snapshot_totalBackupSizeInMegaBytes :: Lens' Snapshot (Maybe Double)
snapshot_totalBackupSizeInMegaBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Double
totalBackupSizeInMegaBytes :: Maybe Double
$sel:totalBackupSizeInMegaBytes:Snapshot' :: Snapshot -> Maybe Double
totalBackupSizeInMegaBytes} -> Maybe Double
totalBackupSizeInMegaBytes) (\s :: Snapshot
s@Snapshot' {} Maybe Double
a -> Snapshot
s {$sel:totalBackupSizeInMegaBytes:Snapshot' :: Maybe Double
totalBackupSizeInMegaBytes = Maybe Double
a} :: Snapshot)

-- | The VPC identifier of the cluster if the snapshot is from a cluster in a
-- VPC. Otherwise, this field is not in the output.
snapshot_vpcId :: Lens.Lens' Snapshot (Prelude.Maybe Prelude.Text)
snapshot_vpcId :: Lens' Snapshot (Maybe Text)
snapshot_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Snapshot' {Maybe Text
vpcId :: Maybe Text
$sel:vpcId:Snapshot' :: Snapshot -> Maybe Text
vpcId} -> Maybe Text
vpcId) (\s :: Snapshot
s@Snapshot' {} Maybe Text
a -> Snapshot
s {$sel:vpcId:Snapshot' :: Maybe Text
vpcId = Maybe Text
a} :: Snapshot)

instance Data.FromXML Snapshot where
  parseXML :: [Node] -> Either String Snapshot
parseXML [Node]
x =
    Maybe [AccountWithRestoreAccess]
-> Maybe Double
-> Maybe Text
-> Maybe Double
-> Maybe ISO8601
-> Maybe Text
-> Maybe Text
-> Maybe Double
-> Maybe Text
-> Maybe Integer
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe [Text]
-> Maybe ISO8601
-> Maybe Text
-> Maybe ISO8601
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [Tag]
-> Maybe Double
-> Maybe Text
-> Snapshot
Snapshot'
      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
"AccountsWithRestoreAccess"
                      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
"AccountWithRestoreAccess")
                  )
      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
"ActualIncrementalBackupSizeInMegaBytes")
      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
"AvailabilityZone")
      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
"BackupProgressInMegaBytes")
      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
"ClusterCreateTime")
      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
"ClusterIdentifier")
      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
"ClusterVersion")
      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
"CurrentBackupRateInMegaBytesPerSecond")
      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
"DBName")
      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
"ElapsedTimeInSeconds")
      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
"Encrypted")
      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
"EncryptedWithHSM")
      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
"EngineFullVersion")
      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
"EnhancedVpcRouting")
      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
"EstimatedSecondsToCompletion")
      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
"KmsKeyId")
      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
"MaintenanceTrackName")
      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
"ManualSnapshotRemainingDays")
      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
"ManualSnapshotRetentionPeriod")
      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
"MasterUsername")
      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
"NodeType")
      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
"NumberOfNodes")
      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
"OwnerAccount")
      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
"Port")
      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
"RestorableNodeTypes"
                      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
"NodeType")
                  )
      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
"SnapshotCreateTime")
      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
"SnapshotIdentifier")
      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
"SnapshotRetentionStartTime")
      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
"SnapshotType")
      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
"SourceRegion")
      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
"Status")
      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
"Tags"
                      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
"Tag")
                  )
      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
"TotalBackupSizeInMegaBytes")
      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
"VpcId")

instance Prelude.Hashable Snapshot where
  hashWithSalt :: Int -> Snapshot -> Int
hashWithSalt Int
_salt Snapshot' {Maybe Bool
Maybe Double
Maybe Int
Maybe Integer
Maybe [Text]
Maybe [AccountWithRestoreAccess]
Maybe [Tag]
Maybe Text
Maybe ISO8601
vpcId :: Maybe Text
totalBackupSizeInMegaBytes :: Maybe Double
tags :: Maybe [Tag]
status :: Maybe Text
sourceRegion :: Maybe Text
snapshotType :: Maybe Text
snapshotRetentionStartTime :: Maybe ISO8601
snapshotIdentifier :: Maybe Text
snapshotCreateTime :: Maybe ISO8601
restorableNodeTypes :: Maybe [Text]
port :: Maybe Int
ownerAccount :: Maybe Text
numberOfNodes :: Maybe Int
nodeType :: Maybe Text
masterUsername :: Maybe Text
manualSnapshotRetentionPeriod :: Maybe Int
manualSnapshotRemainingDays :: Maybe Int
maintenanceTrackName :: Maybe Text
kmsKeyId :: Maybe Text
estimatedSecondsToCompletion :: Maybe Integer
enhancedVpcRouting :: Maybe Bool
engineFullVersion :: Maybe Text
encryptedWithHSM :: Maybe Bool
encrypted :: Maybe Bool
elapsedTimeInSeconds :: Maybe Integer
dbName :: Maybe Text
currentBackupRateInMegaBytesPerSecond :: Maybe Double
clusterVersion :: Maybe Text
clusterIdentifier :: Maybe Text
clusterCreateTime :: Maybe ISO8601
backupProgressInMegaBytes :: Maybe Double
availabilityZone :: Maybe Text
actualIncrementalBackupSizeInMegaBytes :: Maybe Double
accountsWithRestoreAccess :: Maybe [AccountWithRestoreAccess]
$sel:vpcId:Snapshot' :: Snapshot -> Maybe Text
$sel:totalBackupSizeInMegaBytes:Snapshot' :: Snapshot -> Maybe Double
$sel:tags:Snapshot' :: Snapshot -> Maybe [Tag]
$sel:status:Snapshot' :: Snapshot -> Maybe Text
$sel:sourceRegion:Snapshot' :: Snapshot -> Maybe Text
$sel:snapshotType:Snapshot' :: Snapshot -> Maybe Text
$sel:snapshotRetentionStartTime:Snapshot' :: Snapshot -> Maybe ISO8601
$sel:snapshotIdentifier:Snapshot' :: Snapshot -> Maybe Text
$sel:snapshotCreateTime:Snapshot' :: Snapshot -> Maybe ISO8601
$sel:restorableNodeTypes:Snapshot' :: Snapshot -> Maybe [Text]
$sel:port:Snapshot' :: Snapshot -> Maybe Int
$sel:ownerAccount:Snapshot' :: Snapshot -> Maybe Text
$sel:numberOfNodes:Snapshot' :: Snapshot -> Maybe Int
$sel:nodeType:Snapshot' :: Snapshot -> Maybe Text
$sel:masterUsername:Snapshot' :: Snapshot -> Maybe Text
$sel:manualSnapshotRetentionPeriod:Snapshot' :: Snapshot -> Maybe Int
$sel:manualSnapshotRemainingDays:Snapshot' :: Snapshot -> Maybe Int
$sel:maintenanceTrackName:Snapshot' :: Snapshot -> Maybe Text
$sel:kmsKeyId:Snapshot' :: Snapshot -> Maybe Text
$sel:estimatedSecondsToCompletion:Snapshot' :: Snapshot -> Maybe Integer
$sel:enhancedVpcRouting:Snapshot' :: Snapshot -> Maybe Bool
$sel:engineFullVersion:Snapshot' :: Snapshot -> Maybe Text
$sel:encryptedWithHSM:Snapshot' :: Snapshot -> Maybe Bool
$sel:encrypted:Snapshot' :: Snapshot -> Maybe Bool
$sel:elapsedTimeInSeconds:Snapshot' :: Snapshot -> Maybe Integer
$sel:dbName:Snapshot' :: Snapshot -> Maybe Text
$sel:currentBackupRateInMegaBytesPerSecond:Snapshot' :: Snapshot -> Maybe Double
$sel:clusterVersion:Snapshot' :: Snapshot -> Maybe Text
$sel:clusterIdentifier:Snapshot' :: Snapshot -> Maybe Text
$sel:clusterCreateTime:Snapshot' :: Snapshot -> Maybe ISO8601
$sel:backupProgressInMegaBytes:Snapshot' :: Snapshot -> Maybe Double
$sel:availabilityZone:Snapshot' :: Snapshot -> Maybe Text
$sel:actualIncrementalBackupSizeInMegaBytes:Snapshot' :: Snapshot -> Maybe Double
$sel:accountsWithRestoreAccess:Snapshot' :: Snapshot -> Maybe [AccountWithRestoreAccess]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AccountWithRestoreAccess]
accountsWithRestoreAccess
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
actualIncrementalBackupSizeInMegaBytes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
availabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
backupProgressInMegaBytes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
clusterCreateTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
currentBackupRateInMegaBytesPerSecond
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
elapsedTimeInSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
encrypted
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
encryptedWithHSM
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineFullVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enhancedVpcRouting
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
estimatedSecondsToCompletion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
maintenanceTrackName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
manualSnapshotRemainingDays
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
manualSnapshotRetentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
masterUsername
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nodeType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
numberOfNodes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ownerAccount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
port
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
restorableNodeTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
snapshotCreateTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
snapshotRetentionStartTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceRegion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
totalBackupSizeInMegaBytes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vpcId

instance Prelude.NFData Snapshot where
  rnf :: Snapshot -> ()
rnf Snapshot' {Maybe Bool
Maybe Double
Maybe Int
Maybe Integer
Maybe [Text]
Maybe [AccountWithRestoreAccess]
Maybe [Tag]
Maybe Text
Maybe ISO8601
vpcId :: Maybe Text
totalBackupSizeInMegaBytes :: Maybe Double
tags :: Maybe [Tag]
status :: Maybe Text
sourceRegion :: Maybe Text
snapshotType :: Maybe Text
snapshotRetentionStartTime :: Maybe ISO8601
snapshotIdentifier :: Maybe Text
snapshotCreateTime :: Maybe ISO8601
restorableNodeTypes :: Maybe [Text]
port :: Maybe Int
ownerAccount :: Maybe Text
numberOfNodes :: Maybe Int
nodeType :: Maybe Text
masterUsername :: Maybe Text
manualSnapshotRetentionPeriod :: Maybe Int
manualSnapshotRemainingDays :: Maybe Int
maintenanceTrackName :: Maybe Text
kmsKeyId :: Maybe Text
estimatedSecondsToCompletion :: Maybe Integer
enhancedVpcRouting :: Maybe Bool
engineFullVersion :: Maybe Text
encryptedWithHSM :: Maybe Bool
encrypted :: Maybe Bool
elapsedTimeInSeconds :: Maybe Integer
dbName :: Maybe Text
currentBackupRateInMegaBytesPerSecond :: Maybe Double
clusterVersion :: Maybe Text
clusterIdentifier :: Maybe Text
clusterCreateTime :: Maybe ISO8601
backupProgressInMegaBytes :: Maybe Double
availabilityZone :: Maybe Text
actualIncrementalBackupSizeInMegaBytes :: Maybe Double
accountsWithRestoreAccess :: Maybe [AccountWithRestoreAccess]
$sel:vpcId:Snapshot' :: Snapshot -> Maybe Text
$sel:totalBackupSizeInMegaBytes:Snapshot' :: Snapshot -> Maybe Double
$sel:tags:Snapshot' :: Snapshot -> Maybe [Tag]
$sel:status:Snapshot' :: Snapshot -> Maybe Text
$sel:sourceRegion:Snapshot' :: Snapshot -> Maybe Text
$sel:snapshotType:Snapshot' :: Snapshot -> Maybe Text
$sel:snapshotRetentionStartTime:Snapshot' :: Snapshot -> Maybe ISO8601
$sel:snapshotIdentifier:Snapshot' :: Snapshot -> Maybe Text
$sel:snapshotCreateTime:Snapshot' :: Snapshot -> Maybe ISO8601
$sel:restorableNodeTypes:Snapshot' :: Snapshot -> Maybe [Text]
$sel:port:Snapshot' :: Snapshot -> Maybe Int
$sel:ownerAccount:Snapshot' :: Snapshot -> Maybe Text
$sel:numberOfNodes:Snapshot' :: Snapshot -> Maybe Int
$sel:nodeType:Snapshot' :: Snapshot -> Maybe Text
$sel:masterUsername:Snapshot' :: Snapshot -> Maybe Text
$sel:manualSnapshotRetentionPeriod:Snapshot' :: Snapshot -> Maybe Int
$sel:manualSnapshotRemainingDays:Snapshot' :: Snapshot -> Maybe Int
$sel:maintenanceTrackName:Snapshot' :: Snapshot -> Maybe Text
$sel:kmsKeyId:Snapshot' :: Snapshot -> Maybe Text
$sel:estimatedSecondsToCompletion:Snapshot' :: Snapshot -> Maybe Integer
$sel:enhancedVpcRouting:Snapshot' :: Snapshot -> Maybe Bool
$sel:engineFullVersion:Snapshot' :: Snapshot -> Maybe Text
$sel:encryptedWithHSM:Snapshot' :: Snapshot -> Maybe Bool
$sel:encrypted:Snapshot' :: Snapshot -> Maybe Bool
$sel:elapsedTimeInSeconds:Snapshot' :: Snapshot -> Maybe Integer
$sel:dbName:Snapshot' :: Snapshot -> Maybe Text
$sel:currentBackupRateInMegaBytesPerSecond:Snapshot' :: Snapshot -> Maybe Double
$sel:clusterVersion:Snapshot' :: Snapshot -> Maybe Text
$sel:clusterIdentifier:Snapshot' :: Snapshot -> Maybe Text
$sel:clusterCreateTime:Snapshot' :: Snapshot -> Maybe ISO8601
$sel:backupProgressInMegaBytes:Snapshot' :: Snapshot -> Maybe Double
$sel:availabilityZone:Snapshot' :: Snapshot -> Maybe Text
$sel:actualIncrementalBackupSizeInMegaBytes:Snapshot' :: Snapshot -> Maybe Double
$sel:accountsWithRestoreAccess:Snapshot' :: Snapshot -> Maybe [AccountWithRestoreAccess]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AccountWithRestoreAccess]
accountsWithRestoreAccess
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
actualIncrementalBackupSizeInMegaBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
availabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
backupProgressInMegaBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
clusterCreateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
currentBackupRateInMegaBytesPerSecond
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
elapsedTimeInSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
encrypted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
encryptedWithHSM
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineFullVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enhancedVpcRouting
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
estimatedSecondsToCompletion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
maintenanceTrackName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Int
manualSnapshotRemainingDays
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Int
manualSnapshotRetentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
masterUsername
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nodeType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
numberOfNodes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ownerAccount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
port
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe [Text]
restorableNodeTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe ISO8601
snapshotCreateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
snapshotIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe ISO8601
snapshotRetentionStartTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
snapshotType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
sourceRegion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Double
totalBackupSizeInMegaBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
vpcId