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

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

-- |
-- Module      : Amazonka.RDS.RestoreDBClusterToPointInTime
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Restores a DB cluster to an arbitrary point in time. Users can restore
-- to any point in time before @LatestRestorableTime@ for up to
-- @BackupRetentionPeriod@ days. The target DB cluster is created from the
-- source DB cluster with the same configuration as the original DB
-- cluster, except that the new DB cluster is created with the default DB
-- security group.
--
-- For Aurora, this action only restores the DB cluster, not the DB
-- instances for that DB cluster. You must invoke the @CreateDBInstance@
-- action to create DB instances for the restored DB cluster, specifying
-- the identifier of the restored DB cluster in @DBClusterIdentifier@. You
-- can create DB instances only after the @RestoreDBClusterToPointInTime@
-- action has completed and the DB cluster is available.
--
-- For more information on Amazon Aurora DB clusters, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/CHAP_AuroraOverview.html What is Amazon Aurora?>
-- in the /Amazon Aurora User Guide/.
--
-- For more information on Multi-AZ DB clusters, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/multi-az-db-clusters-concepts.html Multi-AZ deployments with two readable standby DB instances>
-- in the /Amazon RDS User Guide./
module Amazonka.RDS.RestoreDBClusterToPointInTime
  ( -- * Creating a Request
    RestoreDBClusterToPointInTime (..),
    newRestoreDBClusterToPointInTime,

    -- * Request Lenses
    restoreDBClusterToPointInTime_backtrackWindow,
    restoreDBClusterToPointInTime_copyTagsToSnapshot,
    restoreDBClusterToPointInTime_dbClusterInstanceClass,
    restoreDBClusterToPointInTime_dbClusterParameterGroupName,
    restoreDBClusterToPointInTime_dbSubnetGroupName,
    restoreDBClusterToPointInTime_deletionProtection,
    restoreDBClusterToPointInTime_domain,
    restoreDBClusterToPointInTime_domainIAMRoleName,
    restoreDBClusterToPointInTime_enableCloudwatchLogsExports,
    restoreDBClusterToPointInTime_enableIAMDatabaseAuthentication,
    restoreDBClusterToPointInTime_engineMode,
    restoreDBClusterToPointInTime_iops,
    restoreDBClusterToPointInTime_kmsKeyId,
    restoreDBClusterToPointInTime_networkType,
    restoreDBClusterToPointInTime_optionGroupName,
    restoreDBClusterToPointInTime_port,
    restoreDBClusterToPointInTime_publiclyAccessible,
    restoreDBClusterToPointInTime_restoreToTime,
    restoreDBClusterToPointInTime_restoreType,
    restoreDBClusterToPointInTime_scalingConfiguration,
    restoreDBClusterToPointInTime_serverlessV2ScalingConfiguration,
    restoreDBClusterToPointInTime_storageType,
    restoreDBClusterToPointInTime_tags,
    restoreDBClusterToPointInTime_useLatestRestorableTime,
    restoreDBClusterToPointInTime_vpcSecurityGroupIds,
    restoreDBClusterToPointInTime_dbClusterIdentifier,
    restoreDBClusterToPointInTime_sourceDBClusterIdentifier,

    -- * Destructuring the Response
    RestoreDBClusterToPointInTimeResponse (..),
    newRestoreDBClusterToPointInTimeResponse,

    -- * Response Lenses
    restoreDBClusterToPointInTimeResponse_dbCluster,
    restoreDBClusterToPointInTimeResponse_httpStatus,
  )
where

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

