{-# 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.DocumentDB.Types.DBCluster
-- 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.DocumentDB.Types.DBCluster where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DocumentDB.Types.DBClusterMember
import Amazonka.DocumentDB.Types.DBClusterRole
import Amazonka.DocumentDB.Types.VpcSecurityGroupMembership
import qualified Amazonka.Prelude as Prelude

-- | Detailed information about a cluster.
--
-- /See:/ 'newDBCluster' smart constructor.
data DBCluster = DBCluster'
  { -- | Provides a list of the Identity and Access Management (IAM) roles that
    -- are associated with the cluster. (IAM) roles that are associated with a
    -- cluster grant permission for the cluster to access other Amazon Web
    -- Services services on your behalf.
    DBCluster -> Maybe [DBClusterRole]
associatedRoles :: Prelude.Maybe [DBClusterRole],
    -- | Provides the list of Amazon EC2 Availability Zones that instances in the
    -- cluster can be created in.
    DBCluster -> Maybe [Text]
availabilityZones :: Prelude.Maybe [Prelude.Text],
    -- | Specifies the number of days for which automatic snapshots are retained.
    DBCluster -> Maybe Int
backupRetentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | Identifies the clone group to which the DB cluster is associated.
    DBCluster -> Maybe Text
cloneGroupId :: Prelude.Maybe Prelude.Text,
    -- | Specifies the time when the cluster was created, in Universal
    -- Coordinated Time (UTC).
    DBCluster -> Maybe ISO8601
clusterCreateTime :: Prelude.Maybe Data.ISO8601,
    -- | The Amazon Resource Name (ARN) for the cluster.
    DBCluster -> Maybe Text
dbClusterArn :: Prelude.Maybe Prelude.Text,
    -- | Contains a user-supplied cluster identifier. This identifier is the
    -- unique key that identifies a cluster.
    DBCluster -> Maybe Text
dbClusterIdentifier :: Prelude.Maybe Prelude.Text,
    -- | Provides the list of instances that make up the cluster.
    DBCluster -> Maybe [DBClusterMember]
dbClusterMembers :: Prelude.Maybe [DBClusterMember],
    -- | Specifies the name of the cluster parameter group for the cluster.
    DBCluster -> Maybe Text
dbClusterParameterGroup :: Prelude.Maybe Prelude.Text,
    -- | Specifies information on the subnet group that is associated with the
    -- cluster, including the name, description, and subnets in the subnet
    -- group.
    DBCluster -> Maybe Text
dbSubnetGroup :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services Region-unique, immutable identifier for the
    -- cluster. This identifier is found in CloudTrail log entries whenever the
    -- KMS key for the cluster is accessed.
    DBCluster -> Maybe Text
dbClusterResourceId :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether this cluster can be deleted. If @DeletionProtection@
    -- is enabled, the cluster cannot be deleted unless it is modified and
    -- @DeletionProtection@ is disabled. @DeletionProtection@ protects clusters
    -- from being accidentally deleted.
    DBCluster -> Maybe Bool
deletionProtection :: Prelude.Maybe Prelude.Bool,
    -- | The earliest time to which a database can be restored with point-in-time
    -- restore.
    DBCluster -> Maybe ISO8601
earliestRestorableTime :: Prelude.Maybe Data.ISO8601,
    -- | A list of log types that this cluster is configured to export to Amazon
    -- CloudWatch Logs.
    DBCluster -> Maybe [Text]
enabledCloudwatchLogsExports :: Prelude.Maybe [Prelude.Text],
    -- | Specifies the connection endpoint for the primary instance of the
    -- cluster.
    DBCluster -> Maybe Text
endpoint :: Prelude.Maybe Prelude.Text,
    -- | Provides the name of the database engine to be used for this cluster.
    DBCluster -> Maybe Text
engine :: Prelude.Maybe Prelude.Text,
    -- | Indicates the database engine version.
    DBCluster -> Maybe Text
engineVersion :: Prelude.Maybe Prelude.Text,
    -- | Specifies the ID that Amazon Route 53 assigns when you create a hosted
    -- zone.
    DBCluster -> Maybe Text
hostedZoneId :: Prelude.Maybe Prelude.Text,
    -- | If @StorageEncrypted@ is @true@, the KMS key identifier for the
    -- encrypted cluster.
    DBCluster -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | Specifies the latest time to which a database can be restored with
    -- point-in-time restore.
    DBCluster -> Maybe ISO8601
latestRestorableTime :: Prelude.Maybe Data.ISO8601,
    -- | Contains the master user name for the cluster.
    DBCluster -> Maybe Text
masterUsername :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether the cluster has instances in multiple Availability
    -- Zones.
    DBCluster -> Maybe Bool
multiAZ :: Prelude.Maybe Prelude.Bool,
    -- | Specifies the progress of the operation as a percentage.
    DBCluster -> Maybe Text
percentProgress :: Prelude.Maybe Prelude.Text,
    -- | Specifies the port that the database engine is listening on.
    DBCluster -> Maybe Int
port :: Prelude.Maybe Prelude.Int,
    -- | Specifies the daily time range during which automated backups are
    -- created if automated backups are enabled, as determined by the
    -- @BackupRetentionPeriod@.
    DBCluster -> Maybe Text
preferredBackupWindow :: Prelude.Maybe Prelude.Text,
    -- | Specifies the weekly time range during which system maintenance can
    -- occur, in Universal Coordinated Time (UTC).
    DBCluster -> Maybe Text
preferredMaintenanceWindow :: Prelude.Maybe Prelude.Text,
    -- | Contains one or more identifiers of the secondary clusters that are
    -- associated with this cluster.
    DBCluster -> Maybe [Text]
readReplicaIdentifiers :: Prelude.Maybe [Prelude.Text],
    -- | The reader endpoint for the cluster. The reader endpoint for a cluster
    -- load balances connections across the Amazon DocumentDB replicas that are
    -- available in a cluster. As clients request new connections to the reader
    -- endpoint, Amazon DocumentDB distributes the connection requests among
    -- the Amazon DocumentDB replicas in the cluster. This functionality can
    -- help balance your read workload across multiple Amazon DocumentDB
    -- replicas in your cluster.
    --
    -- If a failover occurs, and the Amazon DocumentDB replica that you are
    -- connected to is promoted to be the primary instance, your connection is
    -- dropped. To continue sending your read workload to other Amazon
    -- DocumentDB replicas in the cluster, you can then reconnect to the reader
    -- endpoint.
    DBCluster -> Maybe Text
readerEndpoint :: Prelude.Maybe Prelude.Text,
    -- | Contains the identifier of the source cluster if this cluster is a
    -- secondary cluster.
    DBCluster -> Maybe Text
replicationSourceIdentifier :: Prelude.Maybe Prelude.Text,
    -- | Specifies the current state of this cluster.
    DBCluster -> Maybe Text
status :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether the cluster is encrypted.
    DBCluster -> Maybe Bool
storageEncrypted :: Prelude.Maybe Prelude.Bool,
    -- | Provides a list of virtual private cloud (VPC) security groups that the
    -- cluster belongs to.
    DBCluster -> Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups :: Prelude.Maybe [VpcSecurityGroupMembership]
  }
  deriving (DBCluster -> DBCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DBCluster -> DBCluster -> Bool
$c/= :: DBCluster -> DBCluster -> Bool
== :: DBCluster -> DBCluster -> Bool
$c== :: DBCluster -> DBCluster -> Bool
Prelude.Eq, ReadPrec [DBCluster]
ReadPrec DBCluster
Int -> ReadS DBCluster
ReadS [DBCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DBCluster]
$creadListPrec :: ReadPrec [DBCluster]
readPrec :: ReadPrec DBCluster
$creadPrec :: ReadPrec DBCluster
readList :: ReadS [DBCluster]
$creadList :: ReadS [DBCluster]
readsPrec :: Int -> ReadS DBCluster
$creadsPrec :: Int -> ReadS DBCluster
Prelude.Read, Int -> DBCluster -> ShowS
[DBCluster] -> ShowS
DBCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DBCluster] -> ShowS
$cshowList :: [DBCluster] -> ShowS
show :: DBCluster -> String
$cshow :: DBCluster -> String
showsPrec :: Int -> DBCluster -> ShowS
$cshowsPrec :: Int -> DBCluster -> ShowS
Prelude.Show, forall x. Rep DBCluster x -> DBCluster
forall x. DBCluster -> Rep DBCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DBCluster x -> DBCluster
$cfrom :: forall x. DBCluster -> Rep DBCluster x
Prelude.Generic)

