{-# 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.RestoreDBClusterFromSnapshot
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new DB cluster from a DB snapshot or DB cluster snapshot.
--
-- The target DB cluster is created from the source snapshot with a default
-- configuration. If you don\'t specify a security group, the new DB
-- cluster is associated with the default security group.
--
-- 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 @RestoreDBClusterFromSnapshot@ 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.RestoreDBClusterFromSnapshot
  ( -- * Creating a Request
    RestoreDBClusterFromSnapshot (..),
    newRestoreDBClusterFromSnapshot,

    -- * Request Lenses
    restoreDBClusterFromSnapshot_availabilityZones,
    restoreDBClusterFromSnapshot_backtrackWindow,
    restoreDBClusterFromSnapshot_copyTagsToSnapshot,
    restoreDBClusterFromSnapshot_dbClusterInstanceClass,
    restoreDBClusterFromSnapshot_dbClusterParameterGroupName,
    restoreDBClusterFromSnapshot_dbSubnetGroupName,
    restoreDBClusterFromSnapshot_databaseName,
    restoreDBClusterFromSnapshot_deletionProtection,
    restoreDBClusterFromSnapshot_domain,
    restoreDBClusterFromSnapshot_domainIAMRoleName,
    restoreDBClusterFromSnapshot_enableCloudwatchLogsExports,
    restoreDBClusterFromSnapshot_enableIAMDatabaseAuthentication,
    restoreDBClusterFromSnapshot_engineMode,
    restoreDBClusterFromSnapshot_engineVersion,
    restoreDBClusterFromSnapshot_iops,
    restoreDBClusterFromSnapshot_kmsKeyId,
    restoreDBClusterFromSnapshot_networkType,
    restoreDBClusterFromSnapshot_optionGroupName,
    restoreDBClusterFromSnapshot_port,
    restoreDBClusterFromSnapshot_publiclyAccessible,
    restoreDBClusterFromSnapshot_scalingConfiguration,
    restoreDBClusterFromSnapshot_serverlessV2ScalingConfiguration,
    restoreDBClusterFromSnapshot_storageType,
    restoreDBClusterFromSnapshot_tags,
    restoreDBClusterFromSnapshot_vpcSecurityGroupIds,
    restoreDBClusterFromSnapshot_dbClusterIdentifier,
    restoreDBClusterFromSnapshot_snapshotIdentifier,
    restoreDBClusterFromSnapshot_engine,

    -- * Destructuring the Response
    RestoreDBClusterFromSnapshotResponse (..),
    newRestoreDBClusterFromSnapshotResponse,

    -- * Response Lenses
    restoreDBClusterFromSnapshotResponse_dbCluster,
    restoreDBClusterFromSnapshotResponse_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:/ 'newRestoreDBClusterFromSnapshot' smart constructor.
data RestoreDBClusterFromSnapshot = RestoreDBClusterFromSnapshot'
  { -- | Provides the list of Availability Zones (AZs) where instances in the
    -- restored DB cluster can be created.
    --
    -- Valid for: Aurora DB clusters only
    RestoreDBClusterFromSnapshot -> Maybe [Text]
availabilityZones :: Prelude.Maybe [Prelude.Text],
    -- | The target backtrack window, in seconds. To disable backtracking, set
    -- this value to 0.
    --
    -- Currently, Backtrack is only supported for Aurora MySQL DB clusters.
    --
    -- Default: 0
    --
    -- Constraints:
    --
    -- -   If specified, this value must be set to a number from 0 to 259,200
    --     (72 hours).
    --
    -- Valid for: Aurora DB clusters only
    RestoreDBClusterFromSnapshot -> 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
    RestoreDBClusterFromSnapshot -> 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
    RestoreDBClusterFromSnapshot -> 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 default 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
    RestoreDBClusterFromSnapshot -> Maybe Text
dbClusterParameterGroupName :: Prelude.Maybe Prelude.Text,
    -- | The name of the DB subnet group to use for the new DB cluster.
    --
    -- Constraints: If supplied, must match the name of an existing DB subnet
    -- group.
    --
    -- Example: @mydbsubnetgroup@
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterFromSnapshot -> Maybe Text
dbSubnetGroupName :: Prelude.Maybe Prelude.Text,
    -- | The database name for the restored DB cluster.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterFromSnapshot -> Maybe Text
databaseName :: 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
    RestoreDBClusterFromSnapshot -> 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. Currently, only
    -- MySQL, Microsoft SQL Server, Oracle, and PostgreSQL DB instances can be
    -- created in an Active Directory Domain.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/kerberos-authentication.html Kerberos Authentication>
    -- in the /Amazon RDS User Guide/.
    --
    -- Valid for: Aurora DB clusters only
    RestoreDBClusterFromSnapshot -> 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
    RestoreDBClusterFromSnapshot -> Maybe Text
domainIAMRoleName :: Prelude.Maybe Prelude.Text,
    -- | The list of logs that the restored DB cluster is to export to Amazon
    -- 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
    RestoreDBClusterFromSnapshot -> 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
    RestoreDBClusterFromSnapshot -> Maybe Bool
enableIAMDatabaseAuthentication :: Prelude.Maybe Prelude.Bool,
    -- | The DB engine mode of the DB cluster, either @provisioned@,
    -- @serverless@, @parallelquery@, @global@, or @multimaster@.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/APIReference/API_CreateDBCluster.html CreateDBCluster>.
    --
    -- Valid for: Aurora DB clusters only
    RestoreDBClusterFromSnapshot -> Maybe Text
engineMode :: Prelude.Maybe Prelude.Text,
    -- | The version of the database engine to use for the new DB cluster.
    --
    -- To list all of the available engine versions for MySQL 5.6-compatible
    -- Aurora, use the following command:
    --
    -- @aws rds describe-db-engine-versions --engine aurora --query \"DBEngineVersions[].EngineVersion\"@
    --
    -- To list all of the available engine versions for MySQL 5.7-compatible
    -- and MySQL 8.0-compatible Aurora, use the following command:
    --
    -- @aws rds describe-db-engine-versions --engine aurora-mysql --query \"DBEngineVersions[].EngineVersion\"@
    --
    -- To list all of the available engine versions for Aurora PostgreSQL, use
    -- the following command:
    --
    -- @aws rds describe-db-engine-versions --engine aurora-postgresql --query \"DBEngineVersions[].EngineVersion\"@
    --
    -- To list all of the available engine versions for RDS for MySQL, use the
    -- following command:
    --
    -- @aws rds describe-db-engine-versions --engine mysql --query \"DBEngineVersions[].EngineVersion\"@
    --
    -- To list all of the available engine versions for RDS for PostgreSQL, use
    -- the following command:
    --
    -- @aws rds describe-db-engine-versions --engine postgres --query \"DBEngineVersions[].EngineVersion\"@
    --
    -- __Aurora MySQL__
    --
    -- See
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/AuroraMySQL.Updates.html MySQL on Amazon RDS Versions>
    -- in the /Amazon Aurora User Guide/.
    --
    -- __Aurora PostgreSQL__
    --
    -- See
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/AuroraPostgreSQL.Updates.20180305.html Amazon Aurora PostgreSQL releases and engine versions>
    -- in the /Amazon Aurora User Guide/.
    --
    -- __MySQL__
    --
    -- See
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/CHAP_MySQL.html#MySQL.Concepts.VersionMgmt MySQL on Amazon RDS Versions>
    -- in the /Amazon RDS User Guide./
    --
    -- __PostgreSQL__
    --
    -- See
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/CHAP_PostgreSQL.html#PostgreSQL.Concepts Amazon RDS for PostgreSQL versions and extensions>
    -- in the /Amazon RDS User Guide./
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterFromSnapshot -> Maybe Text
engineVersion :: 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: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterFromSnapshot -> Maybe Int
iops :: Prelude.Maybe Prelude.Int,
    -- | The Amazon Web Services KMS key identifier to use when restoring an
    -- encrypted DB cluster from a DB snapshot or DB cluster snapshot.
    --
    -- 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.
    --
    -- When you don\'t specify a value for the @KmsKeyId@ parameter, then the
    -- following occurs:
    --
    -- -   If the DB snapshot or DB cluster snapshot in @SnapshotIdentifier@ is
    --     encrypted, then the restored DB cluster is encrypted using the KMS
    --     key that was used to encrypt the DB snapshot or DB cluster snapshot.
    --
    -- -   If the DB snapshot or DB cluster snapshot in @SnapshotIdentifier@
    --     isn\'t encrypted, then the restored DB cluster isn\'t encrypted.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterFromSnapshot -> 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
    RestoreDBClusterFromSnapshot -> Maybe Text
networkType :: Prelude.Maybe Prelude.Text,
    -- | The name of the option group to use for the restored DB cluster.
    --
    -- DB clusters are associated with a default option group that can\'t be
    -- modified.
    RestoreDBClusterFromSnapshot -> Maybe Text
optionGroupName :: Prelude.Maybe Prelude.Text,
    -- | The port number on which the new DB cluster accepts connections.
    --
    -- Constraints: This value must be @1150-65535@
    --
    -- Default: The same port as the original DB cluster.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterFromSnapshot -> 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: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterFromSnapshot -> Maybe Bool
publiclyAccessible :: Prelude.Maybe Prelude.Bool,
    -- | For DB clusters in @serverless@ DB engine mode, the scaling properties
    -- of the DB cluster.
    --
    -- Valid for: Aurora DB clusters only
    RestoreDBClusterFromSnapshot -> Maybe ScalingConfiguration
scalingConfiguration :: Prelude.Maybe ScalingConfiguration,
    RestoreDBClusterFromSnapshot
-> 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: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterFromSnapshot -> Maybe Text
storageType :: Prelude.Maybe Prelude.Text,
    -- | The tags to be assigned to the restored DB cluster.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterFromSnapshot -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A list of VPC security groups that the new DB cluster will belong to.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterFromSnapshot -> Maybe [Text]
vpcSecurityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The name of the DB cluster to create from the DB snapshot or DB cluster
    -- snapshot. This parameter isn\'t case-sensitive.
    --
    -- 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
    --
    -- Example: @my-snapshot-id@
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterFromSnapshot -> Text
dbClusterIdentifier :: Prelude.Text,
    -- | The identifier for the DB snapshot or DB cluster snapshot to restore
    -- from.
    --
    -- You can use either the name or the Amazon Resource Name (ARN) to specify
    -- a DB cluster snapshot. However, you can use only the ARN to specify a DB
    -- snapshot.
    --
    -- Constraints:
    --
    -- -   Must match the identifier of an existing Snapshot.
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterFromSnapshot -> Text
snapshotIdentifier :: Prelude.Text,
    -- | The database engine to use for the new DB cluster.
    --
    -- Default: The same as source
    --
    -- Constraint: Must be compatible with the engine of the source
    --
    -- Valid for: Aurora DB clusters and Multi-AZ DB clusters
    RestoreDBClusterFromSnapshot -> Text
engine :: Prelude.Text
  }
  deriving (RestoreDBClusterFromSnapshot
-> RestoreDBClusterFromSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RestoreDBClusterFromSnapshot
-> RestoreDBClusterFromSnapshot -> Bool
$c/= :: RestoreDBClusterFromSnapshot
-> RestoreDBClusterFromSnapshot -> Bool
== :: RestoreDBClusterFromSnapshot
-> RestoreDBClusterFromSnapshot -> Bool
$c== :: RestoreDBClusterFromSnapshot
-> RestoreDBClusterFromSnapshot -> Bool
Prelude.Eq, ReadPrec [RestoreDBClusterFromSnapshot]
ReadPrec RestoreDBClusterFromSnapshot
Int -> ReadS RestoreDBClusterFromSnapshot
ReadS [RestoreDBClusterFromSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RestoreDBClusterFromSnapshot]
$creadListPrec :: ReadPrec [RestoreDBClusterFromSnapshot]
readPrec :: ReadPrec RestoreDBClusterFromSnapshot
$creadPrec :: ReadPrec RestoreDBClusterFromSnapshot
readList :: ReadS [RestoreDBClusterFromSnapshot]
$creadList :: ReadS [RestoreDBClusterFromSnapshot]
readsPrec :: Int -> ReadS RestoreDBClusterFromSnapshot
$creadsPrec :: Int -> ReadS RestoreDBClusterFromSnapshot
Prelude.Read, Int -> RestoreDBClusterFromSnapshot -> ShowS
[RestoreDBClusterFromSnapshot] -> ShowS
RestoreDBClusterFromSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestoreDBClusterFromSnapshot] -> ShowS
$cshowList :: [RestoreDBClusterFromSnapshot] -> ShowS
show :: RestoreDBClusterFromSnapshot -> String
$cshow :: RestoreDBClusterFromSnapshot -> String
showsPrec :: Int -> RestoreDBClusterFromSnapshot -> ShowS
$cshowsPrec :: Int -> RestoreDBClusterFromSnapshot -> ShowS
Prelude.Show, forall x.
Rep RestoreDBClusterFromSnapshot x -> RestoreDBClusterFromSnapshot
forall x.
RestoreDBClusterFromSnapshot -> Rep RestoreDBClusterFromSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RestoreDBClusterFromSnapshot x -> RestoreDBClusterFromSnapshot
$cfrom :: forall x.
RestoreDBClusterFromSnapshot -> Rep RestoreDBClusterFromSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'RestoreDBClusterFromSnapshot' 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:
--
-- 'availabilityZones', 'restoreDBClusterFromSnapshot_availabilityZones' - Provides the list of Availability Zones (AZs) where instances in the
-- restored DB cluster can be created.
--
-- Valid for: Aurora DB clusters only
--
-- 'backtrackWindow', 'restoreDBClusterFromSnapshot_backtrackWindow' - The target backtrack window, in seconds. To disable backtracking, set
-- this value to 0.
--
-- Currently, Backtrack is only supported for Aurora MySQL DB clusters.
--
-- Default: 0
--
-- Constraints:
--
-- -   If specified, this value must be set to a number from 0 to 259,200
--     (72 hours).
--
-- Valid for: Aurora DB clusters only
--
-- 'copyTagsToSnapshot', 'restoreDBClusterFromSnapshot_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', 'restoreDBClusterFromSnapshot_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', 'restoreDBClusterFromSnapshot_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 default 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', 'restoreDBClusterFromSnapshot_dbSubnetGroupName' - The name of the DB subnet group to use for the new DB cluster.
--
-- Constraints: If supplied, must match the name of an existing DB subnet
-- group.
--
-- Example: @mydbsubnetgroup@
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'databaseName', 'restoreDBClusterFromSnapshot_databaseName' - The database name for the restored DB cluster.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'deletionProtection', 'restoreDBClusterFromSnapshot_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', 'restoreDBClusterFromSnapshot_domain' - Specify the Active Directory directory ID to restore the DB cluster in.
-- The domain must be created prior to this operation. Currently, only
-- MySQL, Microsoft SQL Server, Oracle, and PostgreSQL DB instances can be
-- created in an Active Directory Domain.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/kerberos-authentication.html Kerberos Authentication>
-- in the /Amazon RDS User Guide/.
--
-- Valid for: Aurora DB clusters only
--
-- 'domainIAMRoleName', 'restoreDBClusterFromSnapshot_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', 'restoreDBClusterFromSnapshot_enableCloudwatchLogsExports' - The list of logs that the restored DB cluster is to export to Amazon
-- 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', 'restoreDBClusterFromSnapshot_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', 'restoreDBClusterFromSnapshot_engineMode' - The DB engine mode of the DB cluster, either @provisioned@,
-- @serverless@, @parallelquery@, @global@, or @multimaster@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/APIReference/API_CreateDBCluster.html CreateDBCluster>.
--
-- Valid for: Aurora DB clusters only
--
-- 'engineVersion', 'restoreDBClusterFromSnapshot_engineVersion' - The version of the database engine to use for the new DB cluster.
--
-- To list all of the available engine versions for MySQL 5.6-compatible
-- Aurora, use the following command:
--
-- @aws rds describe-db-engine-versions --engine aurora --query \"DBEngineVersions[].EngineVersion\"@
--
-- To list all of the available engine versions for MySQL 5.7-compatible
-- and MySQL 8.0-compatible Aurora, use the following command:
--
-- @aws rds describe-db-engine-versions --engine aurora-mysql --query \"DBEngineVersions[].EngineVersion\"@
--
-- To list all of the available engine versions for Aurora PostgreSQL, use
-- the following command:
--
-- @aws rds describe-db-engine-versions --engine aurora-postgresql --query \"DBEngineVersions[].EngineVersion\"@
--
-- To list all of the available engine versions for RDS for MySQL, use the
-- following command:
--
-- @aws rds describe-db-engine-versions --engine mysql --query \"DBEngineVersions[].EngineVersion\"@
--
-- To list all of the available engine versions for RDS for PostgreSQL, use
-- the following command:
--
-- @aws rds describe-db-engine-versions --engine postgres --query \"DBEngineVersions[].EngineVersion\"@
--
-- __Aurora MySQL__
--
-- See
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/AuroraMySQL.Updates.html MySQL on Amazon RDS Versions>
-- in the /Amazon Aurora User Guide/.
--
-- __Aurora PostgreSQL__
--
-- See
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/AuroraPostgreSQL.Updates.20180305.html Amazon Aurora PostgreSQL releases and engine versions>
-- in the /Amazon Aurora User Guide/.
--
-- __MySQL__
--
-- See
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/CHAP_MySQL.html#MySQL.Concepts.VersionMgmt MySQL on Amazon RDS Versions>
-- in the /Amazon RDS User Guide./
--
-- __PostgreSQL__
--
-- See
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/CHAP_PostgreSQL.html#PostgreSQL.Concepts Amazon RDS for PostgreSQL versions and extensions>
-- in the /Amazon RDS User Guide./
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'iops', 'restoreDBClusterFromSnapshot_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: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'kmsKeyId', 'restoreDBClusterFromSnapshot_kmsKeyId' - The Amazon Web Services KMS key identifier to use when restoring an
-- encrypted DB cluster from a DB snapshot or DB cluster snapshot.
--
-- 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.
--
-- When you don\'t specify a value for the @KmsKeyId@ parameter, then the
-- following occurs:
--
-- -   If the DB snapshot or DB cluster snapshot in @SnapshotIdentifier@ is
--     encrypted, then the restored DB cluster is encrypted using the KMS
--     key that was used to encrypt the DB snapshot or DB cluster snapshot.
--
-- -   If the DB snapshot or DB cluster snapshot in @SnapshotIdentifier@
--     isn\'t encrypted, then the restored DB cluster isn\'t encrypted.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'networkType', 'restoreDBClusterFromSnapshot_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', 'restoreDBClusterFromSnapshot_optionGroupName' - The name of the option group to use for the restored DB cluster.
--
-- DB clusters are associated with a default option group that can\'t be
-- modified.
--
-- 'port', 'restoreDBClusterFromSnapshot_port' - The port number on which the new DB cluster accepts connections.
--
-- Constraints: This value must be @1150-65535@
--
-- Default: The same port as the original DB cluster.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'publiclyAccessible', 'restoreDBClusterFromSnapshot_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: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'scalingConfiguration', 'restoreDBClusterFromSnapshot_scalingConfiguration' - For DB clusters in @serverless@ DB engine mode, the scaling properties
-- of the DB cluster.
--
-- Valid for: Aurora DB clusters only
--
-- 'serverlessV2ScalingConfiguration', 'restoreDBClusterFromSnapshot_serverlessV2ScalingConfiguration' - Undocumented member.
--
-- 'storageType', 'restoreDBClusterFromSnapshot_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: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'tags', 'restoreDBClusterFromSnapshot_tags' - The tags to be assigned to the restored DB cluster.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'vpcSecurityGroupIds', 'restoreDBClusterFromSnapshot_vpcSecurityGroupIds' - A list of VPC security groups that the new DB cluster will belong to.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'dbClusterIdentifier', 'restoreDBClusterFromSnapshot_dbClusterIdentifier' - The name of the DB cluster to create from the DB snapshot or DB cluster
-- snapshot. This parameter isn\'t case-sensitive.
--
-- 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
--
-- Example: @my-snapshot-id@
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'snapshotIdentifier', 'restoreDBClusterFromSnapshot_snapshotIdentifier' - The identifier for the DB snapshot or DB cluster snapshot to restore
-- from.
--
-- You can use either the name or the Amazon Resource Name (ARN) to specify
-- a DB cluster snapshot. However, you can use only the ARN to specify a DB
-- snapshot.
--
-- Constraints:
--
-- -   Must match the identifier of an existing Snapshot.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
--
-- 'engine', 'restoreDBClusterFromSnapshot_engine' - The database engine to use for the new DB cluster.
--
-- Default: The same as source
--
-- Constraint: Must be compatible with the engine of the source
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
newRestoreDBClusterFromSnapshot ::
  -- | 'dbClusterIdentifier'
  Prelude.Text ->
  -- | 'snapshotIdentifier'
  Prelude.Text ->
  -- | 'engine'
  Prelude.Text ->
  RestoreDBClusterFromSnapshot
newRestoreDBClusterFromSnapshot :: Text -> Text -> Text -> RestoreDBClusterFromSnapshot
newRestoreDBClusterFromSnapshot
  Text
pDBClusterIdentifier_
  Text
pSnapshotIdentifier_
  Text
pEngine_ =
    RestoreDBClusterFromSnapshot'
      { $sel:availabilityZones:RestoreDBClusterFromSnapshot' :: Maybe [Text]
availabilityZones =
          forall a. Maybe a
Prelude.Nothing,
        $sel:backtrackWindow:RestoreDBClusterFromSnapshot' :: Maybe Integer
backtrackWindow = forall a. Maybe a
Prelude.Nothing,
        $sel:copyTagsToSnapshot:RestoreDBClusterFromSnapshot' :: Maybe Bool
copyTagsToSnapshot = forall a. Maybe a
Prelude.Nothing,
        $sel:dbClusterInstanceClass:RestoreDBClusterFromSnapshot' :: Maybe Text
dbClusterInstanceClass = forall a. Maybe a
Prelude.Nothing,
        $sel:dbClusterParameterGroupName:RestoreDBClusterFromSnapshot' :: Maybe Text
dbClusterParameterGroupName = forall a. Maybe a
Prelude.Nothing,
        $sel:dbSubnetGroupName:RestoreDBClusterFromSnapshot' :: Maybe Text
dbSubnetGroupName = forall a. Maybe a
Prelude.Nothing,
        $sel:databaseName:RestoreDBClusterFromSnapshot' :: Maybe Text
databaseName = forall a. Maybe a
Prelude.Nothing,
        $sel:deletionProtection:RestoreDBClusterFromSnapshot' :: Maybe Bool
deletionProtection = forall a. Maybe a
Prelude.Nothing,
        $sel:domain:RestoreDBClusterFromSnapshot' :: Maybe Text
domain = forall a. Maybe a
Prelude.Nothing,
        $sel:domainIAMRoleName:RestoreDBClusterFromSnapshot' :: Maybe Text
domainIAMRoleName = forall a. Maybe a
Prelude.Nothing,
        $sel:enableCloudwatchLogsExports:RestoreDBClusterFromSnapshot' :: Maybe [Text]
enableCloudwatchLogsExports = forall a. Maybe a
Prelude.Nothing,
        $sel:enableIAMDatabaseAuthentication:RestoreDBClusterFromSnapshot' :: Maybe Bool
enableIAMDatabaseAuthentication =
          forall a. Maybe a
Prelude.Nothing,
        $sel:engineMode:RestoreDBClusterFromSnapshot' :: Maybe Text
engineMode = forall a. Maybe a
Prelude.Nothing,
        $sel:engineVersion:RestoreDBClusterFromSnapshot' :: Maybe Text
engineVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:iops:RestoreDBClusterFromSnapshot' :: Maybe Int
iops = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:RestoreDBClusterFromSnapshot' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:networkType:RestoreDBClusterFromSnapshot' :: Maybe Text
networkType = forall a. Maybe a
Prelude.Nothing,
        $sel:optionGroupName:RestoreDBClusterFromSnapshot' :: Maybe Text
optionGroupName = forall a. Maybe a
Prelude.Nothing,
        $sel:port:RestoreDBClusterFromSnapshot' :: Maybe Int
port = forall a. Maybe a
Prelude.Nothing,
        $sel:publiclyAccessible:RestoreDBClusterFromSnapshot' :: Maybe Bool
publiclyAccessible = forall a. Maybe a
Prelude.Nothing,
        $sel:scalingConfiguration:RestoreDBClusterFromSnapshot' :: Maybe ScalingConfiguration
scalingConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:serverlessV2ScalingConfiguration:RestoreDBClusterFromSnapshot' :: Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration =
          forall a. Maybe a
Prelude.Nothing,
        $sel:storageType:RestoreDBClusterFromSnapshot' :: Maybe Text
storageType = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:RestoreDBClusterFromSnapshot' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:vpcSecurityGroupIds:RestoreDBClusterFromSnapshot' :: Maybe [Text]
vpcSecurityGroupIds = forall a. Maybe a
Prelude.Nothing,
        $sel:dbClusterIdentifier:RestoreDBClusterFromSnapshot' :: Text
dbClusterIdentifier = Text
pDBClusterIdentifier_,
        $sel:snapshotIdentifier:RestoreDBClusterFromSnapshot' :: Text
snapshotIdentifier = Text
pSnapshotIdentifier_,
        $sel:engine:RestoreDBClusterFromSnapshot' :: Text
engine = Text
pEngine_
      }

-- | Provides the list of Availability Zones (AZs) where instances in the
-- restored DB cluster can be created.
--
-- Valid for: Aurora DB clusters only
restoreDBClusterFromSnapshot_availabilityZones :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe [Prelude.Text])
restoreDBClusterFromSnapshot_availabilityZones :: Lens' RestoreDBClusterFromSnapshot (Maybe [Text])
restoreDBClusterFromSnapshot_availabilityZones = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe [Text]
availabilityZones :: Maybe [Text]
$sel:availabilityZones:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe [Text]
availabilityZones} -> Maybe [Text]
availabilityZones) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe [Text]
a -> RestoreDBClusterFromSnapshot
s {$sel:availabilityZones:RestoreDBClusterFromSnapshot' :: Maybe [Text]
availabilityZones = Maybe [Text]
a} :: RestoreDBClusterFromSnapshot) 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 target backtrack window, in seconds. To disable backtracking, set
-- this value to 0.
--
-- Currently, Backtrack is only supported for Aurora MySQL DB clusters.
--
-- Default: 0
--
-- Constraints:
--
-- -   If specified, this value must be set to a number from 0 to 259,200
--     (72 hours).
--
-- Valid for: Aurora DB clusters only
restoreDBClusterFromSnapshot_backtrackWindow :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Integer)
restoreDBClusterFromSnapshot_backtrackWindow :: Lens' RestoreDBClusterFromSnapshot (Maybe Integer)
restoreDBClusterFromSnapshot_backtrackWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Integer
backtrackWindow :: Maybe Integer
$sel:backtrackWindow:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Integer
backtrackWindow} -> Maybe Integer
backtrackWindow) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Integer
a -> RestoreDBClusterFromSnapshot
s {$sel:backtrackWindow:RestoreDBClusterFromSnapshot' :: Maybe Integer
backtrackWindow = Maybe Integer
a} :: RestoreDBClusterFromSnapshot)