-- |
--
-- /See:/ 'newRestoreDBClusterToPointInTime' smart constructor.
data RestoreDBClusterToPointInTime = RestoreDBClusterToPointInTime'
  { -- | The target backtrack window, in seconds. To disable backtracking, set
    -- this value to 0.
    --
    -- Default: 0
    --
    -- Constraints:
    --
    -- -   If specified, this value must be set to a number from 0 to 259,200
    --     (72 hours).
    --
    -- Valid for: Aurora MySQL DB clusters only
    RestoreDBClusterToPointInTime -> Maybe Integer
backtrackWindow :: Prelude.Maybe Prelude.Integer,
    -- | A value that indicates whether to copy all tags from the restored DB
    -- cluster to snapshots of the restored DB cluster. The default is not to
    -- copy them.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterToPointInTime -> Maybe Bool
copyTagsToSnapshot :: Prelude.Maybe Prelude.Bool,
    -- | The compute and memory capacity of the each DB instance in the Multi-AZ
    -- DB cluster, for example db.m6gd.xlarge. Not all DB instance classes are
    -- available in all Amazon Web Services Regions, or for all database
    -- engines.
    --
    -- For the full list of DB instance classes, and availability for your
    -- engine, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/Concepts.DBInstanceClass.html DB instance class>
    -- in the /Amazon RDS User Guide./
    --
    -- Valid for: Multi-AZ DB clusters only
    RestoreDBClusterToPointInTime -> Maybe Text
dbClusterInstanceClass :: Prelude.Maybe Prelude.Text,
    -- | The name of the DB cluster parameter group to associate with this DB
    -- cluster. If this argument is omitted, the default DB cluster parameter
    -- group for the specified engine is used.
    --
    -- Constraints:
    --
    -- -   If supplied, must match the name of an existing DB cluster parameter
    --     group.
    --
    -- -   Must be 1 to 255 letters, numbers, or hyphens.
    --
    -- -   First character must be a letter.
    --
    -- -   Can\'t end with a hyphen or contain two consecutive hyphens.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterToPointInTime -> Maybe Text
dbClusterParameterGroupName :: Prelude.Maybe Prelude.Text,
    -- | The DB subnet group name to use for the new DB cluster.
    --
    -- Constraints: If supplied, must match the name of an existing
    -- DBSubnetGroup.
    --
    -- Example: @mydbsubnetgroup@
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterToPointInTime -> Maybe Text
dbSubnetGroupName :: Prelude.Maybe Prelude.Text,
    -- | A value that indicates whether the DB cluster has deletion protection
    -- enabled. The database can\'t be deleted when deletion protection is
    -- enabled. By default, deletion protection isn\'t enabled.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterToPointInTime -> Maybe Bool
deletionProtection :: Prelude.Maybe Prelude.Bool,
    -- | Specify the Active Directory directory ID to restore the DB cluster in.
    -- The domain must be created prior to this operation.
    --
    -- For Amazon Aurora DB clusters, Amazon RDS can use Kerberos
    -- Authentication to authenticate users that connect to the DB cluster. For
    -- more information, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/kerberos-authentication.html Kerberos Authentication>
    -- in the /Amazon Aurora User Guide/.
    --
    -- Valid for: Aurora DB clusters only
    RestoreDBClusterToPointInTime -> Maybe Text
domain :: Prelude.Maybe Prelude.Text,
    -- | Specify the name of the IAM role to be used when making API calls to the
    -- Directory Service.
    --
    -- Valid for: Aurora DB clusters only
    RestoreDBClusterToPointInTime -> Maybe Text
domainIAMRoleName :: Prelude.Maybe Prelude.Text,
    -- | The list of logs that the restored DB cluster is to export to CloudWatch
    -- Logs. The values in the list depend on the DB engine being used.
    --
    -- __RDS for MySQL__
    --
    -- Possible values are @error@, @general@, and @slowquery@.
    --
    -- __RDS for PostgreSQL__
    --
    -- Possible values are @postgresql@ and @upgrade@.
    --
    -- __Aurora MySQL__
    --
    -- Possible values are @audit@, @error@, @general@, and @slowquery@.
    --
    -- __Aurora PostgreSQL__
    --
    -- Possible value is @postgresql@.
    --
    -- For more information about exporting CloudWatch Logs for Amazon RDS, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_LogAccess.html#USER_LogAccess.Procedural.UploadtoCloudWatch Publishing Database Logs to Amazon CloudWatch Logs>
    -- in the /Amazon RDS User Guide/.
    --
    -- For more information about exporting CloudWatch Logs for Amazon Aurora,
    -- see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/USER_LogAccess.html#USER_LogAccess.Procedural.UploadtoCloudWatch Publishing Database Logs to Amazon CloudWatch Logs>
    -- in the /Amazon Aurora User Guide/.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterToPointInTime -> Maybe [Text]
enableCloudwatchLogsExports :: Prelude.Maybe [Prelude.Text],
    -- | A value that indicates whether to enable mapping of Amazon Web Services
    -- Identity and Access Management (IAM) accounts to database accounts. By
    -- default, mapping isn\'t enabled.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/UsingWithRDS.IAMDBAuth.html IAM Database Authentication>
    -- in the /Amazon Aurora User Guide/.
    --
    -- Valid for: Aurora DB clusters only
    RestoreDBClusterToPointInTime -> Maybe Bool
enableIAMDatabaseAuthentication :: Prelude.Maybe Prelude.Bool,
    -- | The engine mode of the new cluster. Specify @provisioned@ or
    -- @serverless@, depending on the type of the cluster you are creating. You
    -- can create an Aurora Serverless v1 clone from a provisioned cluster, or
    -- a provisioned clone from an Aurora Serverless v1 cluster. To create a
    -- clone that is an Aurora Serverless v1 cluster, the original cluster must
    -- be an Aurora Serverless v1 cluster or an encrypted provisioned cluster.
    --
    -- Valid for: Aurora DB clusters only
    RestoreDBClusterToPointInTime -> Maybe Text
engineMode :: Prelude.Maybe Prelude.Text,
    -- | The amount of Provisioned IOPS (input\/output operations per second) to
    -- be initially allocated for each DB instance in the Multi-AZ DB cluster.
    --
    -- For information about valid IOPS values, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/CHAP_Storage.html#USER_PIOPS Amazon RDS Provisioned IOPS storage>
    -- in the /Amazon RDS User Guide/.
    --
    -- Constraints: Must be a multiple between .5 and 50 of the storage amount
    -- for the DB instance.
    --
    -- Valid for: Multi-AZ DB clusters only
    RestoreDBClusterToPointInTime -> Maybe Int
iops :: Prelude.Maybe Prelude.Int,
    -- | The Amazon Web Services KMS key identifier to use when restoring an
    -- encrypted DB cluster from an encrypted DB cluster.
    --
    -- The Amazon Web Services KMS key identifier is the key ARN, key ID, alias
    -- ARN, or alias name for the KMS key. To use a KMS key in a different
    -- Amazon Web Services account, specify the key ARN or alias ARN.
    --
    -- You can restore to a new DB cluster and encrypt the new DB cluster with
    -- a KMS key that is different from the KMS key used to encrypt the source
    -- DB cluster. The new DB cluster is encrypted with the KMS key identified
    -- by the @KmsKeyId@ parameter.
    --
    -- If you don\'t specify a value for the @KmsKeyId@ parameter, then the
    -- following occurs:
    --
    -- -   If the DB cluster is encrypted, then the restored DB cluster is
    --     encrypted using the KMS key that was used to encrypt the source DB
    --     cluster.
    --
    -- -   If the DB cluster isn\'t encrypted, then the restored DB cluster
    --     isn\'t encrypted.
    --
    -- If @DBClusterIdentifier@ refers to a DB cluster that isn\'t encrypted,
    -- then the restore request is rejected.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterToPointInTime -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The network type of the DB cluster.
    --
    -- Valid values:
    --
    -- -   @IPV4@
    --
    -- -   @DUAL@
    --
    -- The network type is determined by the @DBSubnetGroup@ specified for the
    -- DB cluster. A @DBSubnetGroup@ can support only the IPv4 protocol or the
    -- IPv4 and the IPv6 protocols (@DUAL@).
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/USER_VPC.WorkingWithRDSInstanceinaVPC.html Working with a DB instance in a VPC>
    -- in the /Amazon Aurora User Guide./
    --
    -- Valid for: Aurora DB clusters only
    RestoreDBClusterToPointInTime -> Maybe Text
networkType :: Prelude.Maybe Prelude.Text,
    -- | The name of the option group for the new DB cluster.
    --
    -- DB clusters are associated with a default option group that can\'t be
    -- modified.
    RestoreDBClusterToPointInTime -> Maybe Text
optionGroupName :: Prelude.Maybe Prelude.Text,
    -- | The port number on which the new DB cluster accepts connections.
    --
    -- Constraints: A value from @1150-65535@.
    --
    -- Default: The default port for the engine.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterToPointInTime -> Maybe Int
port :: Prelude.Maybe Prelude.Int,
    -- | A value that indicates whether the DB cluster is publicly accessible.
    --
    -- When the DB cluster is publicly accessible, its Domain Name System (DNS)
    -- endpoint resolves to the private IP address from within the DB
    -- cluster\'s virtual private cloud (VPC). It resolves to the public IP
    -- address from outside of the DB cluster\'s VPC. Access to the DB cluster
    -- is ultimately controlled by the security group it uses. That public
    -- access is not permitted if the security group assigned to the DB cluster
    -- doesn\'t permit it.
    --
    -- When the DB cluster isn\'t publicly accessible, it is an internal DB
    -- cluster with a DNS name that resolves to a private IP address.
    --
    -- Default: The default behavior varies depending on whether
    -- @DBSubnetGroupName@ is specified.
    --
    -- If @DBSubnetGroupName@ isn\'t specified, and @PubliclyAccessible@ isn\'t
    -- specified, the following applies:
    --
    -- -   If the default VPC in the target Region doesn’t have an internet
    --     gateway attached to it, the DB cluster is private.
    --
    -- -   If the default VPC in the target Region has an internet gateway
    --     attached to it, the DB cluster is public.
    --
    -- If @DBSubnetGroupName@ is specified, and @PubliclyAccessible@ isn\'t
    -- specified, the following applies:
    --
    -- -   If the subnets are part of a VPC that doesn’t have an internet
    --     gateway attached to it, the DB cluster is private.
    --
    -- -   If the subnets are part of a VPC that has an internet gateway
    --     attached to it, the DB cluster is public.
    --
    -- Valid for: Multi-AZ DB clusters only
    RestoreDBClusterToPointInTime -> Maybe Bool
publiclyAccessible :: Prelude.Maybe Prelude.Bool,
    -- | The date and time to restore the DB cluster to.
    --
    -- Valid Values: Value must be a time in Universal Coordinated Time (UTC)
    -- format
    --
    -- Constraints:
    --
    -- -   Must be before the latest restorable time for the DB instance
    --
    -- -   Must be specified if @UseLatestRestorableTime@ parameter isn\'t
    --     provided
    --
    -- -   Can\'t be specified if the @UseLatestRestorableTime@ parameter is
    --     enabled
    --
    -- -   Can\'t be specified if the @RestoreType@ parameter is
    --     @copy-on-write@
    --
    -- Example: @2015-03-07T23:45:00Z@
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterToPointInTime -> Maybe ISO8601
restoreToTime :: Prelude.Maybe Data.ISO8601,
    -- | The type of restore to be performed. You can specify one of the
    -- following values:
    --
    -- -   @full-copy@ - The new DB cluster is restored as a full copy of the
    --     source DB cluster.
    --
    -- -   @copy-on-write@ - The new DB cluster is restored as a clone of the
    --     source DB cluster.
    --
    -- Constraints: You can\'t specify @copy-on-write@ if the engine version of
    -- the source DB cluster is earlier than 1.11.
    --
    -- If you don\'t specify a @RestoreType@ value, then the new DB cluster is
    -- restored as a full copy of the source DB cluster.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterToPointInTime -> Maybe Text
restoreType :: Prelude.Maybe Prelude.Text,
    -- | For DB clusters in @serverless@ DB engine mode, the scaling properties
    -- of the DB cluster.
    --
    -- Valid for: Aurora DB clusters only
    RestoreDBClusterToPointInTime -> Maybe ScalingConfiguration
scalingConfiguration :: Prelude.Maybe ScalingConfiguration,
    RestoreDBClusterToPointInTime
-> Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration :: Prelude.Maybe ServerlessV2ScalingConfiguration,
    -- | Specifies the storage type to be associated with the each DB instance in
    -- the Multi-AZ DB cluster.
    --
    -- Valid values: @io1@
    --
    -- When specified, a value for the @Iops@ parameter is required.
    --
    -- Default: @io1@
    --
    -- Valid for: Multi-AZ DB clusters only
    RestoreDBClusterToPointInTime -> Maybe Text
storageType :: Prelude.Maybe Prelude.Text,
    RestoreDBClusterToPointInTime -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A value that indicates whether to restore the DB cluster to the latest
    -- restorable backup time. By default, the DB cluster isn\'t restored to
    -- the latest restorable backup time.
    --
    -- Constraints: Can\'t be specified if @RestoreToTime@ parameter is
    -- provided.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterToPointInTime -> Maybe Bool
useLatestRestorableTime :: Prelude.Maybe Prelude.Bool,
    -- | A list of VPC security groups that the new DB cluster belongs to.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterToPointInTime -> Maybe [Text]
vpcSecurityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The name of the new DB cluster to be created.
    --
    -- Constraints:
    --
    -- -   Must contain from 1 to 63 letters, numbers, or hyphens
    --
    -- -   First character must be a letter
    --
    -- -   Can\'t end with a hyphen or contain two consecutive hyphens
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterToPointInTime -> Text
dbClusterIdentifier :: Prelude.Text,
    -- | The identifier of the source DB cluster from which to restore.
    --
    -- Constraints:
    --
    -- -   Must match the identifier of an existing DBCluster.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterToPointInTime -> Text
sourceDBClusterIdentifier :: Prelude.Text
  }
  deriving (RestoreDBClusterToPointInTime
-> RestoreDBClusterToPointInTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RestoreDBClusterToPointInTime
-> RestoreDBClusterToPointInTime -> Bool
$c/= :: RestoreDBClusterToPointInTime
-> RestoreDBClusterToPointInTime -> Bool
== :: RestoreDBClusterToPointInTime
-> RestoreDBClusterToPointInTime -> Bool
$c== :: RestoreDBClusterToPointInTime
-> RestoreDBClusterToPointInTime -> Bool
Prelude.Eq, ReadPrec [RestoreDBClusterToPointInTime]
ReadPrec RestoreDBClusterToPointInTime
Int -> ReadS RestoreDBClusterToPointInTime
ReadS [RestoreDBClusterToPointInTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RestoreDBClusterToPointInTime]
$creadListPrec :: ReadPrec [RestoreDBClusterToPointInTime]
readPrec :: ReadPrec RestoreDBClusterToPointInTime
$creadPrec :: ReadPrec RestoreDBClusterToPointInTime
readList :: ReadS [RestoreDBClusterToPointInTime]
$creadList :: ReadS [RestoreDBClusterToPointInTime]
readsPrec :: Int -> ReadS RestoreDBClusterToPointInTime
$creadsPrec :: Int -> ReadS RestoreDBClusterToPointInTime
Prelude.Read, Int -> RestoreDBClusterToPointInTime -> ShowS
[RestoreDBClusterToPointInTime] -> ShowS
RestoreDBClusterToPointInTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestoreDBClusterToPointInTime] -> ShowS
$cshowList :: [RestoreDBClusterToPointInTime] -> ShowS
show :: RestoreDBClusterToPointInTime -> String
$cshow :: RestoreDBClusterToPointInTime -> String
showsPrec :: Int -> RestoreDBClusterToPointInTime -> ShowS
$cshowsPrec :: Int -> RestoreDBClusterToPointInTime -> ShowS
Prelude.Show, forall x.
Rep RestoreDBClusterToPointInTime x
-> RestoreDBClusterToPointInTime
forall x.
RestoreDBClusterToPointInTime
-> Rep RestoreDBClusterToPointInTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RestoreDBClusterToPointInTime x
-> RestoreDBClusterToPointInTime
$cfrom :: forall x.
RestoreDBClusterToPointInTime
-> Rep RestoreDBClusterToPointInTime x
Prelude.Generic)