-- |
-- Create a value of 'DBCluster' 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:
--
-- 'associatedRoles', 'dbCluster_associatedRoles' - Provides a list of the Identity and Access Management (IAM) roles that
-- are associated with the cluster. (IAM) roles that are associated with a
-- cluster grant permission for the cluster to access other Amazon Web
-- Services services on your behalf.
--
-- 'availabilityZones', 'dbCluster_availabilityZones' - Provides the list of Amazon EC2 Availability Zones that instances in the
-- cluster can be created in.
--
-- 'backupRetentionPeriod', 'dbCluster_backupRetentionPeriod' - Specifies the number of days for which automatic snapshots are retained.
--
-- 'cloneGroupId', 'dbCluster_cloneGroupId' - Identifies the clone group to which the DB cluster is associated.
--
-- 'clusterCreateTime', 'dbCluster_clusterCreateTime' - Specifies the time when the cluster was created, in Universal
-- Coordinated Time (UTC).
--
-- 'dbClusterArn', 'dbCluster_dbClusterArn' - The Amazon Resource Name (ARN) for the cluster.
--
-- 'dbClusterIdentifier', 'dbCluster_dbClusterIdentifier' - Contains a user-supplied cluster identifier. This identifier is the
-- unique key that identifies a cluster.
--
-- 'dbClusterMembers', 'dbCluster_dbClusterMembers' - Provides the list of instances that make up the cluster.
--
-- 'dbClusterParameterGroup', 'dbCluster_dbClusterParameterGroup' - Specifies the name of the cluster parameter group for the cluster.
--
-- 'dbSubnetGroup', 'dbCluster_dbSubnetGroup' - Specifies information on the subnet group that is associated with the
-- cluster, including the name, description, and subnets in the subnet
-- group.
--
-- 'dbClusterResourceId', 'dbCluster_dbClusterResourceId' - The Amazon Web Services Region-unique, immutable identifier for the
-- cluster. This identifier is found in CloudTrail log entries whenever the
-- KMS key for the cluster is accessed.
--
-- 'deletionProtection', 'dbCluster_deletionProtection' - Specifies whether this cluster can be deleted. If @DeletionProtection@
-- is enabled, the cluster cannot be deleted unless it is modified and
-- @DeletionProtection@ is disabled. @DeletionProtection@ protects clusters
-- from being accidentally deleted.
--
-- 'earliestRestorableTime', 'dbCluster_earliestRestorableTime' - The earliest time to which a database can be restored with point-in-time
-- restore.
--
-- 'enabledCloudwatchLogsExports', 'dbCluster_enabledCloudwatchLogsExports' - A list of log types that this cluster is configured to export to Amazon
-- CloudWatch Logs.
--
-- 'endpoint', 'dbCluster_endpoint' - Specifies the connection endpoint for the primary instance of the
-- cluster.
--
-- 'engine', 'dbCluster_engine' - Provides the name of the database engine to be used for this cluster.
--
-- 'engineVersion', 'dbCluster_engineVersion' - Indicates the database engine version.
--
-- 'hostedZoneId', 'dbCluster_hostedZoneId' - Specifies the ID that Amazon Route 53 assigns when you create a hosted
-- zone.
--
-- 'kmsKeyId', 'dbCluster_kmsKeyId' - If @StorageEncrypted@ is @true@, the KMS key identifier for the
-- encrypted cluster.
--
-- 'latestRestorableTime', 'dbCluster_latestRestorableTime' - Specifies the latest time to which a database can be restored with
-- point-in-time restore.
--
-- 'masterUsername', 'dbCluster_masterUsername' - Contains the master user name for the cluster.
--
-- 'multiAZ', 'dbCluster_multiAZ' - Specifies whether the cluster has instances in multiple Availability
-- Zones.
--
-- 'percentProgress', 'dbCluster_percentProgress' - Specifies the progress of the operation as a percentage.
--
-- 'port', 'dbCluster_port' - Specifies the port that the database engine is listening on.
--
-- 'preferredBackupWindow', 'dbCluster_preferredBackupWindow' - Specifies the daily time range during which automated backups are
-- created if automated backups are enabled, as determined by the
-- @BackupRetentionPeriod@.
--
-- 'preferredMaintenanceWindow', 'dbCluster_preferredMaintenanceWindow' - Specifies the weekly time range during which system maintenance can
-- occur, in Universal Coordinated Time (UTC).
--
-- 'readReplicaIdentifiers', 'dbCluster_readReplicaIdentifiers' - Contains one or more identifiers of the secondary clusters that are
-- associated with this cluster.
--
-- 'readerEndpoint', 'dbCluster_readerEndpoint' - The reader endpoint for the cluster. The reader endpoint for a cluster
-- load balances connections across the Amazon DocumentDB replicas that are
-- available in a cluster. As clients request new connections to the reader
-- endpoint, Amazon DocumentDB distributes the connection requests among
-- the Amazon DocumentDB replicas in the cluster. This functionality can
-- help balance your read workload across multiple Amazon DocumentDB
-- replicas in your cluster.
--
-- If a failover occurs, and the Amazon DocumentDB replica that you are
-- connected to is promoted to be the primary instance, your connection is
-- dropped. To continue sending your read workload to other Amazon
-- DocumentDB replicas in the cluster, you can then reconnect to the reader
-- endpoint.
--
-- 'replicationSourceIdentifier', 'dbCluster_replicationSourceIdentifier' - Contains the identifier of the source cluster if this cluster is a
-- secondary cluster.
--
-- 'status', 'dbCluster_status' - Specifies the current state of this cluster.
--
-- 'storageEncrypted', 'dbCluster_storageEncrypted' - Specifies whether the cluster is encrypted.
--
-- 'vpcSecurityGroups', 'dbCluster_vpcSecurityGroups' - Provides a list of virtual private cloud (VPC) security groups that the
-- cluster belongs to.
newDBCluster ::
  DBCluster