-- | 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
restoreDBClusterFromSnapshot_copyTagsToSnapshot :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Bool)
restoreDBClusterFromSnapshot_copyTagsToSnapshot :: Lens' RestoreDBClusterFromSnapshot (Maybe Bool)
restoreDBClusterFromSnapshot_copyTagsToSnapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Bool
copyTagsToSnapshot :: Maybe Bool
$sel:copyTagsToSnapshot:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Bool
copyTagsToSnapshot} -> Maybe Bool
copyTagsToSnapshot) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Bool
a -> RestoreDBClusterFromSnapshot
s {$sel:copyTagsToSnapshot:RestoreDBClusterFromSnapshot' :: Maybe Bool
copyTagsToSnapshot = Maybe Bool
a} :: RestoreDBClusterFromSnapshot)

-- | 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
restoreDBClusterFromSnapshot_dbClusterInstanceClass :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Text)
restoreDBClusterFromSnapshot_dbClusterInstanceClass :: Lens' RestoreDBClusterFromSnapshot (Maybe Text)
restoreDBClusterFromSnapshot_dbClusterInstanceClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Text
dbClusterInstanceClass :: Maybe Text
$sel:dbClusterInstanceClass:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
dbClusterInstanceClass} -> Maybe Text
dbClusterInstanceClass) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Text
a -> RestoreDBClusterFromSnapshot
s {$sel:dbClusterInstanceClass:RestoreDBClusterFromSnapshot' :: Maybe Text
dbClusterInstanceClass = Maybe Text
a} :: RestoreDBClusterFromSnapshot)