-- |
-- Create a value of 'RestoreDBClusterToPointInTime' 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:
--
-- 'backtrackWindow', 'restoreDBClusterToPointInTime_backtrackWindow' - The target backtrack window, in seconds. To disable backtracking, set
-- this value to 0.
--
-- Default: 0
--
-- Constraints:
--
-- -   If specified, this value must be set to a number from 0 to 259,200
--     (72 hours).
--
-- Valid for: Aurora MySQL DB clusters only
--
-- 'copyTagsToSnapshot', 'restoreDBClusterToPointInTime_copyTagsToSnapshot' - A value that indicates whether to copy all tags from the restored DB
-- cluster to snapshots of the restored DB cluster. The default is not to
-- copy them.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'dbClusterInstanceClass', 'restoreDBClusterToPointInTime_dbClusterInstanceClass' - The compute and memory capacity of the each DB instance in the Multi-AZ
-- DB cluster, for example db.m6gd.xlarge. Not all DB instance classes are
-- available in all Amazon Web Services Regions, or for all database
-- engines.
--
-- For the full list of DB instance classes, and availability for your
-- engine, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/Concepts.DBInstanceClass.html DB instance class>
-- in the /Amazon RDS User Guide./
--
-- Valid for: Multi-AZ DB clusters only
--
-- 'dbClusterParameterGroupName', 'restoreDBClusterToPointInTime_dbClusterParameterGroupName' - The name of the DB cluster parameter group to associate with this DB
-- cluster. If this argument is omitted, the default DB cluster parameter
-- group for the specified engine is used.
--
-- Constraints:
--
-- -   If supplied, must match the name of an existing DB cluster parameter
--     group.
--
-- -   Must be 1 to 255 letters, numbers, or hyphens.
--
-- -   First character must be a letter.
--
-- -   Can\'t end with a hyphen or contain two consecutive hyphens.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'dbSubnetGroupName', 'restoreDBClusterToPointInTime_dbSubnetGroupName' - The DB subnet group name to use for the new DB cluster.
--
-- Constraints: If supplied, must match the name of an existing
-- DBSubnetGroup.
--
-- Example: @mydbsubnetgroup@
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'deletionProtection', 'restoreDBClusterToPointInTime_deletionProtection' - A value that indicates whether the DB cluster has deletion protection
-- enabled. The database can\'t be deleted when deletion protection is
-- enabled. By default, deletion protection isn\'t enabled.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'domain', 'restoreDBClusterToPointInTime_domain' - Specify the Active Directory directory ID to restore the DB cluster in.
-- The domain must be created prior to this operation.
--
-- For Amazon Aurora DB clusters, Amazon RDS can use Kerberos
-- Authentication to authenticate users that connect to the DB cluster. For
-- more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/kerberos-authentication.html Kerberos Authentication>
-- in the /Amazon Aurora User Guide/.
--
-- Valid for: Aurora DB clusters only
--
-- 'domainIAMRoleName', 'restoreDBClusterToPointInTime_domainIAMRoleName' - Specify the name of the IAM role to be used when making API calls to the
-- Directory Service.
--
-- Valid for: Aurora DB clusters only
--
-- 'enableCloudwatchLogsExports', 'restoreDBClusterToPointInTime_enableCloudwatchLogsExports' - The list of logs that the restored DB cluster is to export to CloudWatch
-- Logs. The values in the list depend on the DB engine being used.
--
-- __RDS for MySQL__
--
-- Possible values are @error@, @general@, and @slowquery@.
--
-- __RDS for PostgreSQL__
--
-- Possible values are @postgresql@ and @upgrade@.
--
-- __Aurora MySQL__
--
-- Possible values are @audit@, @error@, @general@, and @slowquery@.
--
-- __Aurora PostgreSQL__
--
-- Possible value is @postgresql@.
--
-- For more information about exporting CloudWatch Logs for Amazon RDS, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_LogAccess.html#USER_LogAccess.Procedural.UploadtoCloudWatch Publishing Database Logs to Amazon CloudWatch Logs>
-- in the /Amazon RDS User Guide/.
--
-- For more information about exporting CloudWatch Logs for Amazon Aurora,
-- see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/USER_LogAccess.html#USER_LogAccess.Procedural.UploadtoCloudWatch Publishing Database Logs to Amazon CloudWatch Logs>
-- in the /Amazon Aurora User Guide/.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'enableIAMDatabaseAuthentication', 'restoreDBClusterToPointInTime_enableIAMDatabaseAuthentication' - A value that indicates whether to enable mapping of Amazon Web Services
-- Identity and Access Management (IAM) accounts to database accounts. By
-- default, mapping isn\'t enabled.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/UsingWithRDS.IAMDBAuth.html IAM Database Authentication>
-- in the /Amazon Aurora User Guide/.
--
-- Valid for: Aurora DB clusters only
--
-- 'engineMode', 'restoreDBClusterToPointInTime_engineMode' - The engine mode of the new cluster. Specify @provisioned@ or
-- @serverless@, depending on the type of the cluster you are creating. You
-- can create an Aurora Serverless v1 clone from a provisioned cluster, or
-- a provisioned clone from an Aurora Serverless v1 cluster. To create a
-- clone that is an Aurora Serverless v1 cluster, the original cluster must
-- be an Aurora Serverless v1 cluster or an encrypted provisioned cluster.
--
-- Valid for: Aurora DB clusters only
--
-- 'iops', 'restoreDBClusterToPointInTime_iops' - The amount of Provisioned IOPS (input\/output operations per second) to
-- be initially allocated for each DB instance in the Multi-AZ DB cluster.
--
-- For information about valid IOPS values, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/CHAP_Storage.html#USER_PIOPS Amazon RDS Provisioned IOPS storage>
-- in the /Amazon RDS User Guide/.
--
-- Constraints: Must be a multiple between .5 and 50 of the storage amount
-- for the DB instance.
--
-- Valid for: Multi-AZ DB clusters only
--
-- 'kmsKeyId', 'restoreDBClusterToPointInTime_kmsKeyId' - The Amazon Web Services KMS key identifier to use when restoring an
-- encrypted DB cluster from an encrypted DB cluster.
--
-- The Amazon Web Services KMS key identifier is the key ARN, key ID, alias
-- ARN, or alias name for the KMS key. To use a KMS key in a different
-- Amazon Web Services account, specify the key ARN or alias ARN.
--
-- You can restore to a new DB cluster and encrypt the new DB cluster with
-- a KMS key that is different from the KMS key used to encrypt the source
-- DB cluster. The new DB cluster is encrypted with the KMS key identified
-- by the @KmsKeyId@ parameter.
--
-- If you don\'t specify a value for the @KmsKeyId@ parameter, then the
-- following occurs:
--
-- -   If the DB cluster is encrypted, then the restored DB cluster is
--     encrypted using the KMS key that was used to encrypt the source DB
--     cluster.
--
-- -   If the DB cluster isn\'t encrypted, then the restored DB cluster
--     isn\'t encrypted.
--
-- If @DBClusterIdentifier@ refers to a DB cluster that isn\'t encrypted,
-- then the restore request is rejected.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'networkType', 'restoreDBClusterToPointInTime_networkType' - The network type of the DB cluster.
--
-- Valid values:
--
-- -   @IPV4@
--
-- -   @DUAL@
--
-- The network type is determined by the @DBSubnetGroup@ specified for the
-- DB cluster. A @DBSubnetGroup@ can support only the IPv4 protocol or the
-- IPv4 and the IPv6 protocols (@DUAL@).
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/USER_VPC.WorkingWithRDSInstanceinaVPC.html Working with a DB instance in a VPC>
-- in the /Amazon Aurora User Guide./
--
-- Valid for: Aurora DB clusters only
--
-- 'optionGroupName', 'restoreDBClusterToPointInTime_optionGroupName' - The name of the option group for the new DB cluster.
--
-- DB clusters are associated with a default option group that can\'t be
-- modified.
--
-- 'port', 'restoreDBClusterToPointInTime_port' - The port number on which the new DB cluster accepts connections.
--
-- Constraints: A value from @1150-65535@.
--
-- Default: The default port for the engine.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'publiclyAccessible', 'restoreDBClusterToPointInTime_publiclyAccessible' - A value that indicates whether the DB cluster is publicly accessible.
--
-- When the DB cluster is publicly accessible, its Domain Name System (DNS)
-- endpoint resolves to the private IP address from within the DB
-- cluster\'s virtual private cloud (VPC). It resolves to the public IP
-- address from outside of the DB cluster\'s VPC. Access to the DB cluster
-- is ultimately controlled by the security group it uses. That public
-- access is not permitted if the security group assigned to the DB cluster
-- doesn\'t permit it.
--
-- When the DB cluster isn\'t publicly accessible, it is an internal DB
-- cluster with a DNS name that resolves to a private IP address.
--
-- Default: The default behavior varies depending on whether
-- @DBSubnetGroupName@ is specified.
--
-- If @DBSubnetGroupName@ isn\'t specified, and @PubliclyAccessible@ isn\'t
-- specified, the following applies:
--
-- -   If the default VPC in the target Region doesn’t have an internet
--     gateway attached to it, the DB cluster is private.
--
-- -   If the default VPC in the target Region has an internet gateway
--     attached to it, the DB cluster is public.
--
-- If @DBSubnetGroupName@ is specified, and @PubliclyAccessible@ isn\'t
-- specified, the following applies:
--
-- -   If the subnets are part of a VPC that doesn’t have an internet
--     gateway attached to it, the DB cluster is private.
--
-- -   If the subnets are part of a VPC that has an internet gateway
--     attached to it, the DB cluster is public.
--
-- Valid for: Multi-AZ DB clusters only
--
-- 'restoreToTime', 'restoreDBClusterToPointInTime_restoreToTime' - The date and time to restore the DB cluster to.
--
-- Valid Values: Value must be a time in Universal Coordinated Time (UTC)
-- format
--
-- Constraints:
--
-- -   Must be before the latest restorable time for the DB instance
--
-- -   Must be specified if @UseLatestRestorableTime@ parameter isn\'t
--     provided
--
-- -   Can\'t be specified if the @UseLatestRestorableTime@ parameter is
--     enabled
--
-- -   Can\'t be specified if the @RestoreType@ parameter is
--     @copy-on-write@
--
-- Example: @2015-03-07T23:45:00Z@
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'restoreType', 'restoreDBClusterToPointInTime_restoreType' - The type of restore to be performed. You can specify one of the
-- following values:
--
-- -   @full-copy@ - The new DB cluster is restored as a full copy of the
--     source DB cluster.
--
-- -   @copy-on-write@ - The new DB cluster is restored as a clone of the
--     source DB cluster.
--
-- Constraints: You can\'t specify @copy-on-write@ if the engine version of
-- the source DB cluster is earlier than 1.11.
--
-- If you don\'t specify a @RestoreType@ value, then the new DB cluster is
-- restored as a full copy of the source DB cluster.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'scalingConfiguration', 'restoreDBClusterToPointInTime_scalingConfiguration' - For DB clusters in @serverless@ DB engine mode, the scaling properties
-- of the DB cluster.
--
-- Valid for: Aurora DB clusters only
--
-- 'serverlessV2ScalingConfiguration', 'restoreDBClusterToPointInTime_serverlessV2ScalingConfiguration' - Undocumented member.
--
-- 'storageType', 'restoreDBClusterToPointInTime_storageType' - Specifies the storage type to be associated with the each DB instance in
-- the Multi-AZ DB cluster.
--
-- Valid values: @io1@
--
-- When specified, a value for the @Iops@ parameter is required.
--
-- Default: @io1@
--
-- Valid for: Multi-AZ DB clusters only
--
-- 'tags', 'restoreDBClusterToPointInTime_tags' - Undocumented member.
--
-- 'useLatestRestorableTime', 'restoreDBClusterToPointInTime_useLatestRestorableTime' - A value that indicates whether to restore the DB cluster to the latest
-- restorable backup time. By default, the DB cluster isn\'t restored to
-- the latest restorable backup time.
--
-- Constraints: Can\'t be specified if @RestoreToTime@ parameter is
-- provided.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'vpcSecurityGroupIds', 'restoreDBClusterToPointInTime_vpcSecurityGroupIds' - A list of VPC security groups that the new DB cluster belongs to.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'dbClusterIdentifier', 'restoreDBClusterToPointInTime_dbClusterIdentifier' - The name of the new DB cluster to be created.
--
-- Constraints:
--
-- -   Must contain from 1 to 63 letters, numbers, or hyphens
--
-- -   First character must be a letter
--
-- -   Can\'t end with a hyphen or contain two consecutive hyphens
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'sourceDBClusterIdentifier', 'restoreDBClusterToPointInTime_sourceDBClusterIdentifier' - The identifier of the source DB cluster from which to restore.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DBCluster.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
newRestoreDBClusterToPointInTime ::
  -- | 'dbClusterIdentifier'
  Prelude.Text ->
  -- | 'sourceDBClusterIdentifier'
  Prelude.Text ->
  RestoreDBClusterToPointInTime