newDBCluster :: DBCluster
newDBCluster =
  DBCluster'
    { $sel:associatedRoles:DBCluster' :: Maybe [DBClusterRole]
associatedRoles = forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZones:DBCluster' :: Maybe [Text]
availabilityZones = forall a. Maybe a
Prelude.Nothing,
      $sel:backupRetentionPeriod:DBCluster' :: Maybe Int
backupRetentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:cloneGroupId:DBCluster' :: Maybe Text
cloneGroupId = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterCreateTime:DBCluster' :: Maybe ISO8601
clusterCreateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:dbClusterArn:DBCluster' :: Maybe Text
dbClusterArn = forall a. Maybe a
Prelude.Nothing,
      $sel:dbClusterIdentifier:DBCluster' :: Maybe Text
dbClusterIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:dbClusterMembers:DBCluster' :: Maybe [DBClusterMember]
dbClusterMembers = forall a. Maybe a
Prelude.Nothing,
      $sel:dbClusterParameterGroup:DBCluster' :: Maybe Text
dbClusterParameterGroup = forall a. Maybe a
Prelude.Nothing,
      $sel:dbSubnetGroup:DBCluster' :: Maybe Text
dbSubnetGroup = forall a. Maybe a
Prelude.Nothing,
      $sel:dbClusterResourceId:DBCluster' :: Maybe Text
dbClusterResourceId = forall a. Maybe a
Prelude.Nothing,
      $sel:deletionProtection:DBCluster' :: Maybe Bool
deletionProtection = forall a. Maybe a
Prelude.Nothing,
      $sel:earliestRestorableTime:DBCluster' :: Maybe ISO8601
earliestRestorableTime = forall a. Maybe a
Prelude.Nothing,
      $sel:enabledCloudwatchLogsExports:DBCluster' :: Maybe [Text]
enabledCloudwatchLogsExports = forall a. Maybe a
Prelude.Nothing,
      $sel:endpoint:DBCluster' :: Maybe Text
endpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:engine:DBCluster' :: Maybe Text
engine = forall a. Maybe a
Prelude.Nothing,
      $sel:engineVersion:DBCluster' :: Maybe Text
engineVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:hostedZoneId:DBCluster' :: Maybe Text
hostedZoneId = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:DBCluster' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:latestRestorableTime:DBCluster' :: Maybe ISO8601
latestRestorableTime = forall a. Maybe a
Prelude.Nothing,
      $sel:masterUsername:DBCluster' :: Maybe Text
masterUsername = forall a. Maybe a
Prelude.Nothing,
      $sel:multiAZ:DBCluster' :: Maybe Bool
multiAZ = forall a. Maybe a
Prelude.Nothing,
      $sel:percentProgress:DBCluster' :: Maybe Text
percentProgress = forall a. Maybe a
Prelude.Nothing,
      $sel:port:DBCluster' :: Maybe Int
port = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredBackupWindow:DBCluster' :: Maybe Text
preferredBackupWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredMaintenanceWindow:DBCluster' :: Maybe Text
preferredMaintenanceWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:readReplicaIdentifiers:DBCluster' :: Maybe [Text]
readReplicaIdentifiers = forall a. Maybe a
Prelude.Nothing,
      $sel:readerEndpoint:DBCluster' :: Maybe Text
readerEndpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:replicationSourceIdentifier:DBCluster' :: Maybe Text
replicationSourceIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DBCluster' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
      $sel:storageEncrypted:DBCluster' :: Maybe Bool
storageEncrypted = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcSecurityGroups:DBCluster' :: Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups = forall a. Maybe a
Prelude.Nothing
    }

-- | Provides a list of the Identity and Access Management (IAM) roles that
-- are associated with the cluster. (IAM) roles that are associated with a
-- cluster grant permission for the cluster to access other Amazon Web
-- Services services on your behalf.
dbCluster_associatedRoles :: Lens.Lens' DBCluster (Prelude.Maybe [DBClusterRole])
dbCluster_associatedRoles :: Lens' DBCluster (Maybe [DBClusterRole])
dbCluster_associatedRoles = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe [DBClusterRole]
associatedRoles :: Maybe [DBClusterRole]
$sel:associatedRoles:DBCluster' :: DBCluster -> Maybe [DBClusterRole]
associatedRoles} -> Maybe [DBClusterRole]
associatedRoles) (\s :: DBCluster
s@DBCluster' {} Maybe [DBClusterRole]
a -> DBCluster
s {$sel:associatedRoles:DBCluster' :: Maybe [DBClusterRole]
associatedRoles = Maybe [DBClusterRole]
a} :: DBCluster) 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