-- | 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 default 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
restoreDBClusterFromSnapshot_dbClusterParameterGroupName :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Text)
restoreDBClusterFromSnapshot_dbClusterParameterGroupName :: Lens' RestoreDBClusterFromSnapshot (Maybe Text)
restoreDBClusterFromSnapshot_dbClusterParameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Text
dbClusterParameterGroupName :: Maybe Text
$sel:dbClusterParameterGroupName:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
dbClusterParameterGroupName} -> Maybe Text
dbClusterParameterGroupName) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Text
a -> RestoreDBClusterFromSnapshot
s {$sel:dbClusterParameterGroupName:RestoreDBClusterFromSnapshot' :: Maybe Text
dbClusterParameterGroupName = Maybe Text
a} :: RestoreDBClusterFromSnapshot)

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

-- | The database name for the restored DB cluster.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterFromSnapshot_databaseName :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Text)
restoreDBClusterFromSnapshot_databaseName :: Lens' RestoreDBClusterFromSnapshot (Maybe Text)
restoreDBClusterFromSnapshot_databaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Text
databaseName :: Maybe Text
$sel:databaseName:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
databaseName} -> Maybe Text
databaseName) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Text
a -> RestoreDBClusterFromSnapshot
s {$sel:databaseName:RestoreDBClusterFromSnapshot' :: Maybe Text
databaseName = Maybe Text
a} :: RestoreDBClusterFromSnapshot)