newRestoreDBClusterToPointInTime :: Text -> Text -> RestoreDBClusterToPointInTime
newRestoreDBClusterToPointInTime
  Text
pDBClusterIdentifier_
  Text
pSourceDBClusterIdentifier_ =
    RestoreDBClusterToPointInTime'
      { $sel:backtrackWindow:RestoreDBClusterToPointInTime' :: Maybe Integer
backtrackWindow =
          forall a. Maybe a
Prelude.Nothing,
        $sel:copyTagsToSnapshot:RestoreDBClusterToPointInTime' :: Maybe Bool
copyTagsToSnapshot = forall a. Maybe a
Prelude.Nothing,
        $sel:dbClusterInstanceClass:RestoreDBClusterToPointInTime' :: Maybe Text
dbClusterInstanceClass = forall a. Maybe a
Prelude.Nothing,
        $sel:dbClusterParameterGroupName:RestoreDBClusterToPointInTime' :: Maybe Text
dbClusterParameterGroupName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dbSubnetGroupName:RestoreDBClusterToPointInTime' :: Maybe Text
dbSubnetGroupName = forall a. Maybe a
Prelude.Nothing,
        $sel:deletionProtection:RestoreDBClusterToPointInTime' :: Maybe Bool
deletionProtection = forall a. Maybe a
Prelude.Nothing,
        $sel:domain:RestoreDBClusterToPointInTime' :: Maybe Text
domain = forall a. Maybe a
Prelude.Nothing,
        $sel:domainIAMRoleName:RestoreDBClusterToPointInTime' :: Maybe Text
domainIAMRoleName = forall a. Maybe a
Prelude.Nothing,
        $sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: Maybe [Text]
enableCloudwatchLogsExports =
          forall a. Maybe a
Prelude.Nothing,
        $sel:enableIAMDatabaseAuthentication:RestoreDBClusterToPointInTime' :: Maybe Bool
enableIAMDatabaseAuthentication =
          forall a. Maybe a
Prelude.Nothing,
        $sel:engineMode:RestoreDBClusterToPointInTime' :: Maybe Text
engineMode = forall a. Maybe a
Prelude.Nothing,
        $sel:iops:RestoreDBClusterToPointInTime' :: Maybe Int
iops = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:RestoreDBClusterToPointInTime' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:networkType:RestoreDBClusterToPointInTime' :: Maybe Text
networkType = forall a. Maybe a
Prelude.Nothing,
        $sel:optionGroupName:RestoreDBClusterToPointInTime' :: Maybe Text
optionGroupName = forall a. Maybe a
Prelude.Nothing,
        $sel:port:RestoreDBClusterToPointInTime' :: Maybe Int
port = forall a. Maybe a
Prelude.Nothing,
        $sel:publiclyAccessible:RestoreDBClusterToPointInTime' :: Maybe Bool
publiclyAccessible = forall a. Maybe a
Prelude.Nothing,
        $sel:restoreToTime:RestoreDBClusterToPointInTime' :: Maybe ISO8601
restoreToTime = forall a. Maybe a
Prelude.Nothing,
        $sel:restoreType:RestoreDBClusterToPointInTime' :: Maybe Text
restoreType = forall a. Maybe a
Prelude.Nothing,
        $sel:scalingConfiguration:RestoreDBClusterToPointInTime' :: Maybe ScalingConfiguration
scalingConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:serverlessV2ScalingConfiguration:RestoreDBClusterToPointInTime' :: Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration =
          forall a. Maybe a
Prelude.Nothing,
        $sel:storageType:RestoreDBClusterToPointInTime' :: Maybe Text
storageType = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:RestoreDBClusterToPointInTime' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:useLatestRestorableTime:RestoreDBClusterToPointInTime' :: Maybe Bool
useLatestRestorableTime = forall a. Maybe a
Prelude.Nothing,
        $sel:vpcSecurityGroupIds:RestoreDBClusterToPointInTime' :: Maybe [Text]
vpcSecurityGroupIds = forall a. Maybe a
Prelude.Nothing,
        $sel:dbClusterIdentifier:RestoreDBClusterToPointInTime' :: Text
dbClusterIdentifier = Text
pDBClusterIdentifier_,
        $sel:sourceDBClusterIdentifier:RestoreDBClusterToPointInTime' :: Text
sourceDBClusterIdentifier =
          Text
pSourceDBClusterIdentifier_
      }

-- | The target backtrack window, in seconds. To disable backtracking, set
-- this value to 0.
--
-- Default: 0
--
-- Constraints:
--
-- -   If specified, this value must be set to a number from 0 to 259,200
--     (72 hours).
--
-- Valid for: Aurora MySQL DB clusters only
restoreDBClusterToPointInTime_backtrackWindow :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Integer)
restoreDBClusterToPointInTime_backtrackWindow :: Lens' RestoreDBClusterToPointInTime (Maybe Integer)
restoreDBClusterToPointInTime_backtrackWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Integer
backtrackWindow :: Maybe Integer
$sel:backtrackWindow:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Integer
backtrackWindow} -> Maybe Integer
backtrackWindow) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Integer
a -> RestoreDBClusterToPointInTime
s {$sel:backtrackWindow:RestoreDBClusterToPointInTime' :: Maybe Integer
backtrackWindow = Maybe Integer
a} :: RestoreDBClusterToPointInTime)

-- | A value that indicates whether to copy all tags from the restored DB
-- cluster to snapshots of the restored DB cluster. The default is not to
-- copy them.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterToPointInTime_copyTagsToSnapshot :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Bool)
restoreDBClusterToPointInTime_copyTagsToSnapshot :: Lens' RestoreDBClusterToPointInTime (Maybe Bool)
restoreDBClusterToPointInTime_copyTagsToSnapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Bool
copyTagsToSnapshot :: Maybe Bool
$sel:copyTagsToSnapshot:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
copyTagsToSnapshot} -> Maybe Bool
copyTagsToSnapshot) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Bool
a -> RestoreDBClusterToPointInTime
s {$sel:copyTagsToSnapshot:RestoreDBClusterToPointInTime' :: Maybe Bool
copyTagsToSnapshot = Maybe Bool
a} :: RestoreDBClusterToPointInTime)