-- | Provides the list of Amazon EC2 Availability Zones that instances in the
-- cluster can be created in.
dbCluster_availabilityZones :: Lens.Lens' DBCluster (Prelude.Maybe [Prelude.Text])
dbCluster_availabilityZones :: Lens' DBCluster (Maybe [Text])
dbCluster_availabilityZones = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe [Text]
availabilityZones :: Maybe [Text]
$sel:availabilityZones:DBCluster' :: DBCluster -> Maybe [Text]
availabilityZones} -> Maybe [Text]
availabilityZones) (\s :: DBCluster
s@DBCluster' {} Maybe [Text]
a -> DBCluster
s {$sel:availabilityZones:DBCluster' :: Maybe [Text]
availabilityZones = Maybe [Text]
a} :: DBCluster) 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

-- | Specifies the number of days for which automatic snapshots are retained.
dbCluster_backupRetentionPeriod :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Int)
dbCluster_backupRetentionPeriod :: Lens' DBCluster (Maybe Int)
dbCluster_backupRetentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Int
backupRetentionPeriod :: Maybe Int
$sel:backupRetentionPeriod:DBCluster' :: DBCluster -> Maybe Int
backupRetentionPeriod} -> Maybe Int
backupRetentionPeriod) (\s :: DBCluster
s@DBCluster' {} Maybe Int
a -> DBCluster
s {$sel:backupRetentionPeriod:DBCluster' :: Maybe Int
backupRetentionPeriod = Maybe Int
a} :: DBCluster)

-- | Identifies the clone group to which the DB cluster is associated.
dbCluster_cloneGroupId :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_cloneGroupId :: Lens' DBCluster (Maybe Text)
dbCluster_cloneGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
cloneGroupId :: Maybe Text
$sel:cloneGroupId:DBCluster' :: DBCluster -> Maybe Text
cloneGroupId} -> Maybe Text
cloneGroupId) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:cloneGroupId:DBCluster' :: Maybe Text
cloneGroupId = Maybe Text
a} :: DBCluster)

-- | Specifies the time when the cluster was created, in Universal
-- Coordinated Time (UTC).
dbCluster_clusterCreateTime :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.UTCTime)
dbCluster_clusterCreateTime :: Lens' DBCluster (Maybe UTCTime)
dbCluster_clusterCreateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe ISO8601
clusterCreateTime :: Maybe ISO8601
$sel:clusterCreateTime:DBCluster' :: DBCluster -> Maybe ISO8601
clusterCreateTime} -> Maybe ISO8601
clusterCreateTime) (\s :: DBCluster
s@DBCluster' {} Maybe ISO8601
a -> DBCluster
s {$sel:clusterCreateTime:DBCluster' :: Maybe ISO8601
clusterCreateTime = Maybe ISO8601
a} :: DBCluster) 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 Amazon Resource Name (ARN) for the cluster.
dbCluster_dbClusterArn :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_dbClusterArn :: Lens' DBCluster (Maybe Text)
dbCluster_dbClusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
dbClusterArn :: Maybe Text
$sel:dbClusterArn:DBCluster' :: DBCluster -> Maybe Text
dbClusterArn} -> Maybe Text
dbClusterArn) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:dbClusterArn:DBCluster' :: Maybe Text
dbClusterArn = Maybe Text
a} :: DBCluster)

-- | Contains a user-supplied cluster identifier. This identifier is the
-- unique key that identifies a cluster.
dbCluster_dbClusterIdentifier :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_dbClusterIdentifier :: Lens' DBCluster (Maybe Text)
dbCluster_dbClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
dbClusterIdentifier :: Maybe Text
$sel:dbClusterIdentifier:DBCluster' :: DBCluster -> Maybe Text
dbClusterIdentifier} -> Maybe Text
dbClusterIdentifier) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:dbClusterIdentifier:DBCluster' :: Maybe Text
dbClusterIdentifier = Maybe Text
a} :: DBCluster)

-- | Provides the list of instances that make up the cluster.
dbCluster_dbClusterMembers :: Lens.Lens' DBCluster (Prelude.Maybe [DBClusterMember])
dbCluster_dbClusterMembers :: Lens' DBCluster (Maybe [DBClusterMember])
dbCluster_dbClusterMembers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe [DBClusterMember]
dbClusterMembers :: Maybe [DBClusterMember]
$sel:dbClusterMembers:DBCluster' :: DBCluster -> Maybe [DBClusterMember]
dbClusterMembers} -> Maybe [DBClusterMember]
dbClusterMembers) (\s :: DBCluster
s@DBCluster' {} Maybe [DBClusterMember]
a -> DBCluster
s {$sel:dbClusterMembers:DBCluster' :: Maybe [DBClusterMember]
dbClusterMembers = Maybe [DBClusterMember]
a} :: DBCluster) 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

-- | Specifies the name of the cluster parameter group for the cluster.
dbCluster_dbClusterParameterGroup :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_dbClusterParameterGroup :: Lens' DBCluster (Maybe Text)
dbCluster_dbClusterParameterGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
dbClusterParameterGroup :: Maybe Text
$sel:dbClusterParameterGroup:DBCluster' :: DBCluster -> Maybe Text
dbClusterParameterGroup} -> Maybe Text
dbClusterParameterGroup) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:dbClusterParameterGroup:DBCluster' :: Maybe Text
dbClusterParameterGroup = Maybe Text
a} :: DBCluster)

-- | Specifies information on the subnet group that is associated with the
-- cluster, including the name, description, and subnets in the subnet
-- group.
dbCluster_dbSubnetGroup :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_dbSubnetGroup :: Lens' DBCluster (Maybe Text)
dbCluster_dbSubnetGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
dbSubnetGroup :: Maybe Text
$sel:dbSubnetGroup:DBCluster' :: DBCluster -> Maybe Text
dbSubnetGroup} -> Maybe Text
dbSubnetGroup) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:dbSubnetGroup:DBCluster' :: Maybe Text
dbSubnetGroup = Maybe Text
a} :: DBCluster)

-- | The Amazon Web Services Region-unique, immutable identifier for the
-- cluster. This identifier is found in CloudTrail log entries whenever the
-- KMS key for the cluster is accessed.
dbCluster_dbClusterResourceId :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_dbClusterResourceId :: Lens' DBCluster (Maybe Text)
dbCluster_dbClusterResourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
dbClusterResourceId :: Maybe Text
$sel:dbClusterResourceId:DBCluster' :: DBCluster -> Maybe Text
dbClusterResourceId} -> Maybe Text
dbClusterResourceId) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:dbClusterResourceId:DBCluster' :: Maybe Text
dbClusterResourceId = Maybe Text
a} :: DBCluster)