-- | 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
restoreDBClusterFromSnapshot_deletionProtection :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Bool)
restoreDBClusterFromSnapshot_deletionProtection :: Lens' RestoreDBClusterFromSnapshot (Maybe Bool)
restoreDBClusterFromSnapshot_deletionProtection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Bool
deletionProtection :: Maybe Bool
$sel:deletionProtection:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Bool
deletionProtection} -> Maybe Bool
deletionProtection) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Bool
a -> RestoreDBClusterFromSnapshot
s {$sel:deletionProtection:RestoreDBClusterFromSnapshot' :: Maybe Bool
deletionProtection = Maybe Bool
a} :: RestoreDBClusterFromSnapshot)

-- | Specify the Active Directory directory ID to restore the DB cluster in.
-- The domain must be created prior to this operation. Currently, only
-- MySQL, Microsoft SQL Server, Oracle, and PostgreSQL DB instances can be
-- created in an Active Directory Domain.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/kerberos-authentication.html Kerberos Authentication>
-- in the /Amazon RDS User Guide/.
--
-- Valid for: Aurora DB clusters only
restoreDBClusterFromSnapshot_domain :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Text)
restoreDBClusterFromSnapshot_domain :: Lens' RestoreDBClusterFromSnapshot (Maybe Text)
restoreDBClusterFromSnapshot_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Text
domain :: Maybe Text
$sel:domain:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
domain} -> Maybe Text
domain) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Text
a -> RestoreDBClusterFromSnapshot
s {$sel:domain:RestoreDBClusterFromSnapshot' :: Maybe Text
domain = Maybe Text
a} :: RestoreDBClusterFromSnapshot)

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