-- | The compute and memory capacity of the each DB instance in the Multi-AZ
-- DB cluster, for example db.m6gd.xlarge. Not all DB instance classes are
-- available in all Amazon Web Services Regions, or for all database
-- engines.
--
-- For the full list of DB instance classes, and availability for your
-- engine, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/Concepts.DBInstanceClass.html DB instance class>
-- in the /Amazon RDS User Guide./
--
-- Valid for: Multi-AZ DB clusters only
restoreDBClusterToPointInTime_dbClusterInstanceClass :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_dbClusterInstanceClass :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_dbClusterInstanceClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
dbClusterInstanceClass :: Maybe Text
$sel:dbClusterInstanceClass:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
dbClusterInstanceClass} -> Maybe Text
dbClusterInstanceClass) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:dbClusterInstanceClass:RestoreDBClusterToPointInTime' :: Maybe Text
dbClusterInstanceClass = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | The name of the DB cluster parameter group to associate with this DB
-- cluster. If this argument is omitted, the default DB cluster parameter
-- group for the specified engine is used.
--
-- Constraints:
--
-- -   If supplied, must match the name of an existing DB cluster parameter
--     group.
--
-- -   Must be 1 to 255 letters, numbers, or hyphens.
--
-- -   First character must be a letter.
--
-- -   Can\'t end with a hyphen or contain two consecutive hyphens.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterToPointInTime_dbClusterParameterGroupName :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_dbClusterParameterGroupName :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_dbClusterParameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
dbClusterParameterGroupName :: Maybe Text
$sel:dbClusterParameterGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
dbClusterParameterGroupName} -> Maybe Text
dbClusterParameterGroupName) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:dbClusterParameterGroupName:RestoreDBClusterToPointInTime' :: Maybe Text
dbClusterParameterGroupName = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | The DB subnet group name to use for the new DB cluster.
--
-- Constraints: If supplied, must match the name of an existing
-- DBSubnetGroup.
--
-- Example: @mydbsubnetgroup@
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterToPointInTime_dbSubnetGroupName :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_dbSubnetGroupName :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_dbSubnetGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
dbSubnetGroupName :: Maybe Text
$sel:dbSubnetGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
dbSubnetGroupName} -> Maybe Text
dbSubnetGroupName) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:dbSubnetGroupName:RestoreDBClusterToPointInTime' :: Maybe Text
dbSubnetGroupName = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | A value that indicates whether the DB cluster has deletion protection
-- enabled. The database can\'t be deleted when deletion protection is
-- enabled. By default, deletion protection isn\'t enabled.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterToPointInTime_deletionProtection :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Bool)
restoreDBClusterToPointInTime_deletionProtection :: Lens' RestoreDBClusterToPointInTime (Maybe Bool)
restoreDBClusterToPointInTime_deletionProtection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Bool
deletionProtection :: Maybe Bool
$sel:deletionProtection:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
deletionProtection} -> Maybe Bool
deletionProtection) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Bool
a -> RestoreDBClusterToPointInTime
s {$sel:deletionProtection:RestoreDBClusterToPointInTime' :: Maybe Bool
deletionProtection = Maybe Bool
a} :: RestoreDBClusterToPointInTime)

-- | Specify the Active Directory directory ID to restore the DB cluster in.
-- The domain must be created prior to this operation.
--
-- For Amazon Aurora DB clusters, Amazon RDS can use Kerberos
-- Authentication to authenticate users that connect to the DB cluster. For
-- more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/kerberos-authentication.html Kerberos Authentication>
-- in the /Amazon Aurora User Guide/.
--
-- Valid for: Aurora DB clusters only
restoreDBClusterToPointInTime_domain :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_domain :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
domain :: Maybe Text
$sel:domain:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
domain} -> Maybe Text
domain) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:domain:RestoreDBClusterToPointInTime' :: Maybe Text
domain = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | Specify the name of the IAM role to be used when making API calls to the
-- Directory Service.
--
-- Valid for: Aurora DB clusters only
restoreDBClusterToPointInTime_domainIAMRoleName :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_domainIAMRoleName :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_domainIAMRoleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
domainIAMRoleName :: Maybe Text
$sel:domainIAMRoleName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
domainIAMRoleName} -> Maybe Text
domainIAMRoleName) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:domainIAMRoleName:RestoreDBClusterToPointInTime' :: Maybe Text
domainIAMRoleName = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | The list of logs that the restored DB cluster is to export to CloudWatch
-- Logs. The values in the list depend on the DB engine being used.
--
-- __RDS for MySQL__
--
-- Possible values are @error@, @general@, and @slowquery@.
--
-- __RDS for PostgreSQL__
--
-- Possible values are @postgresql@ and @upgrade@.
--
-- __Aurora MySQL__
--
-- Possible values are @audit@, @error@, @general@, and @slowquery@.
--
-- __Aurora PostgreSQL__
--
-- Possible value is @postgresql@.
--
-- For more information about exporting CloudWatch Logs for Amazon RDS, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_LogAccess.html#USER_LogAccess.Procedural.UploadtoCloudWatch Publishing Database Logs to Amazon CloudWatch Logs>
-- in the /Amazon RDS User Guide/.
--
-- For more information about exporting CloudWatch Logs for Amazon Aurora,
-- see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/USER_LogAccess.html#USER_LogAccess.Procedural.UploadtoCloudWatch Publishing Database Logs to Amazon CloudWatch Logs>
-- in the /Amazon Aurora User Guide/.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterToPointInTime_enableCloudwatchLogsExports :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe [Prelude.Text])
restoreDBClusterToPointInTime_enableCloudwatchLogsExports :: Lens' RestoreDBClusterToPointInTime (Maybe [Text])
restoreDBClusterToPointInTime_enableCloudwatchLogsExports = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe [Text]
enableCloudwatchLogsExports :: Maybe [Text]
$sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
enableCloudwatchLogsExports} -> Maybe [Text]
enableCloudwatchLogsExports) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe [Text]
a -> RestoreDBClusterToPointInTime
s {$sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: Maybe [Text]
enableCloudwatchLogsExports = Maybe [Text]
a} :: RestoreDBClusterToPointInTime) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A value that indicates whether to enable mapping of Amazon Web Services
-- Identity and Access Management (IAM) accounts to database accounts. By
-- default, mapping isn\'t enabled.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/UsingWithRDS.IAMDBAuth.html IAM Database Authentication>
-- in the /Amazon Aurora User Guide/.
--
-- Valid for: Aurora DB clusters only
restoreDBClusterToPointInTime_enableIAMDatabaseAuthentication :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Bool)
restoreDBClusterToPointInTime_enableIAMDatabaseAuthentication :: Lens' RestoreDBClusterToPointInTime (Maybe Bool)
restoreDBClusterToPointInTime_enableIAMDatabaseAuthentication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Bool
enableIAMDatabaseAuthentication :: Maybe Bool
$sel:enableIAMDatabaseAuthentication:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
enableIAMDatabaseAuthentication} -> Maybe Bool
enableIAMDatabaseAuthentication) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Bool
a -> RestoreDBClusterToPointInTime
s {$sel:enableIAMDatabaseAuthentication:RestoreDBClusterToPointInTime' :: Maybe Bool
enableIAMDatabaseAuthentication = Maybe Bool
a} :: RestoreDBClusterToPointInTime)

-- | The engine mode of the new cluster. Specify @provisioned@ or
-- @serverless@, depending on the type of the cluster you are creating. You
-- can create an Aurora Serverless v1 clone from a provisioned cluster, or
-- a provisioned clone from an Aurora Serverless v1 cluster. To create a
-- clone that is an Aurora Serverless v1 cluster, the original cluster must
-- be an Aurora Serverless v1 cluster or an encrypted provisioned cluster.
--
-- Valid for: Aurora DB clusters only
restoreDBClusterToPointInTime_engineMode :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_engineMode :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_engineMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
engineMode :: Maybe Text
$sel:engineMode:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
engineMode} -> Maybe Text
engineMode) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:engineMode:RestoreDBClusterToPointInTime' :: Maybe Text
engineMode = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | The amount of Provisioned IOPS (input\/output operations per second) to
-- be initially allocated for each DB instance in the Multi-AZ DB cluster.
--
-- For information about valid IOPS values, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/CHAP_Storage.html#USER_PIOPS Amazon RDS Provisioned IOPS storage>
-- in the /Amazon RDS User Guide/.
--
-- Constraints: Must be a multiple between .5 and 50 of the storage amount
-- for the DB instance.
--
-- Valid for: Multi-AZ DB clusters only
restoreDBClusterToPointInTime_iops :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Int)
restoreDBClusterToPointInTime_iops :: Lens' RestoreDBClusterToPointInTime (Maybe Int)
restoreDBClusterToPointInTime_iops = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Int
iops :: Maybe Int
$sel:iops:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
iops} -> Maybe Int
iops) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Int
a -> RestoreDBClusterToPointInTime
s {$sel:iops:RestoreDBClusterToPointInTime' :: Maybe Int
iops = Maybe Int
a} :: RestoreDBClusterToPointInTime)