-- | Specifies whether this cluster can be deleted. If @DeletionProtection@
-- is enabled, the cluster cannot be deleted unless it is modified and
-- @DeletionProtection@ is disabled. @DeletionProtection@ protects clusters
-- from being accidentally deleted.
dbCluster_deletionProtection :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Bool)
dbCluster_deletionProtection :: Lens' DBCluster (Maybe Bool)
dbCluster_deletionProtection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Bool
deletionProtection :: Maybe Bool
$sel:deletionProtection:DBCluster' :: DBCluster -> Maybe Bool
deletionProtection} -> Maybe Bool
deletionProtection) (\s :: DBCluster
s@DBCluster' {} Maybe Bool
a -> DBCluster
s {$sel:deletionProtection:DBCluster' :: Maybe Bool
deletionProtection = Maybe Bool
a} :: DBCluster)

-- | The earliest time to which a database can be restored with point-in-time
-- restore.
dbCluster_earliestRestorableTime :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.UTCTime)
dbCluster_earliestRestorableTime :: Lens' DBCluster (Maybe UTCTime)
dbCluster_earliestRestorableTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe ISO8601
earliestRestorableTime :: Maybe ISO8601
$sel:earliestRestorableTime:DBCluster' :: DBCluster -> Maybe ISO8601
earliestRestorableTime} -> Maybe ISO8601
earliestRestorableTime) (\s :: DBCluster
s@DBCluster' {} Maybe ISO8601
a -> DBCluster
s {$sel:earliestRestorableTime:DBCluster' :: Maybe ISO8601
earliestRestorableTime = Maybe ISO8601
a} :: DBCluster) 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

-- | A list of log types that this cluster is configured to export to Amazon
-- CloudWatch Logs.
dbCluster_enabledCloudwatchLogsExports :: Lens.Lens' DBCluster (Prelude.Maybe [Prelude.Text])
dbCluster_enabledCloudwatchLogsExports :: Lens' DBCluster (Maybe [Text])
dbCluster_enabledCloudwatchLogsExports = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe [Text]
enabledCloudwatchLogsExports :: Maybe [Text]
$sel:enabledCloudwatchLogsExports:DBCluster' :: DBCluster -> Maybe [Text]
enabledCloudwatchLogsExports} -> Maybe [Text]
enabledCloudwatchLogsExports) (\s :: DBCluster
s@DBCluster' {} Maybe [Text]
a -> DBCluster
s {$sel:enabledCloudwatchLogsExports:DBCluster' :: Maybe [Text]
enabledCloudwatchLogsExports = Maybe [Text]
a} :: DBCluster) 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

-- | Specifies the connection endpoint for the primary instance of the
-- cluster.
dbCluster_endpoint :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_endpoint :: Lens' DBCluster (Maybe Text)
dbCluster_endpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
endpoint :: Maybe Text
$sel:endpoint:DBCluster' :: DBCluster -> Maybe Text
endpoint} -> Maybe Text
endpoint) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:endpoint:DBCluster' :: Maybe Text
endpoint = Maybe Text
a} :: DBCluster)

-- | Provides the name of the database engine to be used for this cluster.
dbCluster_engine :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_engine :: Lens' DBCluster (Maybe Text)
dbCluster_engine = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
engine :: Maybe Text
$sel:engine:DBCluster' :: DBCluster -> Maybe Text
engine} -> Maybe Text
engine) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:engine:DBCluster' :: Maybe Text
engine = Maybe Text
a} :: DBCluster)

-- | Indicates the database engine version.
dbCluster_engineVersion :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_engineVersion :: Lens' DBCluster (Maybe Text)
dbCluster_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
engineVersion :: Maybe Text
$sel:engineVersion:DBCluster' :: DBCluster -> Maybe Text
engineVersion} -> Maybe Text
engineVersion) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:engineVersion:DBCluster' :: Maybe Text
engineVersion = Maybe Text
a} :: DBCluster)

-- | Specifies the ID that Amazon Route 53 assigns when you create a hosted
-- zone.
dbCluster_hostedZoneId :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_hostedZoneId :: Lens' DBCluster (Maybe Text)
dbCluster_hostedZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
hostedZoneId :: Maybe Text
$sel:hostedZoneId:DBCluster' :: DBCluster -> Maybe Text
hostedZoneId} -> Maybe Text
hostedZoneId) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:hostedZoneId:DBCluster' :: Maybe Text
hostedZoneId = Maybe Text
a} :: DBCluster)

-- | If @StorageEncrypted@ is @true@, the KMS key identifier for the
-- encrypted cluster.
dbCluster_kmsKeyId :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_kmsKeyId :: Lens' DBCluster (Maybe Text)
dbCluster_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:DBCluster' :: DBCluster -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:kmsKeyId:DBCluster' :: Maybe Text
kmsKeyId = Maybe Text
a} :: DBCluster)

-- | Specifies the latest time to which a database can be restored with
-- point-in-time restore.
dbCluster_latestRestorableTime :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.UTCTime)
dbCluster_latestRestorableTime :: Lens' DBCluster (Maybe UTCTime)
dbCluster_latestRestorableTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe ISO8601
latestRestorableTime :: Maybe ISO8601
$sel:latestRestorableTime:DBCluster' :: DBCluster -> Maybe ISO8601
latestRestorableTime} -> Maybe ISO8601
latestRestorableTime) (\s :: DBCluster
s@DBCluster' {} Maybe ISO8601
a -> DBCluster
s {$sel:latestRestorableTime:DBCluster' :: Maybe ISO8601
latestRestorableTime = Maybe ISO8601
a} :: DBCluster) 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

-- | Contains the master user name for the cluster.
dbCluster_masterUsername :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_masterUsername :: Lens' DBCluster (Maybe Text)
dbCluster_masterUsername = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
masterUsername :: Maybe Text
$sel:masterUsername:DBCluster' :: DBCluster -> Maybe Text
masterUsername} -> Maybe Text
masterUsername) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:masterUsername:DBCluster' :: Maybe Text
masterUsername = Maybe Text
a} :: DBCluster)

-- | Specifies whether the cluster has instances in multiple Availability
-- Zones.
dbCluster_multiAZ :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Bool)
dbCluster_multiAZ :: Lens' DBCluster (Maybe Bool)
dbCluster_multiAZ = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Bool
multiAZ :: Maybe Bool
$sel:multiAZ:DBCluster' :: DBCluster -> Maybe Bool
multiAZ} -> Maybe Bool
multiAZ) (\s :: DBCluster
s@DBCluster' {} Maybe Bool
a -> DBCluster
s {$sel:multiAZ:DBCluster' :: Maybe Bool
multiAZ = Maybe Bool
a} :: DBCluster)