-- | The list of logs that the restored DB cluster is to export to Amazon
-- 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
restoreDBClusterFromSnapshot_enableCloudwatchLogsExports :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe [Prelude.Text])
restoreDBClusterFromSnapshot_enableCloudwatchLogsExports :: Lens' RestoreDBClusterFromSnapshot (Maybe [Text])
restoreDBClusterFromSnapshot_enableCloudwatchLogsExports = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe [Text]
enableCloudwatchLogsExports :: Maybe [Text]
$sel:enableCloudwatchLogsExports:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe [Text]
enableCloudwatchLogsExports} -> Maybe [Text]
enableCloudwatchLogsExports) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe [Text]
a -> RestoreDBClusterFromSnapshot
s {$sel:enableCloudwatchLogsExports:RestoreDBClusterFromSnapshot' :: Maybe [Text]
enableCloudwatchLogsExports = Maybe [Text]
a} :: RestoreDBClusterFromSnapshot) 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
restoreDBClusterFromSnapshot_enableIAMDatabaseAuthentication :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Bool)
restoreDBClusterFromSnapshot_enableIAMDatabaseAuthentication :: Lens' RestoreDBClusterFromSnapshot (Maybe Bool)
restoreDBClusterFromSnapshot_enableIAMDatabaseAuthentication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Bool
enableIAMDatabaseAuthentication :: Maybe Bool
$sel:enableIAMDatabaseAuthentication:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Bool
enableIAMDatabaseAuthentication} -> Maybe Bool
enableIAMDatabaseAuthentication) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Bool
a -> RestoreDBClusterFromSnapshot
s {$sel:enableIAMDatabaseAuthentication:RestoreDBClusterFromSnapshot' :: Maybe Bool
enableIAMDatabaseAuthentication = Maybe Bool
a} :: RestoreDBClusterFromSnapshot)

