{-# 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.Redshift.RestoreFromClusterSnapshot
-- 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 cluster from a snapshot. By default, Amazon Redshift
-- creates the resulting cluster with the same configuration as the
-- original cluster from which the snapshot was created, except that the
-- new cluster is created with the default cluster security and parameter
-- groups. After Amazon Redshift creates the cluster, you can use the
-- ModifyCluster API to associate a different security group and different
-- parameter group with the restored cluster. If you are using a DS node
-- type, you can also choose to change to another DS node type of the same
-- size during restore.
--
-- If you restore a cluster into a VPC, you must provide a cluster subnet
-- group where you want the cluster restored.
--
-- For more information about working with snapshots, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-snapshots.html Amazon Redshift Snapshots>
-- in the /Amazon Redshift Cluster Management Guide/.
module Amazonka.Redshift.RestoreFromClusterSnapshot
  ( -- * Creating a Request
    RestoreFromClusterSnapshot (..),
    newRestoreFromClusterSnapshot,

    -- * Request Lenses
    restoreFromClusterSnapshot_additionalInfo,
    restoreFromClusterSnapshot_allowVersionUpgrade,
    restoreFromClusterSnapshot_aquaConfigurationStatus,
    restoreFromClusterSnapshot_automatedSnapshotRetentionPeriod,
    restoreFromClusterSnapshot_availabilityZone,
    restoreFromClusterSnapshot_availabilityZoneRelocation,
    restoreFromClusterSnapshot_clusterParameterGroupName,
    restoreFromClusterSnapshot_clusterSecurityGroups,
    restoreFromClusterSnapshot_clusterSubnetGroupName,
    restoreFromClusterSnapshot_defaultIamRoleArn,
    restoreFromClusterSnapshot_elasticIp,
    restoreFromClusterSnapshot_encrypted,
    restoreFromClusterSnapshot_enhancedVpcRouting,
    restoreFromClusterSnapshot_hsmClientCertificateIdentifier,
    restoreFromClusterSnapshot_hsmConfigurationIdentifier,
    restoreFromClusterSnapshot_iamRoles,
    restoreFromClusterSnapshot_kmsKeyId,
    restoreFromClusterSnapshot_maintenanceTrackName,
    restoreFromClusterSnapshot_manualSnapshotRetentionPeriod,
    restoreFromClusterSnapshot_nodeType,
    restoreFromClusterSnapshot_numberOfNodes,
    restoreFromClusterSnapshot_ownerAccount,
    restoreFromClusterSnapshot_port,
    restoreFromClusterSnapshot_preferredMaintenanceWindow,
    restoreFromClusterSnapshot_publiclyAccessible,
    restoreFromClusterSnapshot_reservedNodeId,
    restoreFromClusterSnapshot_snapshotArn,
    restoreFromClusterSnapshot_snapshotClusterIdentifier,
    restoreFromClusterSnapshot_snapshotIdentifier,
    restoreFromClusterSnapshot_snapshotScheduleIdentifier,
    restoreFromClusterSnapshot_targetReservedNodeOfferingId,
    restoreFromClusterSnapshot_vpcSecurityGroupIds,
    restoreFromClusterSnapshot_clusterIdentifier,

    -- * Destructuring the Response
    RestoreFromClusterSnapshotResponse (..),
    newRestoreFromClusterSnapshotResponse,

    -- * Response Lenses
    restoreFromClusterSnapshotResponse_cluster,
    restoreFromClusterSnapshotResponse_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.Redshift.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newRestoreFromClusterSnapshot' smart constructor.
data RestoreFromClusterSnapshot = RestoreFromClusterSnapshot'
  { -- | Reserved.
    RestoreFromClusterSnapshot -> Maybe Text
additionalInfo :: Prelude.Maybe Prelude.Text,
    -- | If @true@, major version upgrades can be applied during the maintenance
    -- window to the Amazon Redshift engine that is running on the cluster.
    --
    -- Default: @true@
    RestoreFromClusterSnapshot -> Maybe Bool
allowVersionUpgrade :: Prelude.Maybe Prelude.Bool,
    -- | This parameter is retired. It does not set the AQUA configuration
    -- status. Amazon Redshift automatically determines whether to use AQUA
    -- (Advanced Query Accelerator).
    RestoreFromClusterSnapshot -> Maybe AquaConfigurationStatus
aquaConfigurationStatus :: Prelude.Maybe AquaConfigurationStatus,
    -- | The number of days that automated snapshots are retained. If the value
    -- is 0, automated snapshots are disabled. Even if automated snapshots are
    -- disabled, you can still create manual snapshots when you want with
    -- CreateClusterSnapshot.
    --
    -- You can\'t disable automated snapshots for RA3 node types. Set the
    -- automated retention period from 1-35 days.
    --
    -- Default: The value selected for the cluster from which the snapshot was
    -- taken.
    --
    -- Constraints: Must be a value from 0 to 35.
    RestoreFromClusterSnapshot -> Maybe Int
automatedSnapshotRetentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | The Amazon EC2 Availability Zone in which to restore the cluster.
    --
    -- Default: A random, system-chosen Availability Zone.
    --
    -- Example: @us-east-2a@
    RestoreFromClusterSnapshot -> Maybe Text
availabilityZone :: Prelude.Maybe Prelude.Text,
    -- | The option to enable relocation for an Amazon Redshift cluster between
    -- Availability Zones after the cluster is restored.
    RestoreFromClusterSnapshot -> Maybe Bool
availabilityZoneRelocation :: Prelude.Maybe Prelude.Bool,
    -- | The name of the parameter group to be associated with this cluster.
    --
    -- Default: The default Amazon Redshift cluster parameter group. For
    -- information about the default parameter group, go to
    -- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-parameter-groups.html Working with Amazon Redshift Parameter Groups>.
    --
    -- Constraints:
    --
    -- -   Must be 1 to 255 alphanumeric characters or hyphens.
    --
    -- -   First character must be a letter.
    --
    -- -   Cannot end with a hyphen or contain two consecutive hyphens.
    RestoreFromClusterSnapshot -> Maybe Text
clusterParameterGroupName :: Prelude.Maybe Prelude.Text,
    -- | A list of security groups to be associated with this cluster.
    --
    -- Default: The default cluster security group for Amazon Redshift.
    --
    -- Cluster security groups only apply to clusters outside of VPCs.
    RestoreFromClusterSnapshot -> Maybe [Text]
clusterSecurityGroups :: Prelude.Maybe [Prelude.Text],
    -- | The name of the subnet group where you want to cluster restored.
    --
    -- A snapshot of cluster in VPC can be restored only in VPC. Therefore, you
    -- must provide subnet group name where you want the cluster restored.
    RestoreFromClusterSnapshot -> Maybe Text
clusterSubnetGroupName :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) for the IAM role that was set as default
    -- for the cluster when the cluster was last modified while it was restored
    -- from a snapshot.
    RestoreFromClusterSnapshot -> Maybe Text
defaultIamRoleArn :: Prelude.Maybe Prelude.Text,
    -- | The Elastic IP (EIP) address for the cluster. Don\'t specify the Elastic
    -- IP address for a publicly accessible cluster with availability zone
    -- relocation turned on.
    RestoreFromClusterSnapshot -> Maybe Text
elasticIp :: Prelude.Maybe Prelude.Text,
    -- | Enables support for restoring an unencrypted snapshot to a cluster
    -- encrypted with Key Management Service (KMS) and a customer managed key.
    RestoreFromClusterSnapshot -> Maybe Bool
encrypted :: Prelude.Maybe Prelude.Bool,
    -- | An option that specifies whether to create the cluster with enhanced VPC
    -- routing enabled. To create a cluster that uses enhanced VPC routing, the
    -- cluster must be in a VPC. For more information, see
    -- <https://docs.aws.amazon.com/redshift/latest/mgmt/enhanced-vpc-routing.html Enhanced VPC Routing>
    -- in the Amazon Redshift Cluster Management Guide.
    --
    -- If this option is @true@, enhanced VPC routing is enabled.
    --
    -- Default: false
    RestoreFromClusterSnapshot -> Maybe Bool
enhancedVpcRouting :: Prelude.Maybe Prelude.Bool,
    -- | Specifies the name of the HSM client certificate the Amazon Redshift
    -- cluster uses to retrieve the data encryption keys stored in an HSM.
    RestoreFromClusterSnapshot -> Maybe Text
hsmClientCertificateIdentifier :: Prelude.Maybe Prelude.Text,
    -- | Specifies the name of the HSM configuration that contains the
    -- information the Amazon Redshift cluster can use to retrieve and store
    -- keys in an HSM.
    RestoreFromClusterSnapshot -> Maybe Text
hsmConfigurationIdentifier :: Prelude.Maybe Prelude.Text,
    -- | A list of Identity and Access Management (IAM) roles that can be used by
    -- the cluster to access other Amazon Web Services services. You must
    -- supply the IAM roles in their Amazon Resource Name (ARN) format.
    --
    -- The maximum number of IAM roles that you can associate is subject to a
    -- quota. For more information, go to
    -- <https://docs.aws.amazon.com/redshift/latest/mgmt/amazon-redshift-limits.html Quotas and limits>
    -- in the /Amazon Redshift Cluster Management Guide/.
    RestoreFromClusterSnapshot -> Maybe [Text]
iamRoles :: Prelude.Maybe [Prelude.Text],
    -- | The Key Management Service (KMS) key ID of the encryption key that
    -- encrypts data in the cluster restored from a shared snapshot. You can
    -- also provide the key ID when you restore from an unencrypted snapshot to
    -- an encrypted cluster in the same account. Additionally, you can specify
    -- a new KMS key ID when you restore from an encrypted snapshot in the same
    -- account in order to change it. In that case, the restored cluster is
    -- encrypted with the new KMS key ID.
    RestoreFromClusterSnapshot -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The name of the maintenance track for the restored cluster. When you
    -- take a snapshot, the snapshot inherits the @MaintenanceTrack@ value from
    -- the cluster. The snapshot might be on a different track than the cluster
    -- that was the source for the snapshot. For example, suppose that you take
    -- a snapshot of a cluster that is on the current track and then change the
    -- cluster to be on the trailing track. In this case, the snapshot and the
    -- source cluster are on different tracks.
    RestoreFromClusterSnapshot -> Maybe Text
maintenanceTrackName :: Prelude.Maybe Prelude.Text,
    -- | The default number of days to retain a manual snapshot. If the value is
    -- -1, the snapshot is retained indefinitely. This setting doesn\'t change
    -- the retention period of existing snapshots.
    --
    -- The value must be either -1 or an integer between 1 and 3,653.
    RestoreFromClusterSnapshot -> Maybe Int
manualSnapshotRetentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | The node type that the restored cluster will be provisioned with.
    --
    -- Default: The node type of the cluster from which the snapshot was taken.
    -- You can modify this if you are using any DS node type. In that case, you
    -- can choose to restore into another DS node type of the same size. For
    -- example, you can restore ds1.8xlarge into ds2.8xlarge, or ds1.xlarge
    -- into ds2.xlarge. If you have a DC instance type, you must restore into
    -- that same instance type and size. In other words, you can only restore a
    -- dc1.large instance type into another dc1.large instance type or
    -- dc2.large instance type. You can\'t restore dc1.8xlarge to dc2.8xlarge.
    -- First restore to a dc1.8xlarge cluster, then resize to a dc2.8large
    -- cluster. For more information about node types, see
    -- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-clusters.html#rs-about-clusters-and-nodes About Clusters and Nodes>
    -- in the /Amazon Redshift Cluster Management Guide/.
    RestoreFromClusterSnapshot -> Maybe Text
nodeType :: Prelude.Maybe Prelude.Text,
    -- | The number of nodes specified when provisioning the restored cluster.
    RestoreFromClusterSnapshot -> Maybe Int
numberOfNodes :: Prelude.Maybe Prelude.Int,
    -- | The Amazon Web Services account used to create or copy the snapshot.
    -- Required if you are restoring a snapshot you do not own, optional if you
    -- own the snapshot.
    RestoreFromClusterSnapshot -> Maybe Text
ownerAccount :: Prelude.Maybe Prelude.Text,
    -- | The port number on which the cluster accepts connections.
    --
    -- Default: The same port as the original cluster.
    --
    -- Constraints: Must be between @1115@ and @65535@.
    RestoreFromClusterSnapshot -> Maybe Int
port :: Prelude.Maybe Prelude.Int,
    -- | The weekly time range (in UTC) during which automated cluster
    -- maintenance can occur.
    --
    -- Format: @ddd:hh24:mi-ddd:hh24:mi@
    --
    -- Default: The value selected for the cluster from which the snapshot was
    -- taken. For more information about the time blocks for each region, see
    -- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-clusters.html#rs-maintenance-windows Maintenance Windows>
    -- in Amazon Redshift Cluster Management Guide.
    --
    -- Valid Days: Mon | Tue | Wed | Thu | Fri | Sat | Sun
    --
    -- Constraints: Minimum 30-minute window.
    RestoreFromClusterSnapshot -> Maybe Text
preferredMaintenanceWindow :: Prelude.Maybe Prelude.Text,
    -- | If @true@, the cluster can be accessed from a public network.
    RestoreFromClusterSnapshot -> Maybe Bool
publiclyAccessible :: Prelude.Maybe Prelude.Bool,
    -- | The identifier of the target reserved node offering.
    RestoreFromClusterSnapshot -> Maybe Text
reservedNodeId :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the snapshot associated with the
    -- message to restore from a cluster. You can specify this parameter or
    -- @snapshotIdentifier@, but not both.
    RestoreFromClusterSnapshot -> Maybe Text
snapshotArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the cluster the source snapshot was created from. This
    -- parameter is required if your IAM user has a policy containing a
    -- snapshot resource element that specifies anything other than * for the
    -- cluster name.
    RestoreFromClusterSnapshot -> Maybe Text
snapshotClusterIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The name of the snapshot from which to create the new cluster. This
    -- parameter isn\'t case sensitive. You can specify this parameter or
    -- @snapshotArn@, but not both.
    --
    -- Example: @my-snapshot-id@
    RestoreFromClusterSnapshot -> Maybe Text
snapshotIdentifier :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the snapshot schedule.
    RestoreFromClusterSnapshot -> Maybe Text
snapshotScheduleIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the target reserved node offering.
    RestoreFromClusterSnapshot -> Maybe Text
targetReservedNodeOfferingId :: Prelude.Maybe Prelude.Text,
    -- | A list of Virtual Private Cloud (VPC) security groups to be associated
    -- with the cluster.
    --
    -- Default: The default VPC security group is associated with the cluster.
    --
    -- VPC security groups only apply to clusters in VPCs.
    RestoreFromClusterSnapshot -> Maybe [Text]
vpcSecurityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The identifier of the cluster that will be created from restoring the
    -- snapshot.
    --
    -- Constraints:
    --
    -- -   Must contain from 1 to 63 alphanumeric characters or hyphens.
    --
    -- -   Alphabetic characters must be lowercase.
    --
    -- -   First character must be a letter.
    --
    -- -   Cannot end with a hyphen or contain two consecutive hyphens.
    --
    -- -   Must be unique for all clusters within an Amazon Web Services
    --     account.
    RestoreFromClusterSnapshot -> Text
clusterIdentifier :: Prelude.Text
  }
  deriving (RestoreFromClusterSnapshot -> RestoreFromClusterSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RestoreFromClusterSnapshot -> RestoreFromClusterSnapshot -> Bool
$c/= :: RestoreFromClusterSnapshot -> RestoreFromClusterSnapshot -> Bool
== :: RestoreFromClusterSnapshot -> RestoreFromClusterSnapshot -> Bool
$c== :: RestoreFromClusterSnapshot -> RestoreFromClusterSnapshot -> Bool
Prelude.Eq, ReadPrec [RestoreFromClusterSnapshot]
ReadPrec RestoreFromClusterSnapshot
Int -> ReadS RestoreFromClusterSnapshot
ReadS [RestoreFromClusterSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RestoreFromClusterSnapshot]
$creadListPrec :: ReadPrec [RestoreFromClusterSnapshot]
readPrec :: ReadPrec RestoreFromClusterSnapshot
$creadPrec :: ReadPrec RestoreFromClusterSnapshot
readList :: ReadS [RestoreFromClusterSnapshot]
$creadList :: ReadS [RestoreFromClusterSnapshot]
readsPrec :: Int -> ReadS RestoreFromClusterSnapshot
$creadsPrec :: Int -> ReadS RestoreFromClusterSnapshot
Prelude.Read, Int -> RestoreFromClusterSnapshot -> ShowS
[RestoreFromClusterSnapshot] -> ShowS
RestoreFromClusterSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestoreFromClusterSnapshot] -> ShowS
$cshowList :: [RestoreFromClusterSnapshot] -> ShowS
show :: RestoreFromClusterSnapshot -> String
$cshow :: RestoreFromClusterSnapshot -> String
showsPrec :: Int -> RestoreFromClusterSnapshot -> ShowS
$cshowsPrec :: Int -> RestoreFromClusterSnapshot -> ShowS
Prelude.Show, forall x.
Rep RestoreFromClusterSnapshot x -> RestoreFromClusterSnapshot
forall x.
RestoreFromClusterSnapshot -> Rep RestoreFromClusterSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RestoreFromClusterSnapshot x -> RestoreFromClusterSnapshot
$cfrom :: forall x.
RestoreFromClusterSnapshot -> Rep RestoreFromClusterSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'RestoreFromClusterSnapshot' 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:
--
-- 'additionalInfo', 'restoreFromClusterSnapshot_additionalInfo' - Reserved.
--
-- 'allowVersionUpgrade', 'restoreFromClusterSnapshot_allowVersionUpgrade' - If @true@, major version upgrades can be applied during the maintenance
-- window to the Amazon Redshift engine that is running on the cluster.
--
-- Default: @true@
--
-- 'aquaConfigurationStatus', 'restoreFromClusterSnapshot_aquaConfigurationStatus' - This parameter is retired. It does not set the AQUA configuration
-- status. Amazon Redshift automatically determines whether to use AQUA
-- (Advanced Query Accelerator).
--
-- 'automatedSnapshotRetentionPeriod', 'restoreFromClusterSnapshot_automatedSnapshotRetentionPeriod' - The number of days that automated snapshots are retained. If the value
-- is 0, automated snapshots are disabled. Even if automated snapshots are
-- disabled, you can still create manual snapshots when you want with
-- CreateClusterSnapshot.
--
-- You can\'t disable automated snapshots for RA3 node types. Set the
-- automated retention period from 1-35 days.
--
-- Default: The value selected for the cluster from which the snapshot was
-- taken.
--
-- Constraints: Must be a value from 0 to 35.
--
-- 'availabilityZone', 'restoreFromClusterSnapshot_availabilityZone' - The Amazon EC2 Availability Zone in which to restore the cluster.
--
-- Default: A random, system-chosen Availability Zone.
--
-- Example: @us-east-2a@
--
-- 'availabilityZoneRelocation', 'restoreFromClusterSnapshot_availabilityZoneRelocation' - The option to enable relocation for an Amazon Redshift cluster between
-- Availability Zones after the cluster is restored.
--
-- 'clusterParameterGroupName', 'restoreFromClusterSnapshot_clusterParameterGroupName' - The name of the parameter group to be associated with this cluster.
--
-- Default: The default Amazon Redshift cluster parameter group. For
-- information about the default parameter group, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-parameter-groups.html Working with Amazon Redshift Parameter Groups>.
--
-- Constraints:
--
-- -   Must be 1 to 255 alphanumeric characters or hyphens.
--
-- -   First character must be a letter.
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens.
--
-- 'clusterSecurityGroups', 'restoreFromClusterSnapshot_clusterSecurityGroups' - A list of security groups to be associated with this cluster.
--
-- Default: The default cluster security group for Amazon Redshift.
--
-- Cluster security groups only apply to clusters outside of VPCs.
--
-- 'clusterSubnetGroupName', 'restoreFromClusterSnapshot_clusterSubnetGroupName' - The name of the subnet group where you want to cluster restored.
--
-- A snapshot of cluster in VPC can be restored only in VPC. Therefore, you
-- must provide subnet group name where you want the cluster restored.
--
-- 'defaultIamRoleArn', 'restoreFromClusterSnapshot_defaultIamRoleArn' - The Amazon Resource Name (ARN) for the IAM role that was set as default
-- for the cluster when the cluster was last modified while it was restored
-- from a snapshot.
--
-- 'elasticIp', 'restoreFromClusterSnapshot_elasticIp' - The Elastic IP (EIP) address for the cluster. Don\'t specify the Elastic
-- IP address for a publicly accessible cluster with availability zone
-- relocation turned on.
--
-- 'encrypted', 'restoreFromClusterSnapshot_encrypted' - Enables support for restoring an unencrypted snapshot to a cluster
-- encrypted with Key Management Service (KMS) and a customer managed key.
--
-- 'enhancedVpcRouting', 'restoreFromClusterSnapshot_enhancedVpcRouting' - An option that specifies whether to create the cluster with enhanced VPC
-- routing enabled. To create a cluster that uses enhanced VPC routing, the
-- cluster must be in a VPC. For more information, see
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/enhanced-vpc-routing.html Enhanced VPC Routing>
-- in the Amazon Redshift Cluster Management Guide.
--
-- If this option is @true@, enhanced VPC routing is enabled.
--
-- Default: false
--
-- 'hsmClientCertificateIdentifier', 'restoreFromClusterSnapshot_hsmClientCertificateIdentifier' - Specifies the name of the HSM client certificate the Amazon Redshift
-- cluster uses to retrieve the data encryption keys stored in an HSM.
--
-- 'hsmConfigurationIdentifier', 'restoreFromClusterSnapshot_hsmConfigurationIdentifier' - Specifies the name of the HSM configuration that contains the
-- information the Amazon Redshift cluster can use to retrieve and store
-- keys in an HSM.
--
-- 'iamRoles', 'restoreFromClusterSnapshot_iamRoles' - A list of Identity and Access Management (IAM) roles that can be used by
-- the cluster to access other Amazon Web Services services. You must
-- supply the IAM roles in their Amazon Resource Name (ARN) format.
--
-- The maximum number of IAM roles that you can associate is subject to a
-- quota. For more information, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/amazon-redshift-limits.html Quotas and limits>
-- in the /Amazon Redshift Cluster Management Guide/.
--
-- 'kmsKeyId', 'restoreFromClusterSnapshot_kmsKeyId' - The Key Management Service (KMS) key ID of the encryption key that
-- encrypts data in the cluster restored from a shared snapshot. You can
-- also provide the key ID when you restore from an unencrypted snapshot to
-- an encrypted cluster in the same account. Additionally, you can specify
-- a new KMS key ID when you restore from an encrypted snapshot in the same
-- account in order to change it. In that case, the restored cluster is
-- encrypted with the new KMS key ID.
--
-- 'maintenanceTrackName', 'restoreFromClusterSnapshot_maintenanceTrackName' - The name of the maintenance track for the restored cluster. When you
-- take a snapshot, the snapshot inherits the @MaintenanceTrack@ value from
-- the cluster. The snapshot might be on a different track than the cluster
-- that was the source for the snapshot. For example, suppose that you take
-- a snapshot of a cluster that is on the current track and then change the
-- cluster to be on the trailing track. In this case, the snapshot and the
-- source cluster are on different tracks.
--
-- 'manualSnapshotRetentionPeriod', 'restoreFromClusterSnapshot_manualSnapshotRetentionPeriod' - The default number of days to retain a manual snapshot. If the value is
-- -1, the snapshot is retained indefinitely. This setting doesn\'t change
-- the retention period of existing snapshots.
--
-- The value must be either -1 or an integer between 1 and 3,653.
--
-- 'nodeType', 'restoreFromClusterSnapshot_nodeType' - The node type that the restored cluster will be provisioned with.
--
-- Default: The node type of the cluster from which the snapshot was taken.
-- You can modify this if you are using any DS node type. In that case, you
-- can choose to restore into another DS node type of the same size. For
-- example, you can restore ds1.8xlarge into ds2.8xlarge, or ds1.xlarge
-- into ds2.xlarge. If you have a DC instance type, you must restore into
-- that same instance type and size. In other words, you can only restore a
-- dc1.large instance type into another dc1.large instance type or
-- dc2.large instance type. You can\'t restore dc1.8xlarge to dc2.8xlarge.
-- First restore to a dc1.8xlarge cluster, then resize to a dc2.8large
-- cluster. For more information about node types, see
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-clusters.html#rs-about-clusters-and-nodes About Clusters and Nodes>
-- in the /Amazon Redshift Cluster Management Guide/.
--
-- 'numberOfNodes', 'restoreFromClusterSnapshot_numberOfNodes' - The number of nodes specified when provisioning the restored cluster.
--
-- 'ownerAccount', 'restoreFromClusterSnapshot_ownerAccount' - The Amazon Web Services account used to create or copy the snapshot.
-- Required if you are restoring a snapshot you do not own, optional if you
-- own the snapshot.
--
-- 'port', 'restoreFromClusterSnapshot_port' - The port number on which the cluster accepts connections.
--
-- Default: The same port as the original cluster.
--
-- Constraints: Must be between @1115@ and @65535@.
--
-- 'preferredMaintenanceWindow', 'restoreFromClusterSnapshot_preferredMaintenanceWindow' - The weekly time range (in UTC) during which automated cluster
-- maintenance can occur.
--
-- Format: @ddd:hh24:mi-ddd:hh24:mi@
--
-- Default: The value selected for the cluster from which the snapshot was
-- taken. For more information about the time blocks for each region, see
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-clusters.html#rs-maintenance-windows Maintenance Windows>
-- in Amazon Redshift Cluster Management Guide.
--
-- Valid Days: Mon | Tue | Wed | Thu | Fri | Sat | Sun
--
-- Constraints: Minimum 30-minute window.
--
-- 'publiclyAccessible', 'restoreFromClusterSnapshot_publiclyAccessible' - If @true@, the cluster can be accessed from a public network.
--
-- 'reservedNodeId', 'restoreFromClusterSnapshot_reservedNodeId' - The identifier of the target reserved node offering.
--
-- 'snapshotArn', 'restoreFromClusterSnapshot_snapshotArn' - The Amazon Resource Name (ARN) of the snapshot associated with the
-- message to restore from a cluster. You can specify this parameter or
-- @snapshotIdentifier@, but not both.
--
-- 'snapshotClusterIdentifier', 'restoreFromClusterSnapshot_snapshotClusterIdentifier' - The name of the cluster the source snapshot was created from. This
-- parameter is required if your IAM user has a policy containing a
-- snapshot resource element that specifies anything other than * for the
-- cluster name.
--
-- 'snapshotIdentifier', 'restoreFromClusterSnapshot_snapshotIdentifier' - The name of the snapshot from which to create the new cluster. This
-- parameter isn\'t case sensitive. You can specify this parameter or
-- @snapshotArn@, but not both.
--
-- Example: @my-snapshot-id@
--
-- 'snapshotScheduleIdentifier', 'restoreFromClusterSnapshot_snapshotScheduleIdentifier' - A unique identifier for the snapshot schedule.
--
-- 'targetReservedNodeOfferingId', 'restoreFromClusterSnapshot_targetReservedNodeOfferingId' - The identifier of the target reserved node offering.
--
-- 'vpcSecurityGroupIds', 'restoreFromClusterSnapshot_vpcSecurityGroupIds' - A list of Virtual Private Cloud (VPC) security groups to be associated
-- with the cluster.
--
-- Default: The default VPC security group is associated with the cluster.
--
-- VPC security groups only apply to clusters in VPCs.
--
-- 'clusterIdentifier', 'restoreFromClusterSnapshot_clusterIdentifier' - The identifier of the cluster that will be created from restoring the
-- snapshot.
--
-- Constraints:
--
-- -   Must contain from 1 to 63 alphanumeric characters or hyphens.
--
-- -   Alphabetic characters must be lowercase.
--
-- -   First character must be a letter.
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens.
--
-- -   Must be unique for all clusters within an Amazon Web Services
--     account.
newRestoreFromClusterSnapshot ::
  -- | 'clusterIdentifier'
  Prelude.Text ->
  RestoreFromClusterSnapshot
newRestoreFromClusterSnapshot :: Text -> RestoreFromClusterSnapshot
newRestoreFromClusterSnapshot Text
pClusterIdentifier_ =
  RestoreFromClusterSnapshot'
    { $sel:additionalInfo:RestoreFromClusterSnapshot' :: Maybe Text
additionalInfo =
        forall a. Maybe a
Prelude.Nothing,
      $sel:allowVersionUpgrade:RestoreFromClusterSnapshot' :: Maybe Bool
allowVersionUpgrade = forall a. Maybe a
Prelude.Nothing,
      $sel:aquaConfigurationStatus:RestoreFromClusterSnapshot' :: Maybe AquaConfigurationStatus
aquaConfigurationStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:automatedSnapshotRetentionPeriod:RestoreFromClusterSnapshot' :: Maybe Int
automatedSnapshotRetentionPeriod =
        forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZone:RestoreFromClusterSnapshot' :: Maybe Text
availabilityZone = forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZoneRelocation:RestoreFromClusterSnapshot' :: Maybe Bool
availabilityZoneRelocation = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterParameterGroupName:RestoreFromClusterSnapshot' :: Maybe Text
clusterParameterGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterSecurityGroups:RestoreFromClusterSnapshot' :: Maybe [Text]
clusterSecurityGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterSubnetGroupName:RestoreFromClusterSnapshot' :: Maybe Text
clusterSubnetGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultIamRoleArn:RestoreFromClusterSnapshot' :: Maybe Text
defaultIamRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:elasticIp:RestoreFromClusterSnapshot' :: Maybe Text
elasticIp = forall a. Maybe a
Prelude.Nothing,
      $sel:encrypted:RestoreFromClusterSnapshot' :: Maybe Bool
encrypted = forall a. Maybe a
Prelude.Nothing,
      $sel:enhancedVpcRouting:RestoreFromClusterSnapshot' :: Maybe Bool
enhancedVpcRouting = forall a. Maybe a
Prelude.Nothing,
      $sel:hsmClientCertificateIdentifier:RestoreFromClusterSnapshot' :: Maybe Text
hsmClientCertificateIdentifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:hsmConfigurationIdentifier:RestoreFromClusterSnapshot' :: Maybe Text
hsmConfigurationIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:iamRoles:RestoreFromClusterSnapshot' :: Maybe [Text]
iamRoles = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:RestoreFromClusterSnapshot' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:maintenanceTrackName:RestoreFromClusterSnapshot' :: Maybe Text
maintenanceTrackName = forall a. Maybe a
Prelude.Nothing,
      $sel:manualSnapshotRetentionPeriod:RestoreFromClusterSnapshot' :: Maybe Int
manualSnapshotRetentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:nodeType:RestoreFromClusterSnapshot' :: Maybe Text
nodeType = forall a. Maybe a
Prelude.Nothing,
      $sel:numberOfNodes:RestoreFromClusterSnapshot' :: Maybe Int
numberOfNodes = forall a. Maybe a
Prelude.Nothing,
      $sel:ownerAccount:RestoreFromClusterSnapshot' :: Maybe Text
ownerAccount = forall a. Maybe a
Prelude.Nothing,
      $sel:port:RestoreFromClusterSnapshot' :: Maybe Int
port = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredMaintenanceWindow:RestoreFromClusterSnapshot' :: Maybe Text
preferredMaintenanceWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:publiclyAccessible:RestoreFromClusterSnapshot' :: Maybe Bool
publiclyAccessible = forall a. Maybe a
Prelude.Nothing,
      $sel:reservedNodeId:RestoreFromClusterSnapshot' :: Maybe Text
reservedNodeId = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotArn:RestoreFromClusterSnapshot' :: Maybe Text
snapshotArn = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotClusterIdentifier:RestoreFromClusterSnapshot' :: Maybe Text
snapshotClusterIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotIdentifier:RestoreFromClusterSnapshot' :: Maybe Text
snapshotIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotScheduleIdentifier:RestoreFromClusterSnapshot' :: Maybe Text
snapshotScheduleIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:targetReservedNodeOfferingId:RestoreFromClusterSnapshot' :: Maybe Text
targetReservedNodeOfferingId = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcSecurityGroupIds:RestoreFromClusterSnapshot' :: Maybe [Text]
vpcSecurityGroupIds = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterIdentifier:RestoreFromClusterSnapshot' :: Text
clusterIdentifier = Text
pClusterIdentifier_
    }

-- | Reserved.
restoreFromClusterSnapshot_additionalInfo :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_additionalInfo :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_additionalInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
additionalInfo :: Maybe Text
$sel:additionalInfo:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
additionalInfo} -> Maybe Text
additionalInfo) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:additionalInfo:RestoreFromClusterSnapshot' :: Maybe Text
additionalInfo = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | If @true@, major version upgrades can be applied during the maintenance
-- window to the Amazon Redshift engine that is running on the cluster.
--
-- Default: @true@
restoreFromClusterSnapshot_allowVersionUpgrade :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Bool)
restoreFromClusterSnapshot_allowVersionUpgrade :: Lens' RestoreFromClusterSnapshot (Maybe Bool)
restoreFromClusterSnapshot_allowVersionUpgrade = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Bool
allowVersionUpgrade :: Maybe Bool
$sel:allowVersionUpgrade:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
allowVersionUpgrade} -> Maybe Bool
allowVersionUpgrade) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Bool
a -> RestoreFromClusterSnapshot
s {$sel:allowVersionUpgrade:RestoreFromClusterSnapshot' :: Maybe Bool
allowVersionUpgrade = Maybe Bool
a} :: RestoreFromClusterSnapshot)