-- | Specifies the progress of the operation as a percentage.
dbCluster_percentProgress :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_percentProgress :: Lens' DBCluster (Maybe Text)
dbCluster_percentProgress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
percentProgress :: Maybe Text
$sel:percentProgress:DBCluster' :: DBCluster -> Maybe Text
percentProgress} -> Maybe Text
percentProgress) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:percentProgress:DBCluster' :: Maybe Text
percentProgress = Maybe Text
a} :: DBCluster)

-- | Specifies the port that the database engine is listening on.
dbCluster_port :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Int)
dbCluster_port :: Lens' DBCluster (Maybe Int)
dbCluster_port = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Int
port :: Maybe Int
$sel:port:DBCluster' :: DBCluster -> Maybe Int
port} -> Maybe Int
port) (\s :: DBCluster
s@DBCluster' {} Maybe Int
a -> DBCluster
s {$sel:port:DBCluster' :: Maybe Int
port = Maybe Int
a} :: DBCluster)

-- | Specifies the daily time range during which automated backups are
-- created if automated backups are enabled, as determined by the
-- @BackupRetentionPeriod@.
dbCluster_preferredBackupWindow :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_preferredBackupWindow :: Lens' DBCluster (Maybe Text)
dbCluster_preferredBackupWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
preferredBackupWindow :: Maybe Text
$sel:preferredBackupWindow:DBCluster' :: DBCluster -> Maybe Text
preferredBackupWindow} -> Maybe Text
preferredBackupWindow) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:preferredBackupWindow:DBCluster' :: Maybe Text
preferredBackupWindow = Maybe Text
a} :: DBCluster)

-- | Specifies the weekly time range during which system maintenance can
-- occur, in Universal Coordinated Time (UTC).
dbCluster_preferredMaintenanceWindow :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_preferredMaintenanceWindow :: Lens' DBCluster (Maybe Text)
dbCluster_preferredMaintenanceWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
preferredMaintenanceWindow :: Maybe Text
$sel:preferredMaintenanceWindow:DBCluster' :: DBCluster -> Maybe Text
preferredMaintenanceWindow} -> Maybe Text
preferredMaintenanceWindow) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:preferredMaintenanceWindow:DBCluster' :: Maybe Text
preferredMaintenanceWindow = Maybe Text
a} :: DBCluster)

-- | Contains one or more identifiers of the secondary clusters that are
-- associated with this cluster.
dbCluster_readReplicaIdentifiers :: Lens.Lens' DBCluster (Prelude.Maybe [Prelude.Text])
dbCluster_readReplicaIdentifiers :: Lens' DBCluster (Maybe [Text])
dbCluster_readReplicaIdentifiers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe [Text]
readReplicaIdentifiers :: Maybe [Text]
$sel:readReplicaIdentifiers:DBCluster' :: DBCluster -> Maybe [Text]
readReplicaIdentifiers} -> Maybe [Text]
readReplicaIdentifiers) (\s :: DBCluster
s@DBCluster' {} Maybe [Text]
a -> DBCluster
s {$sel:readReplicaIdentifiers:DBCluster' :: Maybe [Text]
readReplicaIdentifiers = Maybe [Text]
a} :: DBCluster) 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 reader endpoint for the cluster. The reader endpoint for a cluster
-- load balances connections across the Amazon DocumentDB replicas that are
-- available in a cluster. As clients request new connections to the reader
-- endpoint, Amazon DocumentDB distributes the connection requests among
-- the Amazon DocumentDB replicas in the cluster. This functionality can
-- help balance your read workload across multiple Amazon DocumentDB
-- replicas in your cluster.
--
-- If a failover occurs, and the Amazon DocumentDB replica that you are
-- connected to is promoted to be the primary instance, your connection is
-- dropped. To continue sending your read workload to other Amazon
-- DocumentDB replicas in the cluster, you can then reconnect to the reader
-- endpoint.
dbCluster_readerEndpoint :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_readerEndpoint :: Lens' DBCluster (Maybe Text)
dbCluster_readerEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
readerEndpoint :: Maybe Text
$sel:readerEndpoint:DBCluster' :: DBCluster -> Maybe Text
readerEndpoint} -> Maybe Text
readerEndpoint) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:readerEndpoint:DBCluster' :: Maybe Text
readerEndpoint = Maybe Text
a} :: DBCluster)

-- | Contains the identifier of the source cluster if this cluster is a
-- secondary cluster.
dbCluster_replicationSourceIdentifier :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_replicationSourceIdentifier :: Lens' DBCluster (Maybe Text)
dbCluster_replicationSourceIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
replicationSourceIdentifier :: Maybe Text
$sel:replicationSourceIdentifier:DBCluster' :: DBCluster -> Maybe Text
replicationSourceIdentifier} -> Maybe Text
replicationSourceIdentifier) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:replicationSourceIdentifier:DBCluster' :: Maybe Text
replicationSourceIdentifier = Maybe Text
a} :: DBCluster)

-- | Specifies the current state of this cluster.
dbCluster_status :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Text)
dbCluster_status :: Lens' DBCluster (Maybe Text)
dbCluster_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Text
status :: Maybe Text
$sel:status:DBCluster' :: DBCluster -> Maybe Text
status} -> Maybe Text
status) (\s :: DBCluster
s@DBCluster' {} Maybe Text
a -> DBCluster
s {$sel:status:DBCluster' :: Maybe Text
status = Maybe Text
a} :: DBCluster)

-- | Specifies whether the cluster is encrypted.
dbCluster_storageEncrypted :: Lens.Lens' DBCluster (Prelude.Maybe Prelude.Bool)
dbCluster_storageEncrypted :: Lens' DBCluster (Maybe Bool)
dbCluster_storageEncrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe Bool
storageEncrypted :: Maybe Bool
$sel:storageEncrypted:DBCluster' :: DBCluster -> Maybe Bool
storageEncrypted} -> Maybe Bool
storageEncrypted) (\s :: DBCluster
s@DBCluster' {} Maybe Bool
a -> DBCluster
s {$sel:storageEncrypted:DBCluster' :: Maybe Bool
storageEncrypted = Maybe Bool
a} :: DBCluster)