-- | The DB engine mode of the DB cluster, either @provisioned@,
-- @serverless@, @parallelquery@, @global@, or @multimaster@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/APIReference/API_CreateDBCluster.html CreateDBCluster>.
--
-- Valid for: Aurora DB clusters only
restoreDBClusterFromSnapshot_engineMode :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Text)
restoreDBClusterFromSnapshot_engineMode :: Lens' RestoreDBClusterFromSnapshot (Maybe Text)
restoreDBClusterFromSnapshot_engineMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Text
engineMode :: Maybe Text
$sel:engineMode:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
engineMode} -> Maybe Text
engineMode) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Text
a -> RestoreDBClusterFromSnapshot
s {$sel:engineMode:RestoreDBClusterFromSnapshot' :: Maybe Text
engineMode = Maybe Text
a} :: RestoreDBClusterFromSnapshot)

-- | The version of the database engine to use for the new DB cluster.
--
-- To list all of the available engine versions for MySQL 5.6-compatible
-- Aurora, use the following command:
--
-- @aws rds describe-db-engine-versions --engine aurora --query \"DBEngineVersions[].EngineVersion\"@
--
-- To list all of the available engine versions for MySQL 5.7-compatible
-- and MySQL 8.0-compatible Aurora, use the following command:
--
-- @aws rds describe-db-engine-versions --engine aurora-mysql --query \"DBEngineVersions[].EngineVersion\"@
--
-- To list all of the available engine versions for Aurora PostgreSQL, use
-- the following command:
--
-- @aws rds describe-db-engine-versions --engine aurora-postgresql --query \"DBEngineVersions[].EngineVersion\"@
--
-- To list all of the available engine versions for RDS for MySQL, use the
-- following command:
--
-- @aws rds describe-db-engine-versions --engine mysql --query \"DBEngineVersions[].EngineVersion\"@
--
-- To list all of the available engine versions for RDS for PostgreSQL, use
-- the following command:
--
-- @aws rds describe-db-engine-versions --engine postgres --query \"DBEngineVersions[].EngineVersion\"@
--
-- __Aurora MySQL__
--
-- See
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/AuroraMySQL.Updates.html MySQL on Amazon RDS Versions>
-- in the /Amazon Aurora User Guide/.
--
-- __Aurora PostgreSQL__
--
-- See
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/AuroraPostgreSQL.Updates.20180305.html Amazon Aurora PostgreSQL releases and engine versions>
-- in the /Amazon Aurora User Guide/.
--
-- __MySQL__
--
-- See
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/CHAP_MySQL.html#MySQL.Concepts.VersionMgmt MySQL on Amazon RDS Versions>
-- in the /Amazon RDS User Guide./
--
-- __PostgreSQL__
--
-- See
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/CHAP_PostgreSQL.html#PostgreSQL.Concepts Amazon RDS for PostgreSQL versions and extensions>
-- in the /Amazon RDS User Guide./
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterFromSnapshot_engineVersion :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Text)
restoreDBClusterFromSnapshot_engineVersion :: Lens' RestoreDBClusterFromSnapshot (Maybe Text)
restoreDBClusterFromSnapshot_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Text
engineVersion :: Maybe Text
$sel:engineVersion:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
engineVersion} -> Maybe Text
engineVersion) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Text
a -> RestoreDBClusterFromSnapshot
s {$sel:engineVersion:RestoreDBClusterFromSnapshot' :: Maybe Text
engineVersion = Maybe Text
a} :: RestoreDBClusterFromSnapshot)

-- | 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: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterFromSnapshot_iops :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Int)
restoreDBClusterFromSnapshot_iops :: Lens' RestoreDBClusterFromSnapshot (Maybe Int)
restoreDBClusterFromSnapshot_iops = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Int
iops :: Maybe Int
$sel:iops:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Int
iops} -> Maybe Int
iops) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Int
a -> RestoreDBClusterFromSnapshot
s {$sel:iops:RestoreDBClusterFromSnapshot' :: Maybe Int
iops = Maybe Int
a} :: RestoreDBClusterFromSnapshot)

-- | The Amazon Web Services KMS key identifier to use when restoring an
-- encrypted DB cluster from a DB snapshot or DB cluster snapshot.
--
-- 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.
--
-- When you don\'t specify a value for the @KmsKeyId@ parameter, then the
-- following occurs:
--
-- -   If the DB snapshot or DB cluster snapshot in @SnapshotIdentifier@ is
--     encrypted, then the restored DB cluster is encrypted using the KMS
--     key that was used to encrypt the DB snapshot or DB cluster snapshot.
--
-- -   If the DB snapshot or DB cluster snapshot in @SnapshotIdentifier@
--     isn\'t encrypted, then the restored DB cluster isn\'t encrypted.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterFromSnapshot_kmsKeyId :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Text)
restoreDBClusterFromSnapshot_kmsKeyId :: Lens' RestoreDBClusterFromSnapshot (Maybe Text)
restoreDBClusterFromSnapshot_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Text
a -> RestoreDBClusterFromSnapshot
s {$sel:kmsKeyId:RestoreDBClusterFromSnapshot' :: Maybe Text
kmsKeyId = Maybe Text
a} :: RestoreDBClusterFromSnapshot)

-- | 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
restoreDBClusterFromSnapshot_networkType :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Text)
restoreDBClusterFromSnapshot_networkType :: Lens' RestoreDBClusterFromSnapshot (Maybe Text)
restoreDBClusterFromSnapshot_networkType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Text
networkType :: Maybe Text
$sel:networkType:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
networkType} -> Maybe Text
networkType) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Text
a -> RestoreDBClusterFromSnapshot
s {$sel:networkType:RestoreDBClusterFromSnapshot' :: Maybe Text
networkType = Maybe Text
a} :: RestoreDBClusterFromSnapshot)

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