-- | The Amazon Web Services KMS key identifier to use when restoring an
-- encrypted DB cluster from an encrypted DB cluster.
--
-- The Amazon Web Services KMS key identifier is the key ARN, key ID, alias
-- ARN, or alias name for the KMS key. To use a KMS key in a different
-- Amazon Web Services account, specify the key ARN or alias ARN.
--
-- You can restore to a new DB cluster and encrypt the new DB cluster with
-- a KMS key that is different from the KMS key used to encrypt the source
-- DB cluster. The new DB cluster is encrypted with the KMS key identified
-- by the @KmsKeyId@ parameter.
--
-- If you don\'t specify a value for the @KmsKeyId@ parameter, then the
-- following occurs:
--
-- -   If the DB cluster is encrypted, then the restored DB cluster is
--     encrypted using the KMS key that was used to encrypt the source DB
--     cluster.
--
-- -   If the DB cluster isn\'t encrypted, then the restored DB cluster
--     isn\'t encrypted.
--
-- If @DBClusterIdentifier@ refers to a DB cluster that isn\'t encrypted,
-- then the restore request is rejected.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterToPointInTime_kmsKeyId :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_kmsKeyId :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:kmsKeyId:RestoreDBClusterToPointInTime' :: Maybe Text
kmsKeyId = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | The network type of the DB cluster.
--
-- Valid values:
--
-- -   @IPV4@
--
-- -   @DUAL@
--
-- The network type is determined by the @DBSubnetGroup@ specified for the
-- DB cluster. A @DBSubnetGroup@ can support only the IPv4 protocol or the
-- IPv4 and the IPv6 protocols (@DUAL@).
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/USER_VPC.WorkingWithRDSInstanceinaVPC.html Working with a DB instance in a VPC>
-- in the /Amazon Aurora User Guide./
--
-- Valid for: Aurora DB clusters only
restoreDBClusterToPointInTime_networkType :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_networkType :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_networkType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
networkType :: Maybe Text
$sel:networkType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
networkType} -> Maybe Text
networkType) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:networkType:RestoreDBClusterToPointInTime' :: Maybe Text
networkType = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | The name of the option group for the new DB cluster.
--
-- DB clusters are associated with a default option group that can\'t be
-- modified.
restoreDBClusterToPointInTime_optionGroupName :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_optionGroupName :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_optionGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
optionGroupName :: Maybe Text
$sel:optionGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
optionGroupName} -> Maybe Text
optionGroupName) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:optionGroupName:RestoreDBClusterToPointInTime' :: Maybe Text
optionGroupName = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | The port number on which the new DB cluster accepts connections.
--
-- Constraints: A value from @1150-65535@.
--
-- Default: The default port for the engine.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterToPointInTime_port :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Int)
restoreDBClusterToPointInTime_port :: Lens' RestoreDBClusterToPointInTime (Maybe Int)
restoreDBClusterToPointInTime_port = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Int
port :: Maybe Int
$sel:port:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
port} -> Maybe Int
port) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Int
a -> RestoreDBClusterToPointInTime
s {$sel:port:RestoreDBClusterToPointInTime' :: Maybe Int
port = Maybe Int
a} :: RestoreDBClusterToPointInTime)

-- | A value that indicates whether the DB cluster is publicly accessible.
--
-- When the DB cluster is publicly accessible, its Domain Name System (DNS)
-- endpoint resolves to the private IP address from within the DB
-- cluster\'s virtual private cloud (VPC). It resolves to the public IP
-- address from outside of the DB cluster\'s VPC. Access to the DB cluster
-- is ultimately controlled by the security group it uses. That public
-- access is not permitted if the security group assigned to the DB cluster
-- doesn\'t permit it.
--
-- When the DB cluster isn\'t publicly accessible, it is an internal DB
-- cluster with a DNS name that resolves to a private IP address.
--
-- Default: The default behavior varies depending on whether
-- @DBSubnetGroupName@ is specified.
--
-- If @DBSubnetGroupName@ isn\'t specified, and @PubliclyAccessible@ isn\'t
-- specified, the following applies:
--
-- -   If the default VPC in the target Region doesn’t have an internet
--     gateway attached to it, the DB cluster is private.
--
-- -   If the default VPC in the target Region has an internet gateway
--     attached to it, the DB cluster is public.
--
-- If @DBSubnetGroupName@ is specified, and @PubliclyAccessible@ isn\'t
-- specified, the following applies:
--
-- -   If the subnets are part of a VPC that doesn’t have an internet
--     gateway attached to it, the DB cluster is private.
--
-- -   If the subnets are part of a VPC that has an internet gateway
--     attached to it, the DB cluster is public.
--
-- Valid for: Multi-AZ DB clusters only
restoreDBClusterToPointInTime_publiclyAccessible :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Bool)
restoreDBClusterToPointInTime_publiclyAccessible :: Lens' RestoreDBClusterToPointInTime (Maybe Bool)
restoreDBClusterToPointInTime_publiclyAccessible = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Bool
publiclyAccessible :: Maybe Bool
$sel:publiclyAccessible:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
publiclyAccessible} -> Maybe Bool
publiclyAccessible) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Bool
a -> RestoreDBClusterToPointInTime
s {$sel:publiclyAccessible:RestoreDBClusterToPointInTime' :: Maybe Bool
publiclyAccessible = Maybe Bool
a} :: RestoreDBClusterToPointInTime)

-- | The date and time to restore the DB cluster to.
--
-- Valid Values: Value must be a time in Universal Coordinated Time (UTC)
-- format
--
-- Constraints:
--
-- -   Must be before the latest restorable time for the DB instance
--
-- -   Must be specified if @UseLatestRestorableTime@ parameter isn\'t
--     provided
--
-- -   Can\'t be specified if the @UseLatestRestorableTime@ parameter is
--     enabled
--
-- -   Can\'t be specified if the @RestoreType@ parameter is
--     @copy-on-write@
--
-- Example: @2015-03-07T23:45:00Z@
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterToPointInTime_restoreToTime :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.UTCTime)
restoreDBClusterToPointInTime_restoreToTime :: Lens' RestoreDBClusterToPointInTime (Maybe UTCTime)
restoreDBClusterToPointInTime_restoreToTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe ISO8601
restoreToTime :: Maybe ISO8601
$sel:restoreToTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ISO8601
restoreToTime} -> Maybe ISO8601
restoreToTime) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe ISO8601
a -> RestoreDBClusterToPointInTime
s {$sel:restoreToTime:RestoreDBClusterToPointInTime' :: Maybe ISO8601
restoreToTime = Maybe ISO8601
a} :: RestoreDBClusterToPointInTime) 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 type of restore to be performed. You can specify one of the
-- following values:
--
-- -   @full-copy@ - The new DB cluster is restored as a full copy of the
--     source DB cluster.
--
-- -   @copy-on-write@ - The new DB cluster is restored as a clone of the
--     source DB cluster.
--
-- Constraints: You can\'t specify @copy-on-write@ if the engine version of
-- the source DB cluster is earlier than 1.11.
--
-- If you don\'t specify a @RestoreType@ value, then the new DB cluster is
-- restored as a full copy of the source DB cluster.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterToPointInTime_restoreType :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_restoreType :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_restoreType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
restoreType :: Maybe Text
$sel:restoreType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
restoreType} -> Maybe Text
restoreType) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:restoreType:RestoreDBClusterToPointInTime' :: Maybe Text
restoreType = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | For DB clusters in @serverless@ DB engine mode, the scaling properties
-- of the DB cluster.
--
-- Valid for: Aurora DB clusters only
restoreDBClusterToPointInTime_scalingConfiguration :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe ScalingConfiguration)
restoreDBClusterToPointInTime_scalingConfiguration :: Lens' RestoreDBClusterToPointInTime (Maybe ScalingConfiguration)
restoreDBClusterToPointInTime_scalingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe ScalingConfiguration
scalingConfiguration :: Maybe ScalingConfiguration
$sel:scalingConfiguration:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ScalingConfiguration
scalingConfiguration} -> Maybe ScalingConfiguration
scalingConfiguration) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe ScalingConfiguration
a -> RestoreDBClusterToPointInTime
s {$sel:scalingConfiguration:RestoreDBClusterToPointInTime' :: Maybe ScalingConfiguration
scalingConfiguration = Maybe ScalingConfiguration
a} :: RestoreDBClusterToPointInTime)

-- | Undocumented member.
restoreDBClusterToPointInTime_serverlessV2ScalingConfiguration :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe ServerlessV2ScalingConfiguration)
restoreDBClusterToPointInTime_serverlessV2ScalingConfiguration :: Lens'
  RestoreDBClusterToPointInTime
  (Maybe ServerlessV2ScalingConfiguration)
restoreDBClusterToPointInTime_serverlessV2ScalingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration :: Maybe ServerlessV2ScalingConfiguration
$sel:serverlessV2ScalingConfiguration:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime
-> Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration} -> Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe ServerlessV2ScalingConfiguration
a -> RestoreDBClusterToPointInTime
s {$sel:serverlessV2ScalingConfiguration:RestoreDBClusterToPointInTime' :: Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration = Maybe ServerlessV2ScalingConfiguration
a} :: RestoreDBClusterToPointInTime)

-- | Specifies the storage type to be associated with the each DB instance in
-- the Multi-AZ DB cluster.
--
-- Valid values: @io1@
--
-- When specified, a value for the @Iops@ parameter is required.
--
-- Default: @io1@
--
-- Valid for: Multi-AZ DB clusters only
restoreDBClusterToPointInTime_storageType :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_storageType :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_storageType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
storageType :: Maybe Text
$sel:storageType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
storageType} -> Maybe Text
storageType) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:storageType:RestoreDBClusterToPointInTime' :: Maybe Text
storageType = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | Undocumented member.
restoreDBClusterToPointInTime_tags :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe [Tag])
restoreDBClusterToPointInTime_tags :: Lens' RestoreDBClusterToPointInTime (Maybe [Tag])
restoreDBClusterToPointInTime_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe [Tag]
a -> RestoreDBClusterToPointInTime
s {$sel:tags:RestoreDBClusterToPointInTime' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: RestoreDBClusterToPointInTime) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A value that indicates whether to restore the DB cluster to the latest
-- restorable backup time. By default, the DB cluster isn\'t restored to
-- the latest restorable backup time.
--
-- Constraints: Can\'t be specified if @RestoreToTime@ parameter is
-- provided.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterToPointInTime_useLatestRestorableTime :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Bool)
restoreDBClusterToPointInTime_useLatestRestorableTime :: Lens' RestoreDBClusterToPointInTime (Maybe Bool)
restoreDBClusterToPointInTime_useLatestRestorableTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Bool
useLatestRestorableTime :: Maybe Bool
$sel:useLatestRestorableTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
useLatestRestorableTime} -> Maybe Bool
useLatestRestorableTime) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Bool
a -> RestoreDBClusterToPointInTime
s {$sel:useLatestRestorableTime:RestoreDBClusterToPointInTime' :: Maybe Bool
useLatestRestorableTime = Maybe Bool
a} :: RestoreDBClusterToPointInTime)