-- | Provides a list of virtual private cloud (VPC) security groups that the
-- cluster belongs to.
dbCluster_vpcSecurityGroups :: Lens.Lens' DBCluster (Prelude.Maybe [VpcSecurityGroupMembership])
dbCluster_vpcSecurityGroups :: Lens' DBCluster (Maybe [VpcSecurityGroupMembership])
dbCluster_vpcSecurityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DBCluster' {Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups :: Maybe [VpcSecurityGroupMembership]
$sel:vpcSecurityGroups:DBCluster' :: DBCluster -> Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups} -> Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups) (\s :: DBCluster
s@DBCluster' {} Maybe [VpcSecurityGroupMembership]
a -> DBCluster
s {$sel:vpcSecurityGroups:DBCluster' :: Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups = Maybe [VpcSecurityGroupMembership]
a} :: DBCluster) 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

instance Data.FromXML DBCluster where
  parseXML :: [Node] -> Either String DBCluster
parseXML [Node]
x =
    Maybe [DBClusterRole]
-> Maybe [Text]
-> Maybe Int
-> Maybe Text
-> Maybe ISO8601
-> Maybe Text
-> Maybe Text
-> Maybe [DBClusterMember]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe ISO8601
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe ISO8601
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [VpcSecurityGroupMembership]
-> DBCluster
DBCluster'
      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
"AssociatedRoles"
                      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
"DBClusterRole")
                  )
      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
"AvailabilityZones"
                      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
"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
"BackupRetentionPeriod")
      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
"CloneGroupId")
      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
"DBClusterArn")
      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
"DBClusterIdentifier")
      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
"DBClusterMembers"
                      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
"DBClusterMember")
                  )
      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
"DBClusterParameterGroup")
      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
"DBSubnetGroup")
      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
"DbClusterResourceId")
      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
"DeletionProtection")
      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
"EarliestRestorableTime")
      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
"EnabledCloudwatchLogsExports"
                      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
"member")
                  )
      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
"Endpoint")
      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
"Engine")
      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
"EngineVersion")
      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
"HostedZoneId")
      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
"LatestRestorableTime")
      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
"MultiAZ")
      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
"PercentProgress")
      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
"PreferredBackupWindow")
      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
"PreferredMaintenanceWindow")
      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
"ReadReplicaIdentifiers"
                      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
"ReadReplicaIdentifier")
                  )
      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
"ReaderEndpoint")
      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
"ReplicationSourceIdentifier")
      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
"StorageEncrypted")
      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
"VpcSecurityGroups"
                      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
"VpcSecurityGroupMembership")
                  )

instance Prelude.Hashable DBCluster where
  hashWithSalt :: Int -> DBCluster -> Int
hashWithSalt Int
_salt DBCluster' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [DBClusterMember]
Maybe [DBClusterRole]
Maybe [VpcSecurityGroupMembership]
Maybe Text
Maybe ISO8601
vpcSecurityGroups :: Maybe [VpcSecurityGroupMembership]
storageEncrypted :: Maybe Bool
status :: Maybe Text
replicationSourceIdentifier :: Maybe Text
readerEndpoint :: Maybe Text
readReplicaIdentifiers :: Maybe [Text]
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
port :: Maybe Int
percentProgress :: Maybe Text
multiAZ :: Maybe Bool
masterUsername :: Maybe Text
latestRestorableTime :: Maybe ISO8601
kmsKeyId :: Maybe Text
hostedZoneId :: Maybe Text
engineVersion :: Maybe Text
engine :: Maybe Text
endpoint :: Maybe Text
enabledCloudwatchLogsExports :: Maybe [Text]
earliestRestorableTime :: Maybe ISO8601
deletionProtection :: Maybe Bool
dbClusterResourceId :: Maybe Text
dbSubnetGroup :: Maybe Text
dbClusterParameterGroup :: Maybe Text
dbClusterMembers :: Maybe [DBClusterMember]
dbClusterIdentifier :: Maybe Text
dbClusterArn :: Maybe Text
clusterCreateTime :: Maybe ISO8601
cloneGroupId :: Maybe Text
backupRetentionPeriod :: Maybe Int
availabilityZones :: Maybe [Text]
associatedRoles :: Maybe [DBClusterRole]
$sel:vpcSecurityGroups:DBCluster' :: DBCluster -> Maybe [VpcSecurityGroupMembership]
$sel:storageEncrypted:DBCluster' :: DBCluster -> Maybe Bool
$sel:status:DBCluster' :: DBCluster -> Maybe Text
$sel:replicationSourceIdentifier:DBCluster' :: DBCluster -> Maybe Text
$sel:readerEndpoint:DBCluster' :: DBCluster -> Maybe Text
$sel:readReplicaIdentifiers:DBCluster' :: DBCluster -> Maybe [Text]
$sel:preferredMaintenanceWindow:DBCluster' :: DBCluster -> Maybe Text
$sel:preferredBackupWindow:DBCluster' :: DBCluster -> Maybe Text
$sel:port:DBCluster' :: DBCluster -> Maybe Int
$sel:percentProgress:DBCluster' :: DBCluster -> Maybe Text
$sel:multiAZ:DBCluster' :: DBCluster -> Maybe Bool
$sel:masterUsername:DBCluster' :: DBCluster -> Maybe Text
$sel:latestRestorableTime:DBCluster' :: DBCluster -> Maybe ISO8601
$sel:kmsKeyId:DBCluster' :: DBCluster -> Maybe Text
$sel:hostedZoneId:DBCluster' :: DBCluster -> Maybe Text
$sel:engineVersion:DBCluster' :: DBCluster -> Maybe Text
$sel:engine:DBCluster' :: DBCluster -> Maybe Text
$sel:endpoint:DBCluster' :: DBCluster -> Maybe Text
$sel:enabledCloudwatchLogsExports:DBCluster' :: DBCluster -> Maybe [Text]
$sel:earliestRestorableTime:DBCluster' :: DBCluster -> Maybe ISO8601
$sel:deletionProtection:DBCluster' :: DBCluster -> Maybe Bool
$sel:dbClusterResourceId:DBCluster' :: DBCluster -> Maybe Text
$sel:dbSubnetGroup:DBCluster' :: DBCluster -> Maybe Text
$sel:dbClusterParameterGroup:DBCluster' :: DBCluster -> Maybe Text
$sel:dbClusterMembers:DBCluster' :: DBCluster -> Maybe [DBClusterMember]
$sel:dbClusterIdentifier:DBCluster' :: DBCluster -> Maybe Text
$sel:dbClusterArn:DBCluster' :: DBCluster -> Maybe Text
$sel:clusterCreateTime:DBCluster' :: DBCluster -> Maybe ISO8601
$sel:cloneGroupId:DBCluster' :: DBCluster -> Maybe Text
$sel:backupRetentionPeriod:DBCluster' :: DBCluster -> Maybe Int
$sel:availabilityZones:DBCluster' :: DBCluster -> Maybe [Text]
$sel:associatedRoles:DBCluster' :: DBCluster -> Maybe [DBClusterRole]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DBClusterRole]
associatedRoles
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
availabilityZones
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
backupRetentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cloneGroupId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
clusterCreateTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbClusterArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbClusterIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DBClusterMember]
dbClusterMembers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbClusterParameterGroup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbSubnetGroup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbClusterResourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
deletionProtection
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
earliestRestorableTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
enabledCloudwatchLogsExports
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
endpoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engine
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hostedZoneId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
latestRestorableTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
masterUsername
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
multiAZ
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
percentProgress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
port
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredBackupWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredMaintenanceWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
readReplicaIdentifiers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
readerEndpoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
replicationSourceIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
storageEncrypted
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups

instance Prelude.NFData DBCluster where
  rnf :: DBCluster -> ()
rnf DBCluster' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [DBClusterMember]
Maybe [DBClusterRole]
Maybe [VpcSecurityGroupMembership]
Maybe Text
Maybe ISO8601
vpcSecurityGroups :: Maybe [VpcSecurityGroupMembership]
storageEncrypted :: Maybe Bool
status :: Maybe Text
replicationSourceIdentifier :: Maybe Text
readerEndpoint :: Maybe Text
readReplicaIdentifiers :: Maybe [Text]
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
port :: Maybe Int
percentProgress :: Maybe Text
multiAZ :: Maybe Bool
masterUsername :: Maybe Text
latestRestorableTime :: Maybe ISO8601
kmsKeyId :: Maybe Text
hostedZoneId :: Maybe Text
engineVersion :: Maybe Text
engine :: Maybe Text
endpoint :: Maybe Text
enabledCloudwatchLogsExports :: Maybe [Text]
earliestRestorableTime :: Maybe ISO8601
deletionProtection :: Maybe Bool
dbClusterResourceId :: Maybe Text
dbSubnetGroup :: Maybe Text
dbClusterParameterGroup :: Maybe Text
dbClusterMembers :: Maybe [DBClusterMember]
dbClusterIdentifier :: Maybe Text
dbClusterArn :: Maybe Text
clusterCreateTime :: Maybe ISO8601
cloneGroupId :: Maybe Text
backupRetentionPeriod :: Maybe Int
availabilityZones :: Maybe [Text]
associatedRoles :: Maybe [DBClusterRole]
$sel:vpcSecurityGroups:DBCluster' :: DBCluster -> Maybe [VpcSecurityGroupMembership]
$sel:storageEncrypted:DBCluster' :: DBCluster -> Maybe Bool
$sel:status:DBCluster' :: DBCluster -> Maybe Text
$sel:replicationSourceIdentifier:DBCluster' :: DBCluster -> Maybe Text
$sel:readerEndpoint:DBCluster' :: DBCluster -> Maybe Text
$sel:readReplicaIdentifiers:DBCluster' :: DBCluster -> Maybe [Text]
$sel:preferredMaintenanceWindow:DBCluster' :: DBCluster -> Maybe Text
$sel:preferredBackupWindow:DBCluster' :: DBCluster -> Maybe Text
$sel:port:DBCluster' :: DBCluster -> Maybe Int
$sel:percentProgress:DBCluster' :: DBCluster -> Maybe Text
$sel:multiAZ:DBCluster' :: DBCluster -> Maybe Bool
$sel:masterUsername:DBCluster' :: DBCluster -> Maybe Text
$sel:latestRestorableTime:DBCluster' :: DBCluster -> Maybe ISO8601
$sel:kmsKeyId:DBCluster' :: DBCluster -> Maybe Text
$sel:hostedZoneId:DBCluster' :: DBCluster -> Maybe Text
$sel:engineVersion:DBCluster' :: DBCluster -> Maybe Text
$sel:engine:DBCluster' :: DBCluster -> Maybe Text
$sel:endpoint:DBCluster' :: DBCluster -> Maybe Text
$sel:enabledCloudwatchLogsExports:DBCluster' :: DBCluster -> Maybe [Text]
$sel:earliestRestorableTime:DBCluster' :: DBCluster -> Maybe ISO8601
$sel:deletionProtection:DBCluster' :: DBCluster -> Maybe Bool
$sel:dbClusterResourceId:DBCluster' :: DBCluster -> Maybe Text
$sel:dbSubnetGroup:DBCluster' :: DBCluster -> Maybe Text
$sel:dbClusterParameterGroup:DBCluster' :: DBCluster -> Maybe Text
$sel:dbClusterMembers:DBCluster' :: DBCluster -> Maybe [DBClusterMember]
$sel:dbClusterIdentifier:DBCluster' :: DBCluster -> Maybe Text
$sel:dbClusterArn:DBCluster' :: DBCluster -> Maybe Text
$sel:clusterCreateTime:DBCluster' :: DBCluster -> Maybe ISO8601
$sel:cloneGroupId:DBCluster' :: DBCluster -> Maybe Text
$sel:backupRetentionPeriod:DBCluster' :: DBCluster -> Maybe Int
$sel:availabilityZones:DBCluster' :: DBCluster -> Maybe [Text]
$sel:associatedRoles:DBCluster' :: DBCluster -> Maybe [DBClusterRole]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DBClusterRole]
associatedRoles
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
availabilityZones
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
backupRetentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cloneGroupId
      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
dbClusterArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbClusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [DBClusterMember]
dbClusterMembers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbClusterParameterGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbSubnetGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbClusterResourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deletionProtection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
earliestRestorableTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
enabledCloudwatchLogsExports
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
endpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engine
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hostedZoneId
      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 ISO8601
latestRestorableTime
      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 Bool
multiAZ
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
percentProgress
      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
preferredBackupWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
preferredMaintenanceWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe [Text]
readReplicaIdentifiers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
readerEndpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
replicationSourceIdentifier
      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 Bool
storageEncrypted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe [VpcSecurityGroupMembership]
vpcSecurityGroups