-- | The port number on which the new DB cluster accepts connections.
--
-- Constraints: This value must be @1150-65535@
--
-- Default: The same port as the original DB cluster.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterFromSnapshot_port :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Int)
restoreDBClusterFromSnapshot_port :: Lens' RestoreDBClusterFromSnapshot (Maybe Int)
restoreDBClusterFromSnapshot_port = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Int
port :: Maybe Int
$sel:port:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Int
port} -> Maybe Int
port) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Int
a -> RestoreDBClusterFromSnapshot
s {$sel:port:RestoreDBClusterFromSnapshot' :: Maybe Int
port = Maybe Int
a} :: RestoreDBClusterFromSnapshot)

-- | 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: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterFromSnapshot_publiclyAccessible :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Bool)
restoreDBClusterFromSnapshot_publiclyAccessible :: Lens' RestoreDBClusterFromSnapshot (Maybe Bool)
restoreDBClusterFromSnapshot_publiclyAccessible = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Bool
publiclyAccessible :: Maybe Bool
$sel:publiclyAccessible:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Bool
publiclyAccessible} -> Maybe Bool
publiclyAccessible) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Bool
a -> RestoreDBClusterFromSnapshot
s {$sel:publiclyAccessible:RestoreDBClusterFromSnapshot' :: Maybe Bool
publiclyAccessible = Maybe Bool
a} :: RestoreDBClusterFromSnapshot)

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

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

-- | 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: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterFromSnapshot_storageType :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe Prelude.Text)
restoreDBClusterFromSnapshot_storageType :: Lens' RestoreDBClusterFromSnapshot (Maybe Text)
restoreDBClusterFromSnapshot_storageType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe Text
storageType :: Maybe Text
$sel:storageType:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
storageType} -> Maybe Text
storageType) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe Text
a -> RestoreDBClusterFromSnapshot
s {$sel:storageType:RestoreDBClusterFromSnapshot' :: Maybe Text
storageType = Maybe Text
a} :: RestoreDBClusterFromSnapshot)

-- | The tags to be assigned to the restored DB cluster.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterFromSnapshot_tags :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe [Tag])
restoreDBClusterFromSnapshot_tags :: Lens' RestoreDBClusterFromSnapshot (Maybe [Tag])
restoreDBClusterFromSnapshot_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe [Tag]
a -> RestoreDBClusterFromSnapshot
s {$sel:tags:RestoreDBClusterFromSnapshot' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: RestoreDBClusterFromSnapshot) 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 list of VPC security groups that the new DB cluster will belong to.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterFromSnapshot_vpcSecurityGroupIds :: Lens.Lens' RestoreDBClusterFromSnapshot (Prelude.Maybe [Prelude.Text])
restoreDBClusterFromSnapshot_vpcSecurityGroupIds :: Lens' RestoreDBClusterFromSnapshot (Maybe [Text])
restoreDBClusterFromSnapshot_vpcSecurityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Maybe [Text]
vpcSecurityGroupIds :: Maybe [Text]
$sel:vpcSecurityGroupIds:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe [Text]
vpcSecurityGroupIds} -> Maybe [Text]
vpcSecurityGroupIds) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Maybe [Text]
a -> RestoreDBClusterFromSnapshot
s {$sel:vpcSecurityGroupIds:RestoreDBClusterFromSnapshot' :: Maybe [Text]
vpcSecurityGroupIds = Maybe [Text]
a} :: RestoreDBClusterFromSnapshot) 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 DB cluster to create from the DB snapshot or DB cluster
-- snapshot. This parameter isn\'t case-sensitive.
--
-- 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
--
-- Example: @my-snapshot-id@
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterFromSnapshot_dbClusterIdentifier :: Lens.Lens' RestoreDBClusterFromSnapshot Prelude.Text
restoreDBClusterFromSnapshot_dbClusterIdentifier :: Lens' RestoreDBClusterFromSnapshot Text
restoreDBClusterFromSnapshot_dbClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Text
dbClusterIdentifier :: Text
$sel:dbClusterIdentifier:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Text
dbClusterIdentifier} -> Text
dbClusterIdentifier) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Text
a -> RestoreDBClusterFromSnapshot
s {$sel:dbClusterIdentifier:RestoreDBClusterFromSnapshot' :: Text
dbClusterIdentifier = Text
a} :: RestoreDBClusterFromSnapshot)

-- | The identifier for the DB snapshot or DB cluster snapshot to restore
-- from.
--
-- You can use either the name or the Amazon Resource Name (ARN) to specify
-- a DB cluster snapshot. However, you can use only the ARN to specify a DB
-- snapshot.
--
-- Constraints:
--
-- -   Must match the identifier of an existing Snapshot.
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterFromSnapshot_snapshotIdentifier :: Lens.Lens' RestoreDBClusterFromSnapshot Prelude.Text
restoreDBClusterFromSnapshot_snapshotIdentifier :: Lens' RestoreDBClusterFromSnapshot Text
restoreDBClusterFromSnapshot_snapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Text
snapshotIdentifier :: Text
$sel:snapshotIdentifier:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Text
snapshotIdentifier} -> Text
snapshotIdentifier) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Text
a -> RestoreDBClusterFromSnapshot
s {$sel:snapshotIdentifier:RestoreDBClusterFromSnapshot' :: Text
snapshotIdentifier = Text
a} :: RestoreDBClusterFromSnapshot)

-- | The database engine to use for the new DB cluster.
--
-- Default: The same as source
--
-- Constraint: Must be compatible with the engine of the source
--
-- Valid for: Aurora DB clusters and Multi-AZ DB clusters
restoreDBClusterFromSnapshot_engine :: Lens.Lens' RestoreDBClusterFromSnapshot Prelude.Text
restoreDBClusterFromSnapshot_engine :: Lens' RestoreDBClusterFromSnapshot Text
restoreDBClusterFromSnapshot_engine = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterFromSnapshot' {Text
engine :: Text
$sel:engine:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Text
engine} -> Text
engine) (\s :: RestoreDBClusterFromSnapshot
s@RestoreDBClusterFromSnapshot' {} Text
a -> RestoreDBClusterFromSnapshot
s {$sel:engine:RestoreDBClusterFromSnapshot' :: Text
engine = Text
a} :: RestoreDBClusterFromSnapshot)

instance Core.AWSRequest RestoreDBClusterFromSnapshot where
  type
    AWSResponse RestoreDBClusterFromSnapshot =
      RestoreDBClusterFromSnapshotResponse
  request :: (Service -> Service)