-- | A list of VPC security groups that the new DB cluster belongs to.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterToPointInTime_vpcSecurityGroupIds :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe [Prelude.Text])
restoreDBClusterToPointInTime_vpcSecurityGroupIds :: Lens' RestoreDBClusterToPointInTime (Maybe [Text])
restoreDBClusterToPointInTime_vpcSecurityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe [Text]
vpcSecurityGroupIds :: Maybe [Text]
$sel:vpcSecurityGroupIds:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
vpcSecurityGroupIds} -> Maybe [Text]
vpcSecurityGroupIds) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe [Text]
a -> RestoreDBClusterToPointInTime
s {$sel:vpcSecurityGroupIds:RestoreDBClusterToPointInTime' :: Maybe [Text]
vpcSecurityGroupIds = Maybe [Text]
a} :: RestoreDBClusterToPointInTime) 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 name of the new DB cluster to be created.
--
-- Constraints:
--
-- -   Must contain from 1 to 63 letters, numbers, or hyphens
--
-- -   First character must be a letter
--
-- -   Can\'t end with a hyphen or contain two consecutive hyphens
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterToPointInTime_dbClusterIdentifier :: Lens.Lens' RestoreDBClusterToPointInTime Prelude.Text
restoreDBClusterToPointInTime_dbClusterIdentifier :: Lens' RestoreDBClusterToPointInTime Text
restoreDBClusterToPointInTime_dbClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Text
dbClusterIdentifier :: Text
$sel:dbClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
dbClusterIdentifier} -> Text
dbClusterIdentifier) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Text
a -> RestoreDBClusterToPointInTime
s {$sel:dbClusterIdentifier:RestoreDBClusterToPointInTime' :: Text
dbClusterIdentifier = Text
a} :: RestoreDBClusterToPointInTime)

-- | The identifier of the source DB cluster from which to restore.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DBCluster.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterToPointInTime_sourceDBClusterIdentifier :: Lens.Lens' RestoreDBClusterToPointInTime Prelude.Text
restoreDBClusterToPointInTime_sourceDBClusterIdentifier :: Lens' RestoreDBClusterToPointInTime Text
restoreDBClusterToPointInTime_sourceDBClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Text
sourceDBClusterIdentifier :: Text
$sel:sourceDBClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
sourceDBClusterIdentifier} -> Text
sourceDBClusterIdentifier) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Text
a -> RestoreDBClusterToPointInTime
s {$sel:sourceDBClusterIdentifier:RestoreDBClusterToPointInTime' :: Text
sourceDBClusterIdentifier = Text
a} :: RestoreDBClusterToPointInTime)

instance
  Core.AWSRequest
    RestoreDBClusterToPointInTime
  where
  type
    AWSResponse RestoreDBClusterToPointInTime =
      RestoreDBClusterToPointInTimeResponse
  request :: (Service -> Service)
-> RestoreDBClusterToPointInTime
-> Request RestoreDBClusterToPointInTime
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy RestoreDBClusterToPointInTime
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RestoreDBClusterToPointInTime)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"RestoreDBClusterToPointInTimeResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBCluster -> Int -> RestoreDBClusterToPointInTimeResponse
RestoreDBClusterToPointInTimeResponse'
            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
"DBCluster")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance
  Prelude.Hashable
    RestoreDBClusterToPointInTime
  where
  hashWithSalt :: Int -> RestoreDBClusterToPointInTime -> Int
hashWithSalt Int
_salt RestoreDBClusterToPointInTime' {Maybe Bool
Maybe Int
Maybe Integer
Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe ScalingConfiguration
Maybe ServerlessV2ScalingConfiguration
Text
sourceDBClusterIdentifier :: Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
useLatestRestorableTime :: Maybe Bool
tags :: Maybe [Tag]
storageType :: Maybe Text
serverlessV2ScalingConfiguration :: Maybe ServerlessV2ScalingConfiguration
scalingConfiguration :: Maybe ScalingConfiguration
restoreType :: Maybe Text
restoreToTime :: Maybe ISO8601
publiclyAccessible :: Maybe Bool
port :: Maybe Int
optionGroupName :: Maybe Text
networkType :: Maybe Text
kmsKeyId :: Maybe Text
iops :: Maybe Int
engineMode :: Maybe Text
enableIAMDatabaseAuthentication :: Maybe Bool
enableCloudwatchLogsExports :: Maybe [Text]
domainIAMRoleName :: Maybe Text
domain :: Maybe Text
deletionProtection :: Maybe Bool
dbSubnetGroupName :: Maybe Text
dbClusterParameterGroupName :: Maybe Text
dbClusterInstanceClass :: Maybe Text
copyTagsToSnapshot :: Maybe Bool
backtrackWindow :: Maybe Integer
$sel:sourceDBClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
$sel:dbClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
$sel:vpcSecurityGroupIds:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:useLatestRestorableTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:tags:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Tag]
$sel:storageType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:serverlessV2ScalingConfiguration:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime
-> Maybe ServerlessV2ScalingConfiguration
$sel:scalingConfiguration:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ScalingConfiguration
$sel:restoreType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:restoreToTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ISO8601
$sel:publiclyAccessible:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:port:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
$sel:optionGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:networkType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:kmsKeyId:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:iops:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
$sel:engineMode:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:enableIAMDatabaseAuthentication:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:domainIAMRoleName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:domain:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:deletionProtection:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:dbSubnetGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:dbClusterParameterGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:dbClusterInstanceClass:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:copyTagsToSnapshot:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:backtrackWindow:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Integer
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
backtrackWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
copyTagsToSnapshot
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbClusterInstanceClass
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbClusterParameterGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbSubnetGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
deletionProtection
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
domain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
domainIAMRoleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
enableCloudwatchLogsExports
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableIAMDatabaseAuthentication
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
iops
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
networkType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
optionGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
port
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
publiclyAccessible
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
restoreToTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
restoreType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ScalingConfiguration
scalingConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
storageType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
useLatestRestorableTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
vpcSecurityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbClusterIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceDBClusterIdentifier

instance Prelude.NFData RestoreDBClusterToPointInTime where
  rnf :: RestoreDBClusterToPointInTime -> ()
rnf RestoreDBClusterToPointInTime' {Maybe Bool
Maybe Int
Maybe Integer
Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe ScalingConfiguration
Maybe ServerlessV2ScalingConfiguration
Text
sourceDBClusterIdentifier :: Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
useLatestRestorableTime :: Maybe Bool
tags :: Maybe [Tag]
storageType :: Maybe Text
serverlessV2ScalingConfiguration :: Maybe ServerlessV2ScalingConfiguration
scalingConfiguration :: Maybe ScalingConfiguration
restoreType :: Maybe Text
restoreToTime :: Maybe ISO8601
publiclyAccessible :: Maybe Bool
port :: Maybe Int
optionGroupName :: Maybe Text
networkType :: Maybe Text
kmsKeyId :: Maybe Text
iops :: Maybe Int
engineMode :: Maybe Text
enableIAMDatabaseAuthentication :: Maybe Bool
enableCloudwatchLogsExports :: Maybe [Text]
domainIAMRoleName :: Maybe Text
domain :: Maybe Text
deletionProtection :: Maybe Bool
dbSubnetGroupName :: Maybe Text
dbClusterParameterGroupName :: Maybe Text
dbClusterInstanceClass :: Maybe Text
copyTagsToSnapshot :: Maybe Bool
backtrackWindow :: Maybe Integer
$sel:sourceDBClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
$sel:dbClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
$sel:vpcSecurityGroupIds:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:useLatestRestorableTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:tags:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Tag]
$sel:storageType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:serverlessV2ScalingConfiguration:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime
-> Maybe ServerlessV2ScalingConfiguration
$sel:scalingConfiguration:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ScalingConfiguration
$sel:restoreType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:restoreToTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ISO8601
$sel:publiclyAccessible:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:port:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
$sel:optionGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:networkType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:kmsKeyId:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:iops:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
$sel:engineMode:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:enableIAMDatabaseAuthentication:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:domainIAMRoleName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:domain:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:deletionProtection:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:dbSubnetGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:dbClusterParameterGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:dbClusterInstanceClass:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:copyTagsToSnapshot:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:backtrackWindow:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Integer
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
backtrackWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
copyTagsToSnapshot
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbClusterInstanceClass
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbClusterParameterGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbSubnetGroupName
      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 Text
domain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainIAMRoleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
enableCloudwatchLogsExports
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableIAMDatabaseAuthentication
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
iops
      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
networkType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
optionGroupName
      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 Bool
publiclyAccessible
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
restoreToTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
restoreType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe ScalingConfiguration
scalingConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
storageType
      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 Bool
useLatestRestorableTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe [Text]
vpcSecurityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Text
dbClusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Text
sourceDBClusterIdentifier

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

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

instance Data.ToQuery RestoreDBClusterToPointInTime where
  toQuery :: RestoreDBClusterToPointInTime -> QueryString