-- | This parameter is retired. It does not set the AQUA configuration
-- status. Amazon Redshift automatically determines whether to use AQUA
-- (Advanced Query Accelerator).
restoreFromClusterSnapshot_aquaConfigurationStatus :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe AquaConfigurationStatus)
restoreFromClusterSnapshot_aquaConfigurationStatus :: Lens' RestoreFromClusterSnapshot (Maybe AquaConfigurationStatus)
restoreFromClusterSnapshot_aquaConfigurationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe AquaConfigurationStatus
aquaConfigurationStatus :: Maybe AquaConfigurationStatus
$sel:aquaConfigurationStatus:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe AquaConfigurationStatus
aquaConfigurationStatus} -> Maybe AquaConfigurationStatus
aquaConfigurationStatus) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe AquaConfigurationStatus
a -> RestoreFromClusterSnapshot
s {$sel:aquaConfigurationStatus:RestoreFromClusterSnapshot' :: Maybe AquaConfigurationStatus
aquaConfigurationStatus = Maybe AquaConfigurationStatus
a} :: RestoreFromClusterSnapshot)

-- | The number of days that automated snapshots are retained. If the value
-- is 0, automated snapshots are disabled. Even if automated snapshots are
-- disabled, you can still create manual snapshots when you want with
-- CreateClusterSnapshot.
--
-- You can\'t disable automated snapshots for RA3 node types. Set the
-- automated retention period from 1-35 days.
--
-- Default: The value selected for the cluster from which the snapshot was
-- taken.
--
-- Constraints: Must be a value from 0 to 35.
restoreFromClusterSnapshot_automatedSnapshotRetentionPeriod :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Int)
restoreFromClusterSnapshot_automatedSnapshotRetentionPeriod :: Lens' RestoreFromClusterSnapshot (Maybe Int)
restoreFromClusterSnapshot_automatedSnapshotRetentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Int
automatedSnapshotRetentionPeriod :: Maybe Int
$sel:automatedSnapshotRetentionPeriod:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
automatedSnapshotRetentionPeriod} -> Maybe Int
automatedSnapshotRetentionPeriod) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Int
a -> RestoreFromClusterSnapshot
s {$sel:automatedSnapshotRetentionPeriod:RestoreFromClusterSnapshot' :: Maybe Int
automatedSnapshotRetentionPeriod = Maybe Int
a} :: RestoreFromClusterSnapshot)

-- | The Amazon EC2 Availability Zone in which to restore the cluster.
--
-- Default: A random, system-chosen Availability Zone.
--
-- Example: @us-east-2a@
restoreFromClusterSnapshot_availabilityZone :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_availabilityZone :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
availabilityZone :: Maybe Text
$sel:availabilityZone:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
availabilityZone} -> Maybe Text
availabilityZone) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:availabilityZone:RestoreFromClusterSnapshot' :: Maybe Text
availabilityZone = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | The option to enable relocation for an Amazon Redshift cluster between
-- Availability Zones after the cluster is restored.
restoreFromClusterSnapshot_availabilityZoneRelocation :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Bool)
restoreFromClusterSnapshot_availabilityZoneRelocation :: Lens' RestoreFromClusterSnapshot (Maybe Bool)
restoreFromClusterSnapshot_availabilityZoneRelocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Bool
availabilityZoneRelocation :: Maybe Bool
$sel:availabilityZoneRelocation:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
availabilityZoneRelocation} -> Maybe Bool
availabilityZoneRelocation) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Bool
a -> RestoreFromClusterSnapshot
s {$sel:availabilityZoneRelocation:RestoreFromClusterSnapshot' :: Maybe Bool
availabilityZoneRelocation = Maybe Bool
a} :: RestoreFromClusterSnapshot)

-- | The name of the parameter group to be associated with this cluster.
--
-- Default: The default Amazon Redshift cluster parameter group. For
-- information about the default parameter group, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-parameter-groups.html Working with Amazon Redshift Parameter Groups>.
--
-- Constraints:
--
-- -   Must be 1 to 255 alphanumeric characters or hyphens.
--
-- -   First character must be a letter.
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens.
restoreFromClusterSnapshot_clusterParameterGroupName :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_clusterParameterGroupName :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_clusterParameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
clusterParameterGroupName :: Maybe Text
$sel:clusterParameterGroupName:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
clusterParameterGroupName} -> Maybe Text
clusterParameterGroupName) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:clusterParameterGroupName:RestoreFromClusterSnapshot' :: Maybe Text
clusterParameterGroupName = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | A list of security groups to be associated with this cluster.
--
-- Default: The default cluster security group for Amazon Redshift.
--
-- Cluster security groups only apply to clusters outside of VPCs.
restoreFromClusterSnapshot_clusterSecurityGroups :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe [Prelude.Text])
restoreFromClusterSnapshot_clusterSecurityGroups :: Lens' RestoreFromClusterSnapshot (Maybe [Text])
restoreFromClusterSnapshot_clusterSecurityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe [Text]
clusterSecurityGroups :: Maybe [Text]
$sel:clusterSecurityGroups:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe [Text]
clusterSecurityGroups} -> Maybe [Text]
clusterSecurityGroups) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe [Text]
a -> RestoreFromClusterSnapshot
s {$sel:clusterSecurityGroups:RestoreFromClusterSnapshot' :: Maybe [Text]
clusterSecurityGroups = Maybe [Text]
a} :: RestoreFromClusterSnapshot) 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 subnet group where you want to cluster restored.
--
-- A snapshot of cluster in VPC can be restored only in VPC. Therefore, you
-- must provide subnet group name where you want the cluster restored.
restoreFromClusterSnapshot_clusterSubnetGroupName :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_clusterSubnetGroupName :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_clusterSubnetGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
clusterSubnetGroupName :: Maybe Text
$sel:clusterSubnetGroupName:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
clusterSubnetGroupName} -> Maybe Text
clusterSubnetGroupName) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:clusterSubnetGroupName:RestoreFromClusterSnapshot' :: Maybe Text
clusterSubnetGroupName = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | The Amazon Resource Name (ARN) for the IAM role that was set as default
-- for the cluster when the cluster was last modified while it was restored
-- from a snapshot.
restoreFromClusterSnapshot_defaultIamRoleArn :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_defaultIamRoleArn :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_defaultIamRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
defaultIamRoleArn :: Maybe Text
$sel:defaultIamRoleArn:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
defaultIamRoleArn} -> Maybe Text
defaultIamRoleArn) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:defaultIamRoleArn:RestoreFromClusterSnapshot' :: Maybe Text
defaultIamRoleArn = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | The Elastic IP (EIP) address for the cluster. Don\'t specify the Elastic
-- IP address for a publicly accessible cluster with availability zone
-- relocation turned on.
restoreFromClusterSnapshot_elasticIp :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_elasticIp :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_elasticIp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
elasticIp :: Maybe Text
$sel:elasticIp:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
elasticIp} -> Maybe Text
elasticIp) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:elasticIp:RestoreFromClusterSnapshot' :: Maybe Text
elasticIp = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | Enables support for restoring an unencrypted snapshot to a cluster
-- encrypted with Key Management Service (KMS) and a customer managed key.
restoreFromClusterSnapshot_encrypted :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Bool)
restoreFromClusterSnapshot_encrypted :: Lens' RestoreFromClusterSnapshot (Maybe Bool)
restoreFromClusterSnapshot_encrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Bool
encrypted :: Maybe Bool
$sel:encrypted:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
encrypted} -> Maybe Bool
encrypted) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Bool
a -> RestoreFromClusterSnapshot
s {$sel:encrypted:RestoreFromClusterSnapshot' :: Maybe Bool
encrypted = Maybe Bool
a} :: RestoreFromClusterSnapshot)

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

-- | Specifies the name of the HSM client certificate the Amazon Redshift
-- cluster uses to retrieve the data encryption keys stored in an HSM.
restoreFromClusterSnapshot_hsmClientCertificateIdentifier :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_hsmClientCertificateIdentifier :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_hsmClientCertificateIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
hsmClientCertificateIdentifier :: Maybe Text
$sel:hsmClientCertificateIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
hsmClientCertificateIdentifier} -> Maybe Text
hsmClientCertificateIdentifier) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:hsmClientCertificateIdentifier:RestoreFromClusterSnapshot' :: Maybe Text
hsmClientCertificateIdentifier = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | Specifies the name of the HSM configuration that contains the
-- information the Amazon Redshift cluster can use to retrieve and store
-- keys in an HSM.
restoreFromClusterSnapshot_hsmConfigurationIdentifier :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_hsmConfigurationIdentifier :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_hsmConfigurationIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
hsmConfigurationIdentifier :: Maybe Text
$sel:hsmConfigurationIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
hsmConfigurationIdentifier} -> Maybe Text
hsmConfigurationIdentifier) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:hsmConfigurationIdentifier:RestoreFromClusterSnapshot' :: Maybe Text
hsmConfigurationIdentifier = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | A list of Identity and Access Management (IAM) roles that can be used by
-- the cluster to access other Amazon Web Services services. You must
-- supply the IAM roles in their Amazon Resource Name (ARN) format.
--
-- The maximum number of IAM roles that you can associate is subject to a
-- quota. For more information, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/amazon-redshift-limits.html Quotas and limits>
-- in the /Amazon Redshift Cluster Management Guide/.
restoreFromClusterSnapshot_iamRoles :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe [Prelude.Text])
restoreFromClusterSnapshot_iamRoles :: Lens' RestoreFromClusterSnapshot (Maybe [Text])
restoreFromClusterSnapshot_iamRoles = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe [Text]
iamRoles :: Maybe [Text]
$sel:iamRoles:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe [Text]
iamRoles} -> Maybe [Text]
iamRoles) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe [Text]
a -> RestoreFromClusterSnapshot
s {$sel:iamRoles:RestoreFromClusterSnapshot' :: Maybe [Text]
iamRoles = Maybe [Text]
a} :: RestoreFromClusterSnapshot) 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 Key Management Service (KMS) key ID of the encryption key that
-- encrypts data in the cluster restored from a shared snapshot. You can
-- also provide the key ID when you restore from an unencrypted snapshot to
-- an encrypted cluster in the same account. Additionally, you can specify
-- a new KMS key ID when you restore from an encrypted snapshot in the same
-- account in order to change it. In that case, the restored cluster is
-- encrypted with the new KMS key ID.
restoreFromClusterSnapshot_kmsKeyId :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_kmsKeyId :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:kmsKeyId:RestoreFromClusterSnapshot' :: Maybe Text
kmsKeyId = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | The name of the maintenance track for the restored cluster. When you
-- take a snapshot, the snapshot inherits the @MaintenanceTrack@ value from
-- the cluster. The snapshot might be on a different track than the cluster
-- that was the source for the snapshot. For example, suppose that you take
-- a snapshot of a cluster that is on the current track and then change the
-- cluster to be on the trailing track. In this case, the snapshot and the
-- source cluster are on different tracks.
restoreFromClusterSnapshot_maintenanceTrackName :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_maintenanceTrackName :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_maintenanceTrackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
maintenanceTrackName :: Maybe Text
$sel:maintenanceTrackName:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
maintenanceTrackName} -> Maybe Text
maintenanceTrackName) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:maintenanceTrackName:RestoreFromClusterSnapshot' :: Maybe Text
maintenanceTrackName = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | The default number of days to retain a manual snapshot. If the value is
-- -1, the snapshot is retained indefinitely. This setting doesn\'t change
-- the retention period of existing snapshots.
--
-- The value must be either -1 or an integer between 1 and 3,653.
restoreFromClusterSnapshot_manualSnapshotRetentionPeriod :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Int)
restoreFromClusterSnapshot_manualSnapshotRetentionPeriod :: Lens' RestoreFromClusterSnapshot (Maybe Int)
restoreFromClusterSnapshot_manualSnapshotRetentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Int
manualSnapshotRetentionPeriod :: Maybe Int
$sel:manualSnapshotRetentionPeriod:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
manualSnapshotRetentionPeriod} -> Maybe Int
manualSnapshotRetentionPeriod) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Int
a -> RestoreFromClusterSnapshot
s {$sel:manualSnapshotRetentionPeriod:RestoreFromClusterSnapshot' :: Maybe Int
manualSnapshotRetentionPeriod = Maybe Int
a} :: RestoreFromClusterSnapshot)

-- | The node type that the restored cluster will be provisioned with.
--
-- Default: The node type of the cluster from which the snapshot was taken.
-- You can modify this if you are using any DS node type. In that case, you
-- can choose to restore into another DS node type of the same size. For
-- example, you can restore ds1.8xlarge into ds2.8xlarge, or ds1.xlarge
-- into ds2.xlarge. If you have a DC instance type, you must restore into
-- that same instance type and size. In other words, you can only restore a
-- dc1.large instance type into another dc1.large instance type or
-- dc2.large instance type. You can\'t restore dc1.8xlarge to dc2.8xlarge.
-- First restore to a dc1.8xlarge cluster, then resize to a dc2.8large
-- cluster. For more information about node types, see
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-clusters.html#rs-about-clusters-and-nodes About Clusters and Nodes>
-- in the /Amazon Redshift Cluster Management Guide/.
restoreFromClusterSnapshot_nodeType :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_nodeType :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_nodeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
nodeType :: Maybe Text
$sel:nodeType:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
nodeType} -> Maybe Text
nodeType) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:nodeType:RestoreFromClusterSnapshot' :: Maybe Text
nodeType = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | The number of nodes specified when provisioning the restored cluster.
restoreFromClusterSnapshot_numberOfNodes :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Int)
restoreFromClusterSnapshot_numberOfNodes :: Lens' RestoreFromClusterSnapshot (Maybe Int)
restoreFromClusterSnapshot_numberOfNodes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Int
numberOfNodes :: Maybe Int
$sel:numberOfNodes:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
numberOfNodes} -> Maybe Int
numberOfNodes) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Int
a -> RestoreFromClusterSnapshot
s {$sel:numberOfNodes:RestoreFromClusterSnapshot' :: Maybe Int
numberOfNodes = Maybe Int
a} :: RestoreFromClusterSnapshot)

-- | The Amazon Web Services account used to create or copy the snapshot.
-- Required if you are restoring a snapshot you do not own, optional if you
-- own the snapshot.
restoreFromClusterSnapshot_ownerAccount :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_ownerAccount :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_ownerAccount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
ownerAccount :: Maybe Text
$sel:ownerAccount:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
ownerAccount} -> Maybe Text
ownerAccount) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:ownerAccount:RestoreFromClusterSnapshot' :: Maybe Text
ownerAccount = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | The port number on which the cluster accepts connections.
--
-- Default: The same port as the original cluster.
--
-- Constraints: Must be between @1115@ and @65535@.
restoreFromClusterSnapshot_port :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Int)
restoreFromClusterSnapshot_port :: Lens' RestoreFromClusterSnapshot (Maybe Int)
restoreFromClusterSnapshot_port = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Int
port :: Maybe Int
$sel:port:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
port} -> Maybe Int
port) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Int
a -> RestoreFromClusterSnapshot
s {$sel:port:RestoreFromClusterSnapshot' :: Maybe Int
port = Maybe Int
a} :: RestoreFromClusterSnapshot)

-- | The weekly time range (in UTC) during which automated cluster
-- maintenance can occur.
--
-- Format: @ddd:hh24:mi-ddd:hh24:mi@
--
-- Default: The value selected for the cluster from which the snapshot was
-- taken. For more information about the time blocks for each region, see
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-clusters.html#rs-maintenance-windows Maintenance Windows>
-- in Amazon Redshift Cluster Management Guide.
--
-- Valid Days: Mon | Tue | Wed | Thu | Fri | Sat | Sun
--
-- Constraints: Minimum 30-minute window.
restoreFromClusterSnapshot_preferredMaintenanceWindow :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_preferredMaintenanceWindow :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_preferredMaintenanceWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
preferredMaintenanceWindow :: Maybe Text
$sel:preferredMaintenanceWindow:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
preferredMaintenanceWindow} -> Maybe Text
preferredMaintenanceWindow) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:preferredMaintenanceWindow:RestoreFromClusterSnapshot' :: Maybe Text
preferredMaintenanceWindow = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | If @true@, the cluster can be accessed from a public network.
restoreFromClusterSnapshot_publiclyAccessible :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Bool)
restoreFromClusterSnapshot_publiclyAccessible :: Lens' RestoreFromClusterSnapshot (Maybe Bool)
restoreFromClusterSnapshot_publiclyAccessible = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Bool
publiclyAccessible :: Maybe Bool
$sel:publiclyAccessible:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
publiclyAccessible} -> Maybe Bool
publiclyAccessible) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Bool
a -> RestoreFromClusterSnapshot
s {$sel:publiclyAccessible:RestoreFromClusterSnapshot' :: Maybe Bool
publiclyAccessible = Maybe Bool
a} :: RestoreFromClusterSnapshot)

-- | The identifier of the target reserved node offering.
restoreFromClusterSnapshot_reservedNodeId :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_reservedNodeId :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_reservedNodeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
reservedNodeId :: Maybe Text
$sel:reservedNodeId:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
reservedNodeId} -> Maybe Text
reservedNodeId) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:reservedNodeId:RestoreFromClusterSnapshot' :: Maybe Text
reservedNodeId = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | The Amazon Resource Name (ARN) of the snapshot associated with the
-- message to restore from a cluster. You can specify this parameter or
-- @snapshotIdentifier@, but not both.
restoreFromClusterSnapshot_snapshotArn :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_snapshotArn :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_snapshotArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
snapshotArn :: Maybe Text
$sel:snapshotArn:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
snapshotArn} -> Maybe Text
snapshotArn) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:snapshotArn:RestoreFromClusterSnapshot' :: Maybe Text
snapshotArn = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | The name of the cluster the source snapshot was created from. This
-- parameter is required if your IAM user has a policy containing a
-- snapshot resource element that specifies anything other than * for the
-- cluster name.
restoreFromClusterSnapshot_snapshotClusterIdentifier :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_snapshotClusterIdentifier :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_snapshotClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
snapshotClusterIdentifier :: Maybe Text
$sel:snapshotClusterIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
snapshotClusterIdentifier} -> Maybe Text
snapshotClusterIdentifier) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:snapshotClusterIdentifier:RestoreFromClusterSnapshot' :: Maybe Text
snapshotClusterIdentifier = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | The name of the snapshot from which to create the new cluster. This
-- parameter isn\'t case sensitive. You can specify this parameter or
-- @snapshotArn@, but not both.
--
-- Example: @my-snapshot-id@
restoreFromClusterSnapshot_snapshotIdentifier :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_snapshotIdentifier :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_snapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
snapshotIdentifier :: Maybe Text
$sel:snapshotIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
snapshotIdentifier} -> Maybe Text
snapshotIdentifier) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:snapshotIdentifier:RestoreFromClusterSnapshot' :: Maybe Text
snapshotIdentifier = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | A unique identifier for the snapshot schedule.
restoreFromClusterSnapshot_snapshotScheduleIdentifier :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_snapshotScheduleIdentifier :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_snapshotScheduleIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
snapshotScheduleIdentifier :: Maybe Text
$sel:snapshotScheduleIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
snapshotScheduleIdentifier} -> Maybe Text
snapshotScheduleIdentifier) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:snapshotScheduleIdentifier:RestoreFromClusterSnapshot' :: Maybe Text
snapshotScheduleIdentifier = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | The identifier of the target reserved node offering.
restoreFromClusterSnapshot_targetReservedNodeOfferingId :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe Prelude.Text)
restoreFromClusterSnapshot_targetReservedNodeOfferingId :: Lens' RestoreFromClusterSnapshot (Maybe Text)
restoreFromClusterSnapshot_targetReservedNodeOfferingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe Text
targetReservedNodeOfferingId :: Maybe Text
$sel:targetReservedNodeOfferingId:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
targetReservedNodeOfferingId} -> Maybe Text
targetReservedNodeOfferingId) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe Text
a -> RestoreFromClusterSnapshot
s {$sel:targetReservedNodeOfferingId:RestoreFromClusterSnapshot' :: Maybe Text
targetReservedNodeOfferingId = Maybe Text
a} :: RestoreFromClusterSnapshot)

-- | A list of Virtual Private Cloud (VPC) security groups to be associated
-- with the cluster.
--
-- Default: The default VPC security group is associated with the cluster.
--
-- VPC security groups only apply to clusters in VPCs.
restoreFromClusterSnapshot_vpcSecurityGroupIds :: Lens.Lens' RestoreFromClusterSnapshot (Prelude.Maybe [Prelude.Text])
restoreFromClusterSnapshot_vpcSecurityGroupIds :: Lens' RestoreFromClusterSnapshot (Maybe [Text])
restoreFromClusterSnapshot_vpcSecurityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Maybe [Text]
vpcSecurityGroupIds :: Maybe [Text]
$sel:vpcSecurityGroupIds:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe [Text]
vpcSecurityGroupIds} -> Maybe [Text]
vpcSecurityGroupIds) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Maybe [Text]
a -> RestoreFromClusterSnapshot
s {$sel:vpcSecurityGroupIds:RestoreFromClusterSnapshot' :: Maybe [Text]
vpcSecurityGroupIds = Maybe [Text]
a} :: RestoreFromClusterSnapshot) 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 identifier of the cluster that will be created from restoring the
-- snapshot.
--
-- Constraints:
--
-- -   Must contain from 1 to 63 alphanumeric characters or hyphens.
--
-- -   Alphabetic characters must be lowercase.
--
-- -   First character must be a letter.
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens.
--
-- -   Must be unique for all clusters within an Amazon Web Services
--     account.
restoreFromClusterSnapshot_clusterIdentifier :: Lens.Lens' RestoreFromClusterSnapshot Prelude.Text
restoreFromClusterSnapshot_clusterIdentifier :: Lens' RestoreFromClusterSnapshot Text
restoreFromClusterSnapshot_clusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshot' {Text
clusterIdentifier :: Text
$sel:clusterIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Text
clusterIdentifier} -> Text
clusterIdentifier) (\s :: RestoreFromClusterSnapshot
s@RestoreFromClusterSnapshot' {} Text
a -> RestoreFromClusterSnapshot
s {$sel:clusterIdentifier:RestoreFromClusterSnapshot' :: Text
clusterIdentifier = Text
a} :: RestoreFromClusterSnapshot)

instance Core.AWSRequest RestoreFromClusterSnapshot where
  type
    AWSResponse RestoreFromClusterSnapshot =
      RestoreFromClusterSnapshotResponse
  request :: (Service -> Service)
-> RestoreFromClusterSnapshot -> Request RestoreFromClusterSnapshot
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 RestoreFromClusterSnapshot
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RestoreFromClusterSnapshot)))
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
"RestoreFromClusterSnapshotResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Cluster -> Int -> RestoreFromClusterSnapshotResponse
RestoreFromClusterSnapshotResponse'
            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
"Cluster")
            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 RestoreFromClusterSnapshot where
  hashWithSalt :: Int -> RestoreFromClusterSnapshot -> Int
hashWithSalt Int
_salt RestoreFromClusterSnapshot' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Maybe AquaConfigurationStatus
Text
clusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
targetReservedNodeOfferingId :: Maybe Text
snapshotScheduleIdentifier :: Maybe Text
snapshotIdentifier :: Maybe Text
snapshotClusterIdentifier :: Maybe Text
snapshotArn :: Maybe Text
reservedNodeId :: Maybe Text
publiclyAccessible :: Maybe Bool
preferredMaintenanceWindow :: Maybe Text
port :: Maybe Int
ownerAccount :: Maybe Text
numberOfNodes :: Maybe Int
nodeType :: Maybe Text
manualSnapshotRetentionPeriod :: Maybe Int
maintenanceTrackName :: Maybe Text
kmsKeyId :: Maybe Text
iamRoles :: Maybe [Text]
hsmConfigurationIdentifier :: Maybe Text
hsmClientCertificateIdentifier :: Maybe Text
enhancedVpcRouting :: Maybe Bool
encrypted :: Maybe Bool
elasticIp :: Maybe Text
defaultIamRoleArn :: Maybe Text
clusterSubnetGroupName :: Maybe Text
clusterSecurityGroups :: Maybe [Text]
clusterParameterGroupName :: Maybe Text
availabilityZoneRelocation :: Maybe Bool
availabilityZone :: Maybe Text
automatedSnapshotRetentionPeriod :: Maybe Int
aquaConfigurationStatus :: Maybe AquaConfigurationStatus
allowVersionUpgrade :: Maybe Bool
additionalInfo :: Maybe Text
$sel:clusterIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Text
$sel:vpcSecurityGroupIds:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe [Text]
$sel:targetReservedNodeOfferingId:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:snapshotScheduleIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:snapshotIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:snapshotClusterIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:snapshotArn:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:reservedNodeId:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:publiclyAccessible:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:preferredMaintenanceWindow:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:port:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
$sel:ownerAccount:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:numberOfNodes:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
$sel:nodeType:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:manualSnapshotRetentionPeriod:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
$sel:maintenanceTrackName:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:kmsKeyId:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:iamRoles:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe [Text]
$sel:hsmConfigurationIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:hsmClientCertificateIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:enhancedVpcRouting:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:encrypted:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:elasticIp:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:defaultIamRoleArn:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:clusterSubnetGroupName:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:clusterSecurityGroups:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe [Text]
$sel:clusterParameterGroupName:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:availabilityZoneRelocation:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:availabilityZone:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:automatedSnapshotRetentionPeriod:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
$sel:aquaConfigurationStatus:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe AquaConfigurationStatus
$sel:allowVersionUpgrade:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:additionalInfo:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
additionalInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
allowVersionUpgrade
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AquaConfigurationStatus
aquaConfigurationStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
automatedSnapshotRetentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
availabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
availabilityZoneRelocation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterParameterGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
clusterSecurityGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterSubnetGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
defaultIamRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
elasticIp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
encrypted
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enhancedVpcRouting
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hsmClientCertificateIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hsmConfigurationIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
iamRoles
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
maintenanceTrackName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
manualSnapshotRetentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nodeType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
numberOfNodes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ownerAccount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
port
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredMaintenanceWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
publiclyAccessible
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
reservedNodeId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotClusterIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotScheduleIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
targetReservedNodeOfferingId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
vpcSecurityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterIdentifier

instance Prelude.NFData RestoreFromClusterSnapshot where
  rnf :: RestoreFromClusterSnapshot -> ()
rnf RestoreFromClusterSnapshot' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Maybe AquaConfigurationStatus
Text
clusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
targetReservedNodeOfferingId :: Maybe Text
snapshotScheduleIdentifier :: Maybe Text
snapshotIdentifier :: Maybe Text
snapshotClusterIdentifier :: Maybe Text
snapshotArn :: Maybe Text
reservedNodeId :: Maybe Text
publiclyAccessible :: Maybe Bool
preferredMaintenanceWindow :: Maybe Text
port :: Maybe Int
ownerAccount :: Maybe Text
numberOfNodes :: Maybe Int
nodeType :: Maybe Text
manualSnapshotRetentionPeriod :: Maybe Int
maintenanceTrackName :: Maybe Text
kmsKeyId :: Maybe Text
iamRoles :: Maybe [Text]
hsmConfigurationIdentifier :: Maybe Text
hsmClientCertificateIdentifier :: Maybe Text
enhancedVpcRouting :: Maybe Bool
encrypted :: Maybe Bool
elasticIp :: Maybe Text
defaultIamRoleArn :: Maybe Text
clusterSubnetGroupName :: Maybe Text
clusterSecurityGroups :: Maybe [Text]
clusterParameterGroupName :: Maybe Text
availabilityZoneRelocation :: Maybe Bool
availabilityZone :: Maybe Text
automatedSnapshotRetentionPeriod :: Maybe Int
aquaConfigurationStatus :: Maybe AquaConfigurationStatus
allowVersionUpgrade :: Maybe Bool
additionalInfo :: Maybe Text
$sel:clusterIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Text
$sel:vpcSecurityGroupIds:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe [Text]
$sel:targetReservedNodeOfferingId:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:snapshotScheduleIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:snapshotIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:snapshotClusterIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:snapshotArn:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:reservedNodeId:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:publiclyAccessible:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:preferredMaintenanceWindow:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:port:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
$sel:ownerAccount:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:numberOfNodes:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
$sel:nodeType:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:manualSnapshotRetentionPeriod:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
$sel:maintenanceTrackName:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:kmsKeyId:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:iamRoles:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe [Text]
$sel:hsmConfigurationIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:hsmClientCertificateIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:enhancedVpcRouting:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:encrypted:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:elasticIp:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:defaultIamRoleArn:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:clusterSubnetGroupName:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:clusterSecurityGroups:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe [Text]
$sel:clusterParameterGroupName:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:availabilityZoneRelocation:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:availabilityZone:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:automatedSnapshotRetentionPeriod:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
$sel:aquaConfigurationStatus:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe AquaConfigurationStatus
$sel:allowVersionUpgrade:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:additionalInfo:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
additionalInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
allowVersionUpgrade
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AquaConfigurationStatus
aquaConfigurationStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
automatedSnapshotRetentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
availabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
availabilityZoneRelocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterParameterGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
clusterSecurityGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterSubnetGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
defaultIamRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
elasticIp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
encrypted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enhancedVpcRouting
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hsmClientCertificateIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hsmConfigurationIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
iamRoles
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
maintenanceTrackName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Int
manualSnapshotRetentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nodeType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
numberOfNodes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ownerAccount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
port
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
preferredMaintenanceWindow
      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 Text
reservedNodeId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
snapshotArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
snapshotClusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
snapshotIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
snapshotScheduleIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
targetReservedNodeOfferingId
      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
clusterIdentifier

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

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

instance Data.ToQuery RestoreFromClusterSnapshot where
  toQuery :: RestoreFromClusterSnapshot -> QueryString
toQuery RestoreFromClusterSnapshot' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Maybe AquaConfigurationStatus
Text
clusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
targetReservedNodeOfferingId :: Maybe Text
snapshotScheduleIdentifier :: Maybe Text
snapshotIdentifier :: Maybe Text
snapshotClusterIdentifier :: Maybe Text
snapshotArn :: Maybe Text
reservedNodeId :: Maybe Text
publiclyAccessible :: Maybe Bool
preferredMaintenanceWindow :: Maybe Text
port :: Maybe Int
ownerAccount :: Maybe Text
numberOfNodes :: Maybe Int
nodeType :: Maybe Text
manualSnapshotRetentionPeriod :: Maybe Int
maintenanceTrackName :: Maybe Text
kmsKeyId :: Maybe Text
iamRoles :: Maybe [Text]
hsmConfigurationIdentifier :: Maybe Text
hsmClientCertificateIdentifier :: Maybe Text
enhancedVpcRouting :: Maybe Bool
encrypted :: Maybe Bool
elasticIp :: Maybe Text
defaultIamRoleArn :: Maybe Text
clusterSubnetGroupName :: Maybe Text
clusterSecurityGroups :: Maybe [Text]
clusterParameterGroupName :: Maybe Text
availabilityZoneRelocation :: Maybe Bool
availabilityZone :: Maybe Text
automatedSnapshotRetentionPeriod :: Maybe Int
aquaConfigurationStatus :: Maybe AquaConfigurationStatus
allowVersionUpgrade :: Maybe Bool
additionalInfo :: Maybe Text
$sel:clusterIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Text
$sel:vpcSecurityGroupIds:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe [Text]
$sel:targetReservedNodeOfferingId:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:snapshotScheduleIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:snapshotIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:snapshotClusterIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:snapshotArn:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:reservedNodeId:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:publiclyAccessible:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:preferredMaintenanceWindow:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:port:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
$sel:ownerAccount:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:numberOfNodes:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
$sel:nodeType:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:manualSnapshotRetentionPeriod:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
$sel:maintenanceTrackName:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:kmsKeyId:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:iamRoles:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe [Text]
$sel:hsmConfigurationIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:hsmClientCertificateIdentifier:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:enhancedVpcRouting:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:encrypted:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:elasticIp:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:defaultIamRoleArn:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:clusterSubnetGroupName:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:clusterSecurityGroups:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe [Text]
$sel:clusterParameterGroupName:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:availabilityZoneRelocation:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:availabilityZone:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
$sel:automatedSnapshotRetentionPeriod:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Int
$sel:aquaConfigurationStatus:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe AquaConfigurationStatus
$sel:allowVersionUpgrade:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Bool
$sel:additionalInfo:RestoreFromClusterSnapshot' :: RestoreFromClusterSnapshot -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RestoreFromClusterSnapshot" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"AdditionalInfo" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
additionalInfo,
        ByteString
"AllowVersionUpgrade" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
allowVersionUpgrade,
        ByteString
"AquaConfigurationStatus"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe AquaConfigurationStatus
aquaConfigurationStatus,
        ByteString
"AutomatedSnapshotRetentionPeriod"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
automatedSnapshotRetentionPeriod,
        ByteString
"AvailabilityZone" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
availabilityZone,
        ByteString
"AvailabilityZoneRelocation"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
availabilityZoneRelocation,
        ByteString
"ClusterParameterGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clusterParameterGroupName,
        ByteString
"ClusterSecurityGroups"
          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
"ClusterSecurityGroupName"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
clusterSecurityGroups
            ),
        ByteString
"ClusterSubnetGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clusterSubnetGroupName,
        ByteString
"DefaultIamRoleArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
defaultIamRoleArn,
        ByteString
"ElasticIp" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
elasticIp,
        ByteString
"Encrypted" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
encrypted,
        ByteString
"EnhancedVpcRouting" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
enhancedVpcRouting,
        ByteString
"HsmClientCertificateIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
hsmClientCertificateIdentifier,
        ByteString
"HsmConfigurationIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
hsmConfigurationIdentifier,
        ByteString
"IamRoles"
          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
"IamRoleArn" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
iamRoles),
        ByteString
"KmsKeyId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
kmsKeyId,
        ByteString
"MaintenanceTrackName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
maintenanceTrackName,
        ByteString
"ManualSnapshotRetentionPeriod"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
manualSnapshotRetentionPeriod,
        ByteString
"NodeType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nodeType,
        ByteString
"NumberOfNodes" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
numberOfNodes,
        ByteString
"OwnerAccount" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
ownerAccount,
        ByteString
"Port" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
port,
        ByteString
"PreferredMaintenanceWindow"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
preferredMaintenanceWindow,
        ByteString
"PubliclyAccessible" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
publiclyAccessible,
        ByteString
"ReservedNodeId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
reservedNodeId,
        ByteString
"SnapshotArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
snapshotArn,
        ByteString
"SnapshotClusterIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
snapshotClusterIdentifier,
        ByteString
"SnapshotIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
snapshotIdentifier,
        ByteString
"SnapshotScheduleIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
snapshotScheduleIdentifier,
        ByteString
"TargetReservedNodeOfferingId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
targetReservedNodeOfferingId,
        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
"ClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clusterIdentifier
      ]

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

-- |
-- Create a value of 'RestoreFromClusterSnapshotResponse' 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:
--
-- 'cluster', 'restoreFromClusterSnapshotResponse_cluster' - Undocumented member.
--
-- 'httpStatus', 'restoreFromClusterSnapshotResponse_httpStatus' - The response's http status code.
newRestoreFromClusterSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RestoreFromClusterSnapshotResponse
newRestoreFromClusterSnapshotResponse :: Int -> RestoreFromClusterSnapshotResponse
newRestoreFromClusterSnapshotResponse Int
pHttpStatus_ =
  RestoreFromClusterSnapshotResponse'
    { $sel:cluster:RestoreFromClusterSnapshotResponse' :: Maybe Cluster
cluster =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RestoreFromClusterSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
restoreFromClusterSnapshotResponse_cluster :: Lens.Lens' RestoreFromClusterSnapshotResponse (Prelude.Maybe Cluster)
restoreFromClusterSnapshotResponse_cluster :: Lens' RestoreFromClusterSnapshotResponse (Maybe Cluster)
restoreFromClusterSnapshotResponse_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreFromClusterSnapshotResponse' {Maybe Cluster
cluster :: Maybe Cluster
$sel:cluster:RestoreFromClusterSnapshotResponse' :: RestoreFromClusterSnapshotResponse -> Maybe Cluster
cluster} -> Maybe Cluster
cluster) (\s :: RestoreFromClusterSnapshotResponse
s@RestoreFromClusterSnapshotResponse' {} Maybe Cluster
a -> RestoreFromClusterSnapshotResponse
s {$sel:cluster:RestoreFromClusterSnapshotResponse' :: Maybe Cluster
cluster = Maybe Cluster
a} :: RestoreFromClusterSnapshotResponse)

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

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