-> RestoreDBClusterFromSnapshot
-> Request RestoreDBClusterFromSnapshot
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 RestoreDBClusterFromSnapshot
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RestoreDBClusterFromSnapshot)))
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
"RestoreDBClusterFromSnapshotResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBCluster -> Int -> RestoreDBClusterFromSnapshotResponse
RestoreDBClusterFromSnapshotResponse'
            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
    RestoreDBClusterFromSnapshot
  where
  hashWithSalt :: Int -> RestoreDBClusterFromSnapshot -> Int
hashWithSalt Int
_salt RestoreDBClusterFromSnapshot' {Maybe Bool
Maybe Int
Maybe Integer
Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe ScalingConfiguration
Maybe ServerlessV2ScalingConfiguration
Text
engine :: Text
snapshotIdentifier :: Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
tags :: Maybe [Tag]
storageType :: Maybe Text
serverlessV2ScalingConfiguration :: Maybe ServerlessV2ScalingConfiguration
scalingConfiguration :: Maybe ScalingConfiguration
publiclyAccessible :: Maybe Bool
port :: Maybe Int
optionGroupName :: Maybe Text
networkType :: Maybe Text
kmsKeyId :: Maybe Text
iops :: Maybe Int
engineVersion :: Maybe Text
engineMode :: Maybe Text
enableIAMDatabaseAuthentication :: Maybe Bool
enableCloudwatchLogsExports :: Maybe [Text]
domainIAMRoleName :: Maybe Text
domain :: Maybe Text
deletionProtection :: Maybe Bool
databaseName :: Maybe Text
dbSubnetGroupName :: Maybe Text
dbClusterParameterGroupName :: Maybe Text
dbClusterInstanceClass :: Maybe Text
copyTagsToSnapshot :: Maybe Bool
backtrackWindow :: Maybe Integer
availabilityZones :: Maybe [Text]
$sel:engine:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Text
$sel:snapshotIdentifier:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Text
$sel:dbClusterIdentifier:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Text
$sel:vpcSecurityGroupIds:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe [Text]
$sel:tags:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe [Tag]
$sel:storageType:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:serverlessV2ScalingConfiguration:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot
-> Maybe ServerlessV2ScalingConfiguration
$sel:scalingConfiguration:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe ScalingConfiguration
$sel:publiclyAccessible:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Bool
$sel:port:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Int
$sel:optionGroupName:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:networkType:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:kmsKeyId:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:iops:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Int
$sel:engineVersion:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:engineMode:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:enableIAMDatabaseAuthentication:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Bool
$sel:enableCloudwatchLogsExports:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe [Text]
$sel:domainIAMRoleName:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:domain:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:deletionProtection:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Bool
$sel:databaseName:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:dbSubnetGroupName:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:dbClusterParameterGroupName:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:dbClusterInstanceClass:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:copyTagsToSnapshot:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Bool
$sel:backtrackWindow:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Integer
$sel:availabilityZones:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
availabilityZones
      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 Text
databaseName
      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 Text
engineVersion
      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 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 [Text]
vpcSecurityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbClusterIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
snapshotIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
engine

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

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

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

instance Data.ToQuery RestoreDBClusterFromSnapshot where
  toQuery :: RestoreDBClusterFromSnapshot -> QueryString
toQuery RestoreDBClusterFromSnapshot' {Maybe Bool
Maybe Int
Maybe Integer
Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe ScalingConfiguration
Maybe ServerlessV2ScalingConfiguration
Text
engine :: Text
snapshotIdentifier :: Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
tags :: Maybe [Tag]
storageType :: Maybe Text
serverlessV2ScalingConfiguration :: Maybe ServerlessV2ScalingConfiguration
scalingConfiguration :: Maybe ScalingConfiguration
publiclyAccessible :: Maybe Bool
port :: Maybe Int
optionGroupName :: Maybe Text
networkType :: Maybe Text
kmsKeyId :: Maybe Text
iops :: Maybe Int
engineVersion :: Maybe Text
engineMode :: Maybe Text
enableIAMDatabaseAuthentication :: Maybe Bool
enableCloudwatchLogsExports :: Maybe [Text]
domainIAMRoleName :: Maybe Text
domain :: Maybe Text
deletionProtection :: Maybe Bool
databaseName :: Maybe Text
dbSubnetGroupName :: Maybe Text
dbClusterParameterGroupName :: Maybe Text
dbClusterInstanceClass :: Maybe Text
copyTagsToSnapshot :: Maybe Bool
backtrackWindow :: Maybe Integer
availabilityZones :: Maybe [Text]
$sel:engine:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Text
$sel:snapshotIdentifier:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Text
$sel:dbClusterIdentifier:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Text
$sel:vpcSecurityGroupIds:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe [Text]
$sel:tags:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe [Tag]
$sel:storageType:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:serverlessV2ScalingConfiguration:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot
-> Maybe ServerlessV2ScalingConfiguration
$sel:scalingConfiguration:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe ScalingConfiguration
$sel:publiclyAccessible:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Bool
$sel:port:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Int
$sel:optionGroupName:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:networkType:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:kmsKeyId:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:iops:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Int
$sel:engineVersion:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:engineMode:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:enableIAMDatabaseAuthentication:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Bool
$sel:enableCloudwatchLogsExports:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe [Text]
$sel:domainIAMRoleName:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:domain:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:deletionProtection:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Bool
$sel:databaseName:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:dbSubnetGroupName:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:dbClusterParameterGroupName:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:dbClusterInstanceClass:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Text
$sel:copyTagsToSnapshot:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Bool
$sel:backtrackWindow:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe Integer
$sel:availabilityZones:RestoreDBClusterFromSnapshot' :: RestoreDBClusterFromSnapshot -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"RestoreDBClusterFromSnapshot" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"AvailabilityZones"
          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
"AvailabilityZone"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
availabilityZones
            ),
        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
"DatabaseName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
databaseName,
        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
"EngineVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
engineVersion,
        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
"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
"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
"SnapshotIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
snapshotIdentifier,
        ByteString
"Engine" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
engine
      ]

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

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

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

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

instance
  Prelude.NFData
    RestoreDBClusterFromSnapshotResponse
  where
  rnf :: RestoreDBClusterFromSnapshotResponse -> ()
rnf RestoreDBClusterFromSnapshotResponse' {Int
Maybe DBCluster
httpStatus :: Int
dbCluster :: Maybe DBCluster
$sel:httpStatus:RestoreDBClusterFromSnapshotResponse' :: RestoreDBClusterFromSnapshotResponse -> Int
$sel:dbCluster:RestoreDBClusterFromSnapshotResponse' :: RestoreDBClusterFromSnapshotResponse -> 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