toQuery RestoreDBClusterToPointInTime' {Maybe Bool
Maybe Int
Maybe Integer
Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe ScalingConfiguration
Maybe ServerlessV2ScalingConfiguration
Text
sourceDBClusterIdentifier :: Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
useLatestRestorableTime :: Maybe Bool
tags :: Maybe [Tag]
storageType :: Maybe Text
serverlessV2ScalingConfiguration :: Maybe ServerlessV2ScalingConfiguration
scalingConfiguration :: Maybe ScalingConfiguration
restoreType :: Maybe Text
restoreToTime :: Maybe ISO8601
publiclyAccessible :: Maybe Bool
port :: Maybe Int
optionGroupName :: Maybe Text
networkType :: Maybe Text
kmsKeyId :: Maybe Text
iops :: Maybe Int
engineMode :: Maybe Text
enableIAMDatabaseAuthentication :: Maybe Bool
enableCloudwatchLogsExports :: Maybe [Text]
domainIAMRoleName :: Maybe Text
domain :: Maybe Text
deletionProtection :: Maybe Bool
dbSubnetGroupName :: Maybe Text
dbClusterParameterGroupName :: Maybe Text
dbClusterInstanceClass :: Maybe Text
copyTagsToSnapshot :: Maybe Bool
backtrackWindow :: Maybe Integer
$sel:sourceDBClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
$sel:dbClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
$sel:vpcSecurityGroupIds:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:useLatestRestorableTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:tags:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Tag]
$sel:storageType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:serverlessV2ScalingConfiguration:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime
-> Maybe ServerlessV2ScalingConfiguration
$sel:scalingConfiguration:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ScalingConfiguration
$sel:restoreType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:restoreToTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ISO8601
$sel:publiclyAccessible:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:port:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
$sel:optionGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:networkType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:kmsKeyId:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:iops:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
$sel:engineMode:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:enableIAMDatabaseAuthentication:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:domainIAMRoleName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:domain:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:deletionProtection:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:dbSubnetGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:dbClusterParameterGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:dbClusterInstanceClass:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:copyTagsToSnapshot:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:backtrackWindow:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Integer
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"RestoreDBClusterToPointInTime" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"BacktrackWindow" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Integer
backtrackWindow,
        ByteString
"CopyTagsToSnapshot" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
copyTagsToSnapshot,
        ByteString
"DBClusterInstanceClass"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbClusterInstanceClass,
        ByteString
"DBClusterParameterGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbClusterParameterGroupName,
        ByteString
"DBSubnetGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbSubnetGroupName,
        ByteString
"DeletionProtection" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
deletionProtection,
        ByteString
"Domain" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
domain,
        ByteString
"DomainIAMRoleName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
domainIAMRoleName,
        ByteString
"EnableCloudwatchLogsExports"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
enableCloudwatchLogsExports
            ),
        ByteString
"EnableIAMDatabaseAuthentication"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
enableIAMDatabaseAuthentication,
        ByteString
"EngineMode" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
engineMode,
        ByteString
"Iops" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
iops,
        ByteString
"KmsKeyId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
kmsKeyId,
        ByteString
"NetworkType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
networkType,
        ByteString
"OptionGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
optionGroupName,
        ByteString
"Port" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
port,
        ByteString
"PubliclyAccessible" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
publiclyAccessible,
        ByteString
"RestoreToTime" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
restoreToTime,
        ByteString
"RestoreType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
restoreType,
        ByteString
"ScalingConfiguration" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ScalingConfiguration
scalingConfiguration,
        ByteString
"ServerlessV2ScalingConfiguration"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration,
        ByteString
"StorageType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
storageType,
        ByteString
"Tags"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Tag" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags),
        ByteString
"UseLatestRestorableTime"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
useLatestRestorableTime,
        ByteString
"VpcSecurityGroupIds"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"VpcSecurityGroupId"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
vpcSecurityGroupIds
            ),
        ByteString
"DBClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbClusterIdentifier,
        ByteString
"SourceDBClusterIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
sourceDBClusterIdentifier
      ]

-- | /See:/ 'newRestoreDBClusterToPointInTimeResponse' smart constructor.
data RestoreDBClusterToPointInTimeResponse = RestoreDBClusterToPointInTimeResponse'
  { RestoreDBClusterToPointInTimeResponse -> Maybe DBCluster
dbCluster :: Prelude.Maybe DBCluster,
    -- | The response's http status code.
    RestoreDBClusterToPointInTimeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RestoreDBClusterToPointInTimeResponse
-> RestoreDBClusterToPointInTimeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RestoreDBClusterToPointInTimeResponse
-> RestoreDBClusterToPointInTimeResponse -> Bool
$c/= :: RestoreDBClusterToPointInTimeResponse
-> RestoreDBClusterToPointInTimeResponse -> Bool
== :: RestoreDBClusterToPointInTimeResponse
-> RestoreDBClusterToPointInTimeResponse -> Bool
$c== :: RestoreDBClusterToPointInTimeResponse
-> RestoreDBClusterToPointInTimeResponse -> Bool
Prelude.Eq, ReadPrec [RestoreDBClusterToPointInTimeResponse]
ReadPrec RestoreDBClusterToPointInTimeResponse
Int -> ReadS RestoreDBClusterToPointInTimeResponse
ReadS [RestoreDBClusterToPointInTimeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RestoreDBClusterToPointInTimeResponse]
$creadListPrec :: ReadPrec [RestoreDBClusterToPointInTimeResponse]
readPrec :: ReadPrec RestoreDBClusterToPointInTimeResponse
$creadPrec :: ReadPrec RestoreDBClusterToPointInTimeResponse
readList :: ReadS [RestoreDBClusterToPointInTimeResponse]
$creadList :: ReadS [RestoreDBClusterToPointInTimeResponse]
readsPrec :: Int -> ReadS RestoreDBClusterToPointInTimeResponse
$creadsPrec :: Int -> ReadS RestoreDBClusterToPointInTimeResponse
Prelude.Read, Int -> RestoreDBClusterToPointInTimeResponse -> ShowS
[RestoreDBClusterToPointInTimeResponse] -> ShowS
RestoreDBClusterToPointInTimeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestoreDBClusterToPointInTimeResponse] -> ShowS
$cshowList :: [RestoreDBClusterToPointInTimeResponse] -> ShowS
show :: RestoreDBClusterToPointInTimeResponse -> String
$cshow :: RestoreDBClusterToPointInTimeResponse -> String
showsPrec :: Int -> RestoreDBClusterToPointInTimeResponse -> ShowS
$cshowsPrec :: Int -> RestoreDBClusterToPointInTimeResponse -> ShowS
Prelude.Show, forall x.
Rep RestoreDBClusterToPointInTimeResponse x
-> RestoreDBClusterToPointInTimeResponse
forall x.
RestoreDBClusterToPointInTimeResponse
-> Rep RestoreDBClusterToPointInTimeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RestoreDBClusterToPointInTimeResponse x
-> RestoreDBClusterToPointInTimeResponse
$cfrom :: forall x.
RestoreDBClusterToPointInTimeResponse
-> Rep RestoreDBClusterToPointInTimeResponse x
Prelude.Generic)

-- |
-- Create a value of 'RestoreDBClusterToPointInTimeResponse' 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:
--
-- 'dbCluster', 'restoreDBClusterToPointInTimeResponse_dbCluster' - Undocumented member.
--
-- 'httpStatus', 'restoreDBClusterToPointInTimeResponse_httpStatus' - The response's http status code.
newRestoreDBClusterToPointInTimeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RestoreDBClusterToPointInTimeResponse
newRestoreDBClusterToPointInTimeResponse :: Int -> RestoreDBClusterToPointInTimeResponse
newRestoreDBClusterToPointInTimeResponse Int
pHttpStatus_ =
  RestoreDBClusterToPointInTimeResponse'
    { $sel:dbCluster:RestoreDBClusterToPointInTimeResponse' :: Maybe DBCluster
dbCluster =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RestoreDBClusterToPointInTimeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
restoreDBClusterToPointInTimeResponse_dbCluster :: Lens.Lens' RestoreDBClusterToPointInTimeResponse (Prelude.Maybe DBCluster)
restoreDBClusterToPointInTimeResponse_dbCluster :: Lens' RestoreDBClusterToPointInTimeResponse (Maybe DBCluster)
restoreDBClusterToPointInTimeResponse_dbCluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTimeResponse' {Maybe DBCluster
dbCluster :: Maybe DBCluster
$sel:dbCluster:RestoreDBClusterToPointInTimeResponse' :: RestoreDBClusterToPointInTimeResponse -> Maybe DBCluster
dbCluster} -> Maybe DBCluster
dbCluster) (\s :: RestoreDBClusterToPointInTimeResponse
s@RestoreDBClusterToPointInTimeResponse' {} Maybe DBCluster
a -> RestoreDBClusterToPointInTimeResponse
s {$sel:dbCluster:RestoreDBClusterToPointInTimeResponse' :: Maybe DBCluster
dbCluster = Maybe DBCluster
a} :: RestoreDBClusterToPointInTimeResponse)

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

instance
  Prelude.NFData
    RestoreDBClusterToPointInTimeResponse
  where
  rnf :: RestoreDBClusterToPointInTimeResponse -> ()
rnf RestoreDBClusterToPointInTimeResponse' {Int
Maybe DBCluster
httpStatus :: Int
dbCluster :: Maybe DBCluster
$sel:httpStatus:RestoreDBClusterToPointInTimeResponse' :: RestoreDBClusterToPointInTimeResponse -> Int
$sel:dbCluster:RestoreDBClusterToPointInTimeResponse' :: RestoreDBClusterToPointInTimeResponse -> Maybe DBCluster
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DBCluster
dbCluster
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus