{-# 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.ModifyCluster
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the settings for a cluster.
--
-- You can also change node type and the number of nodes to scale up or
-- down the cluster. When resizing a cluster, you must specify both the
-- number of nodes and the node type even if one of the parameters does not
-- change.
--
-- You can add another security or parameter group, or change the admin
-- user password. Resetting a cluster password or modifying the security
-- groups associated with a cluster do not need a reboot. However,
-- modifying a parameter group requires a reboot for parameters to take
-- effect. For more information about managing clusters, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-clusters.html Amazon Redshift Clusters>
-- in the /Amazon Redshift Cluster Management Guide/.
module Amazonka.Redshift.ModifyCluster
  ( -- * Creating a Request
    ModifyCluster (..),
    newModifyCluster,

    -- * Request Lenses
    modifyCluster_allowVersionUpgrade,
    modifyCluster_automatedSnapshotRetentionPeriod,
    modifyCluster_availabilityZone,
    modifyCluster_availabilityZoneRelocation,
    modifyCluster_clusterParameterGroupName,
    modifyCluster_clusterSecurityGroups,
    modifyCluster_clusterType,
    modifyCluster_clusterVersion,
    modifyCluster_elasticIp,
    modifyCluster_encrypted,
    modifyCluster_enhancedVpcRouting,
    modifyCluster_hsmClientCertificateIdentifier,
    modifyCluster_hsmConfigurationIdentifier,
    modifyCluster_kmsKeyId,
    modifyCluster_maintenanceTrackName,
    modifyCluster_manualSnapshotRetentionPeriod,
    modifyCluster_masterUserPassword,
    modifyCluster_newClusterIdentifier,
    modifyCluster_nodeType,
    modifyCluster_numberOfNodes,
    modifyCluster_port,
    modifyCluster_preferredMaintenanceWindow,
    modifyCluster_publiclyAccessible,
    modifyCluster_vpcSecurityGroupIds,
    modifyCluster_clusterIdentifier,

    -- * Destructuring the Response
    ModifyClusterResponse (..),
    newModifyClusterResponse,

    -- * Response Lenses
    modifyClusterResponse_cluster,
    modifyClusterResponse_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:/ 'newModifyCluster' smart constructor.
data ModifyCluster = ModifyCluster'
  { -- | If @true@, major version upgrades will be applied automatically to the
    -- cluster during the maintenance window.
    --
    -- Default: @false@
    ModifyCluster -> Maybe Bool
allowVersionUpgrade :: Prelude.Maybe Prelude.Bool,
    -- | 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.
    --
    -- If you decrease the automated snapshot retention period from its current
    -- value, existing automated snapshots that fall outside of the new
    -- retention period will be immediately deleted.
    --
    -- You can\'t disable automated snapshots for RA3 node types. Set the
    -- automated retention period from 1-35 days.
    --
    -- Default: Uses existing setting.
    --
    -- Constraints: Must be a value from 0 to 35.
    ModifyCluster -> Maybe Int
automatedSnapshotRetentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | The option to initiate relocation for an Amazon Redshift cluster to the
    -- target Availability Zone.
    ModifyCluster -> Maybe Text
availabilityZone :: Prelude.Maybe Prelude.Text,
    -- | The option to enable relocation for an Amazon Redshift cluster between
    -- Availability Zones after the cluster modification is complete.
    ModifyCluster -> Maybe Bool
availabilityZoneRelocation :: Prelude.Maybe Prelude.Bool,
    -- | The name of the cluster parameter group to apply to this cluster. This
    -- change is applied only after the cluster is rebooted. To reboot a
    -- cluster use RebootCluster.
    --
    -- Default: Uses existing setting.
    --
    -- Constraints: The cluster parameter group must be in the same parameter
    -- group family that matches the cluster version.
    ModifyCluster -> Maybe Text
clusterParameterGroupName :: Prelude.Maybe Prelude.Text,
    -- | A list of cluster security groups to be authorized on this cluster. This
    -- change is asynchronously applied as soon as possible.
    --
    -- Security groups currently associated with the cluster, and not in the
    -- list of groups to apply, will be revoked from the cluster.
    --
    -- 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
    ModifyCluster -> Maybe [Text]
clusterSecurityGroups :: Prelude.Maybe [Prelude.Text],
    -- | The new cluster type.
    --
    -- When you submit your cluster resize request, your existing cluster goes
    -- into a read-only mode. After Amazon Redshift provisions a new cluster
    -- based on your resize requirements, there will be outage for a period
    -- while the old cluster is deleted and your connection is switched to the
    -- new cluster. You can use DescribeResize to track the progress of the
    -- resize request.
    --
    -- Valid Values: @ multi-node | single-node @
    ModifyCluster -> Maybe Text
clusterType :: Prelude.Maybe Prelude.Text,
    -- | The new version number of the Amazon Redshift engine to upgrade to.
    --
    -- For major version upgrades, if a non-default cluster parameter group is
    -- currently in use, a new cluster parameter group in the cluster parameter
    -- group family for the new version must be specified. The new cluster
    -- parameter group can be the default for that cluster parameter group
    -- family. For more information about parameters and parameter groups, go
    -- to
    -- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-parameter-groups.html Amazon Redshift Parameter Groups>
    -- in the /Amazon Redshift Cluster Management Guide/.
    --
    -- Example: @1.0@
    ModifyCluster -> Maybe Text
clusterVersion :: Prelude.Maybe Prelude.Text,
    -- | The Elastic IP (EIP) address for the cluster.
    --
    -- Constraints: The cluster must be provisioned in EC2-VPC and
    -- publicly-accessible through an Internet gateway. For more information
    -- about provisioning clusters in EC2-VPC, go to
    -- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-clusters.html#cluster-platforms Supported Platforms to Launch Your Cluster>
    -- in the Amazon Redshift Cluster Management Guide.
    ModifyCluster -> Maybe Text
elasticIp :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether the cluster is encrypted. If the value is encrypted
    -- (true) and you provide a value for the @KmsKeyId@ parameter, we encrypt
    -- the cluster with the provided @KmsKeyId@. If you don\'t provide a
    -- @KmsKeyId@, we encrypt with the default key.
    --
    -- If the value is not encrypted (false), then the cluster is decrypted.
    ModifyCluster -> 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
    ModifyCluster -> 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.
    ModifyCluster -> 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.
    ModifyCluster -> Maybe Text
hsmConfigurationIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The Key Management Service (KMS) key ID of the encryption key that you
    -- want to use to encrypt data in the cluster.
    ModifyCluster -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The name for the maintenance track that you want to assign for the
    -- cluster. This name change is asynchronous. The new track name stays in
    -- the @PendingModifiedValues@ for the cluster until the next maintenance
    -- window. When the maintenance track changes, the cluster is switched to
    -- the latest cluster release available for the maintenance track. At this
    -- point, the maintenance track name is applied.
    ModifyCluster -> Maybe Text
maintenanceTrackName :: Prelude.Maybe Prelude.Text,
    -- | The default for number of days that a newly created manual snapshot is
    -- retained. If the value is -1, the manual snapshot is retained
    -- indefinitely. This value doesn\'t retroactively change the retention
    -- periods of existing manual snapshots.
    --
    -- The value must be either -1 or an integer between 1 and 3,653.
    --
    -- The default value is -1.
    ModifyCluster -> Maybe Int
manualSnapshotRetentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | The new password for the cluster admin user. This change is
    -- asynchronously applied as soon as possible. Between the time of the
    -- request and the completion of the request, the @MasterUserPassword@
    -- element exists in the @PendingModifiedValues@ element of the operation
    -- response.
    --
    -- Operations never return the password, so this operation provides a way
    -- to regain access to the admin user account for a cluster if the password
    -- is lost.
    --
    -- Default: Uses existing setting.
    --
    -- Constraints:
    --
    -- -   Must be between 8 and 64 characters in length.
    --
    -- -   Must contain at least one uppercase letter.
    --
    -- -   Must contain at least one lowercase letter.
    --
    -- -   Must contain one number.
    --
    -- -   Can be any printable ASCII character (ASCII code 33-126) except @\'@
    --     (single quote), @\"@ (double quote), @\\@, @\/@, or @\@@.
    ModifyCluster -> Maybe Text
masterUserPassword :: Prelude.Maybe Prelude.Text,
    -- | The new identifier for the cluster.
    --
    -- 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.
    --
    -- Example: @examplecluster@
    ModifyCluster -> Maybe Text
newClusterIdentifier' :: Prelude.Maybe Prelude.Text,
    -- | The new node type of the cluster. If you specify a new node type, you
    -- must also specify the number of nodes parameter.
    --
    -- For more information about resizing clusters, go to
    -- <https://docs.aws.amazon.com/redshift/latest/mgmt/rs-resize-tutorial.html Resizing Clusters in Amazon Redshift>
    -- in the /Amazon Redshift Cluster Management Guide/.
    --
    -- Valid Values: @ds2.xlarge@ | @ds2.8xlarge@ | @dc1.large@ | @dc1.8xlarge@
    -- | @dc2.large@ | @dc2.8xlarge@ | @ra3.xlplus@ | @ra3.4xlarge@ |
    -- @ra3.16xlarge@
    ModifyCluster -> Maybe Text
nodeType :: Prelude.Maybe Prelude.Text,
    -- | The new number of nodes of the cluster. If you specify a new number of
    -- nodes, you must also specify the node type parameter.
    --
    -- For more information about resizing clusters, go to
    -- <https://docs.aws.amazon.com/redshift/latest/mgmt/rs-resize-tutorial.html Resizing Clusters in Amazon Redshift>
    -- in the /Amazon Redshift Cluster Management Guide/.
    --
    -- Valid Values: Integer greater than @0@.
    ModifyCluster -> Maybe Int
numberOfNodes :: Prelude.Maybe Prelude.Int,
    -- | The option to change the port of an Amazon Redshift cluster.
    ModifyCluster -> Maybe Int
port :: Prelude.Maybe Prelude.Int,
    -- | The weekly time range (in UTC) during which system maintenance can
    -- occur, if necessary. If system maintenance is necessary during the
    -- window, it may result in an outage.
    --
    -- This maintenance window change is made immediately. If the new
    -- maintenance window indicates the current time, there must be at least
    -- 120 minutes between the current time and end of the window in order to
    -- ensure that pending changes are applied.
    --
    -- Default: Uses existing setting.
    --
    -- Format: ddd:hh24:mi-ddd:hh24:mi, for example @wed:07:30-wed:08:00@.
    --
    -- Valid Days: Mon | Tue | Wed | Thu | Fri | Sat | Sun
    --
    -- Constraints: Must be at least 30 minutes.
    ModifyCluster -> Maybe Text
preferredMaintenanceWindow :: Prelude.Maybe Prelude.Text,
    -- | If @true@, the cluster can be accessed from a public network. Only
    -- clusters in VPCs can be set to be publicly available.
    ModifyCluster -> Maybe Bool
publiclyAccessible :: Prelude.Maybe Prelude.Bool,
    -- | A list of virtual private cloud (VPC) security groups to be associated
    -- with the cluster. This change is asynchronously applied as soon as
    -- possible.
    ModifyCluster -> Maybe [Text]
vpcSecurityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The unique identifier of the cluster to be modified.
    --
    -- Example: @examplecluster@
    ModifyCluster -> Text
clusterIdentifier :: Prelude.Text
  }
  deriving (ModifyCluster -> ModifyCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyCluster -> ModifyCluster -> Bool
$c/= :: ModifyCluster -> ModifyCluster -> Bool
== :: ModifyCluster -> ModifyCluster -> Bool
$c== :: ModifyCluster -> ModifyCluster -> Bool
Prelude.Eq, ReadPrec [ModifyCluster]
ReadPrec ModifyCluster
Int -> ReadS ModifyCluster
ReadS [ModifyCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyCluster]
$creadListPrec :: ReadPrec [ModifyCluster]
readPrec :: ReadPrec ModifyCluster
$creadPrec :: ReadPrec ModifyCluster
readList :: ReadS [ModifyCluster]
$creadList :: ReadS [ModifyCluster]
readsPrec :: Int -> ReadS ModifyCluster
$creadsPrec :: Int -> ReadS ModifyCluster
Prelude.Read, Int -> ModifyCluster -> ShowS
[ModifyCluster] -> ShowS
ModifyCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyCluster] -> ShowS
$cshowList :: [ModifyCluster] -> ShowS
show :: ModifyCluster -> String
$cshow :: ModifyCluster -> String
showsPrec :: Int -> ModifyCluster -> ShowS
$cshowsPrec :: Int -> ModifyCluster -> ShowS
Prelude.Show, forall x. Rep ModifyCluster x -> ModifyCluster
forall x. ModifyCluster -> Rep ModifyCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyCluster x -> ModifyCluster
$cfrom :: forall x. ModifyCluster -> Rep ModifyCluster x
Prelude.Generic)

-- |
-- Create a value of 'ModifyCluster' 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:
--
-- 'allowVersionUpgrade', 'modifyCluster_allowVersionUpgrade' - If @true@, major version upgrades will be applied automatically to the
-- cluster during the maintenance window.
--
-- Default: @false@
--
-- 'automatedSnapshotRetentionPeriod', 'modifyCluster_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.
--
-- If you decrease the automated snapshot retention period from its current
-- value, existing automated snapshots that fall outside of the new
-- retention period will be immediately deleted.
--
-- You can\'t disable automated snapshots for RA3 node types. Set the
-- automated retention period from 1-35 days.
--
-- Default: Uses existing setting.
--
-- Constraints: Must be a value from 0 to 35.
--
-- 'availabilityZone', 'modifyCluster_availabilityZone' - The option to initiate relocation for an Amazon Redshift cluster to the
-- target Availability Zone.
--
-- 'availabilityZoneRelocation', 'modifyCluster_availabilityZoneRelocation' - The option to enable relocation for an Amazon Redshift cluster between
-- Availability Zones after the cluster modification is complete.
--
-- 'clusterParameterGroupName', 'modifyCluster_clusterParameterGroupName' - The name of the cluster parameter group to apply to this cluster. This
-- change is applied only after the cluster is rebooted. To reboot a
-- cluster use RebootCluster.
--
-- Default: Uses existing setting.
--
-- Constraints: The cluster parameter group must be in the same parameter
-- group family that matches the cluster version.
--
-- 'clusterSecurityGroups', 'modifyCluster_clusterSecurityGroups' - A list of cluster security groups to be authorized on this cluster. This
-- change is asynchronously applied as soon as possible.
--
-- Security groups currently associated with the cluster, and not in the
-- list of groups to apply, will be revoked from the cluster.
--
-- 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
--
-- 'clusterType', 'modifyCluster_clusterType' - The new cluster type.
--
-- When you submit your cluster resize request, your existing cluster goes
-- into a read-only mode. After Amazon Redshift provisions a new cluster
-- based on your resize requirements, there will be outage for a period
-- while the old cluster is deleted and your connection is switched to the
-- new cluster. You can use DescribeResize to track the progress of the
-- resize request.
--
-- Valid Values: @ multi-node | single-node @
--
-- 'clusterVersion', 'modifyCluster_clusterVersion' - The new version number of the Amazon Redshift engine to upgrade to.
--
-- For major version upgrades, if a non-default cluster parameter group is
-- currently in use, a new cluster parameter group in the cluster parameter
-- group family for the new version must be specified. The new cluster
-- parameter group can be the default for that cluster parameter group
-- family. For more information about parameters and parameter groups, go
-- to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-parameter-groups.html Amazon Redshift Parameter Groups>
-- in the /Amazon Redshift Cluster Management Guide/.
--
-- Example: @1.0@
--
-- 'elasticIp', 'modifyCluster_elasticIp' - The Elastic IP (EIP) address for the cluster.
--
-- Constraints: The cluster must be provisioned in EC2-VPC and
-- publicly-accessible through an Internet gateway. For more information
-- about provisioning clusters in EC2-VPC, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-clusters.html#cluster-platforms Supported Platforms to Launch Your Cluster>
-- in the Amazon Redshift Cluster Management Guide.
--
-- 'encrypted', 'modifyCluster_encrypted' - Indicates whether the cluster is encrypted. If the value is encrypted
-- (true) and you provide a value for the @KmsKeyId@ parameter, we encrypt
-- the cluster with the provided @KmsKeyId@. If you don\'t provide a
-- @KmsKeyId@, we encrypt with the default key.
--
-- If the value is not encrypted (false), then the cluster is decrypted.
--
-- 'enhancedVpcRouting', 'modifyCluster_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', 'modifyCluster_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', 'modifyCluster_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.
--
-- 'kmsKeyId', 'modifyCluster_kmsKeyId' - The Key Management Service (KMS) key ID of the encryption key that you
-- want to use to encrypt data in the cluster.
--
-- 'maintenanceTrackName', 'modifyCluster_maintenanceTrackName' - The name for the maintenance track that you want to assign for the
-- cluster. This name change is asynchronous. The new track name stays in
-- the @PendingModifiedValues@ for the cluster until the next maintenance
-- window. When the maintenance track changes, the cluster is switched to
-- the latest cluster release available for the maintenance track. At this
-- point, the maintenance track name is applied.
--
-- 'manualSnapshotRetentionPeriod', 'modifyCluster_manualSnapshotRetentionPeriod' - The default for number of days that a newly created manual snapshot is
-- retained. If the value is -1, the manual snapshot is retained
-- indefinitely. This value doesn\'t retroactively change the retention
-- periods of existing manual snapshots.
--
-- The value must be either -1 or an integer between 1 and 3,653.
--
-- The default value is -1.
--
-- 'masterUserPassword', 'modifyCluster_masterUserPassword' - The new password for the cluster admin user. This change is
-- asynchronously applied as soon as possible. Between the time of the
-- request and the completion of the request, the @MasterUserPassword@
-- element exists in the @PendingModifiedValues@ element of the operation
-- response.
--
-- Operations never return the password, so this operation provides a way
-- to regain access to the admin user account for a cluster if the password
-- is lost.
--
-- Default: Uses existing setting.
--
-- Constraints:
--
-- -   Must be between 8 and 64 characters in length.
--
-- -   Must contain at least one uppercase letter.
--
-- -   Must contain at least one lowercase letter.
--
-- -   Must contain one number.
--
-- -   Can be any printable ASCII character (ASCII code 33-126) except @\'@
--     (single quote), @\"@ (double quote), @\\@, @\/@, or @\@@.
--
-- 'newClusterIdentifier'', 'modifyCluster_newClusterIdentifier' - The new identifier for the cluster.
--
-- 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.
--
-- Example: @examplecluster@
--
-- 'nodeType', 'modifyCluster_nodeType' - The new node type of the cluster. If you specify a new node type, you
-- must also specify the number of nodes parameter.
--
-- For more information about resizing clusters, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/rs-resize-tutorial.html Resizing Clusters in Amazon Redshift>
-- in the /Amazon Redshift Cluster Management Guide/.
--
-- Valid Values: @ds2.xlarge@ | @ds2.8xlarge@ | @dc1.large@ | @dc1.8xlarge@
-- | @dc2.large@ | @dc2.8xlarge@ | @ra3.xlplus@ | @ra3.4xlarge@ |
-- @ra3.16xlarge@
--
-- 'numberOfNodes', 'modifyCluster_numberOfNodes' - The new number of nodes of the cluster. If you specify a new number of
-- nodes, you must also specify the node type parameter.
--
-- For more information about resizing clusters, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/rs-resize-tutorial.html Resizing Clusters in Amazon Redshift>
-- in the /Amazon Redshift Cluster Management Guide/.
--
-- Valid Values: Integer greater than @0@.
--
-- 'port', 'modifyCluster_port' - The option to change the port of an Amazon Redshift cluster.
--
-- 'preferredMaintenanceWindow', 'modifyCluster_preferredMaintenanceWindow' - The weekly time range (in UTC) during which system maintenance can
-- occur, if necessary. If system maintenance is necessary during the
-- window, it may result in an outage.
--
-- This maintenance window change is made immediately. If the new
-- maintenance window indicates the current time, there must be at least
-- 120 minutes between the current time and end of the window in order to
-- ensure that pending changes are applied.
--
-- Default: Uses existing setting.
--
-- Format: ddd:hh24:mi-ddd:hh24:mi, for example @wed:07:30-wed:08:00@.
--
-- Valid Days: Mon | Tue | Wed | Thu | Fri | Sat | Sun
--
-- Constraints: Must be at least 30 minutes.
--
-- 'publiclyAccessible', 'modifyCluster_publiclyAccessible' - If @true@, the cluster can be accessed from a public network. Only
-- clusters in VPCs can be set to be publicly available.
--
-- 'vpcSecurityGroupIds', 'modifyCluster_vpcSecurityGroupIds' - A list of virtual private cloud (VPC) security groups to be associated
-- with the cluster. This change is asynchronously applied as soon as
-- possible.
--
-- 'clusterIdentifier', 'modifyCluster_clusterIdentifier' - The unique identifier of the cluster to be modified.
--
-- Example: @examplecluster@
newModifyCluster ::
  -- | 'clusterIdentifier'
  Prelude.Text ->
  ModifyCluster
newModifyCluster :: Text -> ModifyCluster
newModifyCluster Text
pClusterIdentifier_ =
  ModifyCluster'
    { $sel:allowVersionUpgrade:ModifyCluster' :: Maybe Bool
allowVersionUpgrade =
        forall a. Maybe a
Prelude.Nothing,
      $sel:automatedSnapshotRetentionPeriod:ModifyCluster' :: Maybe Int
automatedSnapshotRetentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZone:ModifyCluster' :: Maybe Text
availabilityZone = forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZoneRelocation:ModifyCluster' :: Maybe Bool
availabilityZoneRelocation = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterParameterGroupName:ModifyCluster' :: Maybe Text
clusterParameterGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterSecurityGroups:ModifyCluster' :: Maybe [Text]
clusterSecurityGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterType:ModifyCluster' :: Maybe Text
clusterType = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterVersion:ModifyCluster' :: Maybe Text
clusterVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:elasticIp:ModifyCluster' :: Maybe Text
elasticIp = forall a. Maybe a
Prelude.Nothing,
      $sel:encrypted:ModifyCluster' :: Maybe Bool
encrypted = forall a. Maybe a
Prelude.Nothing,
      $sel:enhancedVpcRouting:ModifyCluster' :: Maybe Bool
enhancedVpcRouting = forall a. Maybe a
Prelude.Nothing,
      $sel:hsmClientCertificateIdentifier:ModifyCluster' :: Maybe Text
hsmClientCertificateIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:hsmConfigurationIdentifier:ModifyCluster' :: Maybe Text
hsmConfigurationIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:ModifyCluster' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:maintenanceTrackName:ModifyCluster' :: Maybe Text
maintenanceTrackName = forall a. Maybe a
Prelude.Nothing,
      $sel:manualSnapshotRetentionPeriod:ModifyCluster' :: Maybe Int
manualSnapshotRetentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:masterUserPassword:ModifyCluster' :: Maybe Text
masterUserPassword = forall a. Maybe a
Prelude.Nothing,
      $sel:newClusterIdentifier':ModifyCluster' :: Maybe Text
newClusterIdentifier' = forall a. Maybe a
Prelude.Nothing,
      $sel:nodeType:ModifyCluster' :: Maybe Text
nodeType = forall a. Maybe a
Prelude.Nothing,
      $sel:numberOfNodes:ModifyCluster' :: Maybe Int
numberOfNodes = forall a. Maybe a
Prelude.Nothing,
      $sel:port:ModifyCluster' :: Maybe Int
port = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredMaintenanceWindow:ModifyCluster' :: Maybe Text
preferredMaintenanceWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:publiclyAccessible:ModifyCluster' :: Maybe Bool
publiclyAccessible = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcSecurityGroupIds:ModifyCluster' :: Maybe [Text]
vpcSecurityGroupIds = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterIdentifier:ModifyCluster' :: Text
clusterIdentifier = Text
pClusterIdentifier_
    }

-- | If @true@, major version upgrades will be applied automatically to the
-- cluster during the maintenance window.
--
-- Default: @false@
modifyCluster_allowVersionUpgrade :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Bool)
modifyCluster_allowVersionUpgrade :: Lens' ModifyCluster (Maybe Bool)
modifyCluster_allowVersionUpgrade = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Bool
allowVersionUpgrade :: Maybe Bool
$sel:allowVersionUpgrade:ModifyCluster' :: ModifyCluster -> Maybe Bool
allowVersionUpgrade} -> Maybe Bool
allowVersionUpgrade) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Bool
a -> ModifyCluster
s {$sel:allowVersionUpgrade:ModifyCluster' :: Maybe Bool
allowVersionUpgrade = Maybe Bool
a} :: ModifyCluster)

-- | 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.
--
-- If you decrease the automated snapshot retention period from its current
-- value, existing automated snapshots that fall outside of the new
-- retention period will be immediately deleted.
--
-- You can\'t disable automated snapshots for RA3 node types. Set the
-- automated retention period from 1-35 days.
--
-- Default: Uses existing setting.
--
-- Constraints: Must be a value from 0 to 35.
modifyCluster_automatedSnapshotRetentionPeriod :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Int)
modifyCluster_automatedSnapshotRetentionPeriod :: Lens' ModifyCluster (Maybe Int)
modifyCluster_automatedSnapshotRetentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Int
automatedSnapshotRetentionPeriod :: Maybe Int
$sel:automatedSnapshotRetentionPeriod:ModifyCluster' :: ModifyCluster -> Maybe Int
automatedSnapshotRetentionPeriod} -> Maybe Int
automatedSnapshotRetentionPeriod) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Int
a -> ModifyCluster
s {$sel:automatedSnapshotRetentionPeriod:ModifyCluster' :: Maybe Int
automatedSnapshotRetentionPeriod = Maybe Int
a} :: ModifyCluster)

-- | The option to initiate relocation for an Amazon Redshift cluster to the
-- target Availability Zone.
modifyCluster_availabilityZone :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Text)
modifyCluster_availabilityZone :: Lens' ModifyCluster (Maybe Text)
modifyCluster_availabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Text
availabilityZone :: Maybe Text
$sel:availabilityZone:ModifyCluster' :: ModifyCluster -> Maybe Text
availabilityZone} -> Maybe Text
availabilityZone) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Text
a -> ModifyCluster
s {$sel:availabilityZone:ModifyCluster' :: Maybe Text
availabilityZone = Maybe Text
a} :: ModifyCluster)

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

-- | The name of the cluster parameter group to apply to this cluster. This
-- change is applied only after the cluster is rebooted. To reboot a
-- cluster use RebootCluster.
--
-- Default: Uses existing setting.
--
-- Constraints: The cluster parameter group must be in the same parameter
-- group family that matches the cluster version.
modifyCluster_clusterParameterGroupName :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Text)
modifyCluster_clusterParameterGroupName :: Lens' ModifyCluster (Maybe Text)
modifyCluster_clusterParameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Text
clusterParameterGroupName :: Maybe Text
$sel:clusterParameterGroupName:ModifyCluster' :: ModifyCluster -> Maybe Text
clusterParameterGroupName} -> Maybe Text
clusterParameterGroupName) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Text
a -> ModifyCluster
s {$sel:clusterParameterGroupName:ModifyCluster' :: Maybe Text
clusterParameterGroupName = Maybe Text
a} :: ModifyCluster)

-- | A list of cluster security groups to be authorized on this cluster. This
-- change is asynchronously applied as soon as possible.
--
-- Security groups currently associated with the cluster, and not in the
-- list of groups to apply, will be revoked from the cluster.
--
-- 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
modifyCluster_clusterSecurityGroups :: Lens.Lens' ModifyCluster (Prelude.Maybe [Prelude.Text])
modifyCluster_clusterSecurityGroups :: Lens' ModifyCluster (Maybe [Text])
modifyCluster_clusterSecurityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe [Text]
clusterSecurityGroups :: Maybe [Text]
$sel:clusterSecurityGroups:ModifyCluster' :: ModifyCluster -> Maybe [Text]
clusterSecurityGroups} -> Maybe [Text]
clusterSecurityGroups) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe [Text]
a -> ModifyCluster
s {$sel:clusterSecurityGroups:ModifyCluster' :: Maybe [Text]
clusterSecurityGroups = Maybe [Text]
a} :: ModifyCluster) 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 new cluster type.
--
-- When you submit your cluster resize request, your existing cluster goes
-- into a read-only mode. After Amazon Redshift provisions a new cluster
-- based on your resize requirements, there will be outage for a period
-- while the old cluster is deleted and your connection is switched to the
-- new cluster. You can use DescribeResize to track the progress of the
-- resize request.
--
-- Valid Values: @ multi-node | single-node @
modifyCluster_clusterType :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Text)
modifyCluster_clusterType :: Lens' ModifyCluster (Maybe Text)
modifyCluster_clusterType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Text
clusterType :: Maybe Text
$sel:clusterType:ModifyCluster' :: ModifyCluster -> Maybe Text
clusterType} -> Maybe Text
clusterType) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Text
a -> ModifyCluster
s {$sel:clusterType:ModifyCluster' :: Maybe Text
clusterType = Maybe Text
a} :: ModifyCluster)

-- | The new version number of the Amazon Redshift engine to upgrade to.
--
-- For major version upgrades, if a non-default cluster parameter group is
-- currently in use, a new cluster parameter group in the cluster parameter
-- group family for the new version must be specified. The new cluster
-- parameter group can be the default for that cluster parameter group
-- family. For more information about parameters and parameter groups, go
-- to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-parameter-groups.html Amazon Redshift Parameter Groups>
-- in the /Amazon Redshift Cluster Management Guide/.
--
-- Example: @1.0@
modifyCluster_clusterVersion :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Text)
modifyCluster_clusterVersion :: Lens' ModifyCluster (Maybe Text)
modifyCluster_clusterVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Text
clusterVersion :: Maybe Text
$sel:clusterVersion:ModifyCluster' :: ModifyCluster -> Maybe Text
clusterVersion} -> Maybe Text
clusterVersion) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Text
a -> ModifyCluster
s {$sel:clusterVersion:ModifyCluster' :: Maybe Text
clusterVersion = Maybe Text
a} :: ModifyCluster)

-- | The Elastic IP (EIP) address for the cluster.
--
-- Constraints: The cluster must be provisioned in EC2-VPC and
-- publicly-accessible through an Internet gateway. For more information
-- about provisioning clusters in EC2-VPC, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-clusters.html#cluster-platforms Supported Platforms to Launch Your Cluster>
-- in the Amazon Redshift Cluster Management Guide.
modifyCluster_elasticIp :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Text)
modifyCluster_elasticIp :: Lens' ModifyCluster (Maybe Text)
modifyCluster_elasticIp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Text
elasticIp :: Maybe Text
$sel:elasticIp:ModifyCluster' :: ModifyCluster -> Maybe Text
elasticIp} -> Maybe Text
elasticIp) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Text
a -> ModifyCluster
s {$sel:elasticIp:ModifyCluster' :: Maybe Text
elasticIp = Maybe Text
a} :: ModifyCluster)

-- | Indicates whether the cluster is encrypted. If the value is encrypted
-- (true) and you provide a value for the @KmsKeyId@ parameter, we encrypt
-- the cluster with the provided @KmsKeyId@. If you don\'t provide a
-- @KmsKeyId@, we encrypt with the default key.
--
-- If the value is not encrypted (false), then the cluster is decrypted.
modifyCluster_encrypted :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Bool)
modifyCluster_encrypted :: Lens' ModifyCluster (Maybe Bool)
modifyCluster_encrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Bool
encrypted :: Maybe Bool
$sel:encrypted:ModifyCluster' :: ModifyCluster -> Maybe Bool
encrypted} -> Maybe Bool
encrypted) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Bool
a -> ModifyCluster
s {$sel:encrypted:ModifyCluster' :: Maybe Bool
encrypted = Maybe Bool
a} :: ModifyCluster)

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

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

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

-- | The Key Management Service (KMS) key ID of the encryption key that you
-- want to use to encrypt data in the cluster.
modifyCluster_kmsKeyId :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Text)
modifyCluster_kmsKeyId :: Lens' ModifyCluster (Maybe Text)
modifyCluster_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:ModifyCluster' :: ModifyCluster -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Text
a -> ModifyCluster
s {$sel:kmsKeyId:ModifyCluster' :: Maybe Text
kmsKeyId = Maybe Text
a} :: ModifyCluster)

-- | The name for the maintenance track that you want to assign for the
-- cluster. This name change is asynchronous. The new track name stays in
-- the @PendingModifiedValues@ for the cluster until the next maintenance
-- window. When the maintenance track changes, the cluster is switched to
-- the latest cluster release available for the maintenance track. At this
-- point, the maintenance track name is applied.
modifyCluster_maintenanceTrackName :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Text)
modifyCluster_maintenanceTrackName :: Lens' ModifyCluster (Maybe Text)
modifyCluster_maintenanceTrackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Text
maintenanceTrackName :: Maybe Text
$sel:maintenanceTrackName:ModifyCluster' :: ModifyCluster -> Maybe Text
maintenanceTrackName} -> Maybe Text
maintenanceTrackName) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Text
a -> ModifyCluster
s {$sel:maintenanceTrackName:ModifyCluster' :: Maybe Text
maintenanceTrackName = Maybe Text
a} :: ModifyCluster)

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

-- | The new password for the cluster admin user. This change is
-- asynchronously applied as soon as possible. Between the time of the
-- request and the completion of the request, the @MasterUserPassword@
-- element exists in the @PendingModifiedValues@ element of the operation
-- response.
--
-- Operations never return the password, so this operation provides a way
-- to regain access to the admin user account for a cluster if the password
-- is lost.
--
-- Default: Uses existing setting.
--
-- Constraints:
--
-- -   Must be between 8 and 64 characters in length.
--
-- -   Must contain at least one uppercase letter.
--
-- -   Must contain at least one lowercase letter.
--
-- -   Must contain one number.
--
-- -   Can be any printable ASCII character (ASCII code 33-126) except @\'@
--     (single quote), @\"@ (double quote), @\\@, @\/@, or @\@@.
modifyCluster_masterUserPassword :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Text)
modifyCluster_masterUserPassword :: Lens' ModifyCluster (Maybe Text)
modifyCluster_masterUserPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Text
masterUserPassword :: Maybe Text
$sel:masterUserPassword:ModifyCluster' :: ModifyCluster -> Maybe Text
masterUserPassword} -> Maybe Text
masterUserPassword) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Text
a -> ModifyCluster
s {$sel:masterUserPassword:ModifyCluster' :: Maybe Text
masterUserPassword = Maybe Text
a} :: ModifyCluster)

-- | The new identifier for the cluster.
--
-- 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.
--
-- Example: @examplecluster@
modifyCluster_newClusterIdentifier :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Text)
modifyCluster_newClusterIdentifier :: Lens' ModifyCluster (Maybe Text)
modifyCluster_newClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Text
newClusterIdentifier' :: Maybe Text
$sel:newClusterIdentifier':ModifyCluster' :: ModifyCluster -> Maybe Text
newClusterIdentifier'} -> Maybe Text
newClusterIdentifier') (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Text
a -> ModifyCluster
s {$sel:newClusterIdentifier':ModifyCluster' :: Maybe Text
newClusterIdentifier' = Maybe Text
a} :: ModifyCluster)

-- | The new node type of the cluster. If you specify a new node type, you
-- must also specify the number of nodes parameter.
--
-- For more information about resizing clusters, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/rs-resize-tutorial.html Resizing Clusters in Amazon Redshift>
-- in the /Amazon Redshift Cluster Management Guide/.
--
-- Valid Values: @ds2.xlarge@ | @ds2.8xlarge@ | @dc1.large@ | @dc1.8xlarge@
-- | @dc2.large@ | @dc2.8xlarge@ | @ra3.xlplus@ | @ra3.4xlarge@ |
-- @ra3.16xlarge@
modifyCluster_nodeType :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Text)
modifyCluster_nodeType :: Lens' ModifyCluster (Maybe Text)
modifyCluster_nodeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Text
nodeType :: Maybe Text
$sel:nodeType:ModifyCluster' :: ModifyCluster -> Maybe Text
nodeType} -> Maybe Text
nodeType) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Text
a -> ModifyCluster
s {$sel:nodeType:ModifyCluster' :: Maybe Text
nodeType = Maybe Text
a} :: ModifyCluster)

-- | The new number of nodes of the cluster. If you specify a new number of
-- nodes, you must also specify the node type parameter.
--
-- For more information about resizing clusters, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/rs-resize-tutorial.html Resizing Clusters in Amazon Redshift>
-- in the /Amazon Redshift Cluster Management Guide/.
--
-- Valid Values: Integer greater than @0@.
modifyCluster_numberOfNodes :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Int)
modifyCluster_numberOfNodes :: Lens' ModifyCluster (Maybe Int)
modifyCluster_numberOfNodes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Int
numberOfNodes :: Maybe Int
$sel:numberOfNodes:ModifyCluster' :: ModifyCluster -> Maybe Int
numberOfNodes} -> Maybe Int
numberOfNodes) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Int
a -> ModifyCluster
s {$sel:numberOfNodes:ModifyCluster' :: Maybe Int
numberOfNodes = Maybe Int
a} :: ModifyCluster)

-- | The option to change the port of an Amazon Redshift cluster.
modifyCluster_port :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Int)
modifyCluster_port :: Lens' ModifyCluster (Maybe Int)
modifyCluster_port = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Int
port :: Maybe Int
$sel:port:ModifyCluster' :: ModifyCluster -> Maybe Int
port} -> Maybe Int
port) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Int
a -> ModifyCluster
s {$sel:port:ModifyCluster' :: Maybe Int
port = Maybe Int
a} :: ModifyCluster)

-- | The weekly time range (in UTC) during which system maintenance can
-- occur, if necessary. If system maintenance is necessary during the
-- window, it may result in an outage.
--
-- This maintenance window change is made immediately. If the new
-- maintenance window indicates the current time, there must be at least
-- 120 minutes between the current time and end of the window in order to
-- ensure that pending changes are applied.
--
-- Default: Uses existing setting.
--
-- Format: ddd:hh24:mi-ddd:hh24:mi, for example @wed:07:30-wed:08:00@.
--
-- Valid Days: Mon | Tue | Wed | Thu | Fri | Sat | Sun
--
-- Constraints: Must be at least 30 minutes.
modifyCluster_preferredMaintenanceWindow :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Text)
modifyCluster_preferredMaintenanceWindow :: Lens' ModifyCluster (Maybe Text)
modifyCluster_preferredMaintenanceWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Text
preferredMaintenanceWindow :: Maybe Text
$sel:preferredMaintenanceWindow:ModifyCluster' :: ModifyCluster -> Maybe Text
preferredMaintenanceWindow} -> Maybe Text
preferredMaintenanceWindow) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Text
a -> ModifyCluster
s {$sel:preferredMaintenanceWindow:ModifyCluster' :: Maybe Text
preferredMaintenanceWindow = Maybe Text
a} :: ModifyCluster)

-- | If @true@, the cluster can be accessed from a public network. Only
-- clusters in VPCs can be set to be publicly available.
modifyCluster_publiclyAccessible :: Lens.Lens' ModifyCluster (Prelude.Maybe Prelude.Bool)
modifyCluster_publiclyAccessible :: Lens' ModifyCluster (Maybe Bool)
modifyCluster_publiclyAccessible = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe Bool
publiclyAccessible :: Maybe Bool
$sel:publiclyAccessible:ModifyCluster' :: ModifyCluster -> Maybe Bool
publiclyAccessible} -> Maybe Bool
publiclyAccessible) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe Bool
a -> ModifyCluster
s {$sel:publiclyAccessible:ModifyCluster' :: Maybe Bool
publiclyAccessible = Maybe Bool
a} :: ModifyCluster)

-- | A list of virtual private cloud (VPC) security groups to be associated
-- with the cluster. This change is asynchronously applied as soon as
-- possible.
modifyCluster_vpcSecurityGroupIds :: Lens.Lens' ModifyCluster (Prelude.Maybe [Prelude.Text])
modifyCluster_vpcSecurityGroupIds :: Lens' ModifyCluster (Maybe [Text])
modifyCluster_vpcSecurityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Maybe [Text]
vpcSecurityGroupIds :: Maybe [Text]
$sel:vpcSecurityGroupIds:ModifyCluster' :: ModifyCluster -> Maybe [Text]
vpcSecurityGroupIds} -> Maybe [Text]
vpcSecurityGroupIds) (\s :: ModifyCluster
s@ModifyCluster' {} Maybe [Text]
a -> ModifyCluster
s {$sel:vpcSecurityGroupIds:ModifyCluster' :: Maybe [Text]
vpcSecurityGroupIds = Maybe [Text]
a} :: ModifyCluster) 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 unique identifier of the cluster to be modified.
--
-- Example: @examplecluster@
modifyCluster_clusterIdentifier :: Lens.Lens' ModifyCluster Prelude.Text
modifyCluster_clusterIdentifier :: Lens' ModifyCluster Text
modifyCluster_clusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCluster' {Text
clusterIdentifier :: Text
$sel:clusterIdentifier:ModifyCluster' :: ModifyCluster -> Text
clusterIdentifier} -> Text
clusterIdentifier) (\s :: ModifyCluster
s@ModifyCluster' {} Text
a -> ModifyCluster
s {$sel:clusterIdentifier:ModifyCluster' :: Text
clusterIdentifier = Text
a} :: ModifyCluster)

instance Core.AWSRequest ModifyCluster where
  type
    AWSResponse ModifyCluster =
      ModifyClusterResponse
  request :: (Service -> Service) -> ModifyCluster -> Request ModifyCluster
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 ModifyCluster
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ModifyCluster)))
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
"ModifyClusterResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Cluster -> Int -> ModifyClusterResponse
ModifyClusterResponse'
            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 ModifyCluster where
  hashWithSalt :: Int -> ModifyCluster -> Int
hashWithSalt Int
_salt ModifyCluster' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Text
clusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
publiclyAccessible :: Maybe Bool
preferredMaintenanceWindow :: Maybe Text
port :: Maybe Int
numberOfNodes :: Maybe Int
nodeType :: Maybe Text
newClusterIdentifier' :: Maybe Text
masterUserPassword :: Maybe Text
manualSnapshotRetentionPeriod :: Maybe Int
maintenanceTrackName :: Maybe Text
kmsKeyId :: Maybe Text
hsmConfigurationIdentifier :: Maybe Text
hsmClientCertificateIdentifier :: Maybe Text
enhancedVpcRouting :: Maybe Bool
encrypted :: Maybe Bool
elasticIp :: Maybe Text
clusterVersion :: Maybe Text
clusterType :: Maybe Text
clusterSecurityGroups :: Maybe [Text]
clusterParameterGroupName :: Maybe Text
availabilityZoneRelocation :: Maybe Bool
availabilityZone :: Maybe Text
automatedSnapshotRetentionPeriod :: Maybe Int
allowVersionUpgrade :: Maybe Bool
$sel:clusterIdentifier:ModifyCluster' :: ModifyCluster -> Text
$sel:vpcSecurityGroupIds:ModifyCluster' :: ModifyCluster -> Maybe [Text]
$sel:publiclyAccessible:ModifyCluster' :: ModifyCluster -> Maybe Bool
$sel:preferredMaintenanceWindow:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:port:ModifyCluster' :: ModifyCluster -> Maybe Int
$sel:numberOfNodes:ModifyCluster' :: ModifyCluster -> Maybe Int
$sel:nodeType:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:newClusterIdentifier':ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:masterUserPassword:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:manualSnapshotRetentionPeriod:ModifyCluster' :: ModifyCluster -> Maybe Int
$sel:maintenanceTrackName:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:kmsKeyId:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:hsmConfigurationIdentifier:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:hsmClientCertificateIdentifier:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:enhancedVpcRouting:ModifyCluster' :: ModifyCluster -> Maybe Bool
$sel:encrypted:ModifyCluster' :: ModifyCluster -> Maybe Bool
$sel:elasticIp:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:clusterVersion:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:clusterType:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:clusterSecurityGroups:ModifyCluster' :: ModifyCluster -> Maybe [Text]
$sel:clusterParameterGroupName:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:availabilityZoneRelocation:ModifyCluster' :: ModifyCluster -> Maybe Bool
$sel:availabilityZone:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:automatedSnapshotRetentionPeriod:ModifyCluster' :: ModifyCluster -> Maybe Int
$sel:allowVersionUpgrade:ModifyCluster' :: ModifyCluster -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
allowVersionUpgrade
      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
clusterType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterVersion
      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
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
masterUserPassword
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
newClusterIdentifier'
      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 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]
vpcSecurityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterIdentifier

instance Prelude.NFData ModifyCluster where
  rnf :: ModifyCluster -> ()
rnf ModifyCluster' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Text
clusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
publiclyAccessible :: Maybe Bool
preferredMaintenanceWindow :: Maybe Text
port :: Maybe Int
numberOfNodes :: Maybe Int
nodeType :: Maybe Text
newClusterIdentifier' :: Maybe Text
masterUserPassword :: Maybe Text
manualSnapshotRetentionPeriod :: Maybe Int
maintenanceTrackName :: Maybe Text
kmsKeyId :: Maybe Text
hsmConfigurationIdentifier :: Maybe Text
hsmClientCertificateIdentifier :: Maybe Text
enhancedVpcRouting :: Maybe Bool
encrypted :: Maybe Bool
elasticIp :: Maybe Text
clusterVersion :: Maybe Text
clusterType :: Maybe Text
clusterSecurityGroups :: Maybe [Text]
clusterParameterGroupName :: Maybe Text
availabilityZoneRelocation :: Maybe Bool
availabilityZone :: Maybe Text
automatedSnapshotRetentionPeriod :: Maybe Int
allowVersionUpgrade :: Maybe Bool
$sel:clusterIdentifier:ModifyCluster' :: ModifyCluster -> Text
$sel:vpcSecurityGroupIds:ModifyCluster' :: ModifyCluster -> Maybe [Text]
$sel:publiclyAccessible:ModifyCluster' :: ModifyCluster -> Maybe Bool
$sel:preferredMaintenanceWindow:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:port:ModifyCluster' :: ModifyCluster -> Maybe Int
$sel:numberOfNodes:ModifyCluster' :: ModifyCluster -> Maybe Int
$sel:nodeType:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:newClusterIdentifier':ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:masterUserPassword:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:manualSnapshotRetentionPeriod:ModifyCluster' :: ModifyCluster -> Maybe Int
$sel:maintenanceTrackName:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:kmsKeyId:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:hsmConfigurationIdentifier:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:hsmClientCertificateIdentifier:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:enhancedVpcRouting:ModifyCluster' :: ModifyCluster -> Maybe Bool
$sel:encrypted:ModifyCluster' :: ModifyCluster -> Maybe Bool
$sel:elasticIp:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:clusterVersion:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:clusterType:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:clusterSecurityGroups:ModifyCluster' :: ModifyCluster -> Maybe [Text]
$sel:clusterParameterGroupName:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:availabilityZoneRelocation:ModifyCluster' :: ModifyCluster -> Maybe Bool
$sel:availabilityZone:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:automatedSnapshotRetentionPeriod:ModifyCluster' :: ModifyCluster -> Maybe Int
$sel:allowVersionUpgrade:ModifyCluster' :: ModifyCluster -> Maybe Bool
..} =
    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 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
clusterType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe 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
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
masterUserPassword
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
newClusterIdentifier'
      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 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]
vpcSecurityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Text
clusterIdentifier

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

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

instance Data.ToQuery ModifyCluster where
  toQuery :: ModifyCluster -> QueryString
toQuery ModifyCluster' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Text
clusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
publiclyAccessible :: Maybe Bool
preferredMaintenanceWindow :: Maybe Text
port :: Maybe Int
numberOfNodes :: Maybe Int
nodeType :: Maybe Text
newClusterIdentifier' :: Maybe Text
masterUserPassword :: Maybe Text
manualSnapshotRetentionPeriod :: Maybe Int
maintenanceTrackName :: Maybe Text
kmsKeyId :: Maybe Text
hsmConfigurationIdentifier :: Maybe Text
hsmClientCertificateIdentifier :: Maybe Text
enhancedVpcRouting :: Maybe Bool
encrypted :: Maybe Bool
elasticIp :: Maybe Text
clusterVersion :: Maybe Text
clusterType :: Maybe Text
clusterSecurityGroups :: Maybe [Text]
clusterParameterGroupName :: Maybe Text
availabilityZoneRelocation :: Maybe Bool
availabilityZone :: Maybe Text
automatedSnapshotRetentionPeriod :: Maybe Int
allowVersionUpgrade :: Maybe Bool
$sel:clusterIdentifier:ModifyCluster' :: ModifyCluster -> Text
$sel:vpcSecurityGroupIds:ModifyCluster' :: ModifyCluster -> Maybe [Text]
$sel:publiclyAccessible:ModifyCluster' :: ModifyCluster -> Maybe Bool
$sel:preferredMaintenanceWindow:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:port:ModifyCluster' :: ModifyCluster -> Maybe Int
$sel:numberOfNodes:ModifyCluster' :: ModifyCluster -> Maybe Int
$sel:nodeType:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:newClusterIdentifier':ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:masterUserPassword:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:manualSnapshotRetentionPeriod:ModifyCluster' :: ModifyCluster -> Maybe Int
$sel:maintenanceTrackName:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:kmsKeyId:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:hsmConfigurationIdentifier:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:hsmClientCertificateIdentifier:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:enhancedVpcRouting:ModifyCluster' :: ModifyCluster -> Maybe Bool
$sel:encrypted:ModifyCluster' :: ModifyCluster -> Maybe Bool
$sel:elasticIp:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:clusterVersion:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:clusterType:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:clusterSecurityGroups:ModifyCluster' :: ModifyCluster -> Maybe [Text]
$sel:clusterParameterGroupName:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:availabilityZoneRelocation:ModifyCluster' :: ModifyCluster -> Maybe Bool
$sel:availabilityZone:ModifyCluster' :: ModifyCluster -> Maybe Text
$sel:automatedSnapshotRetentionPeriod:ModifyCluster' :: ModifyCluster -> Maybe Int
$sel:allowVersionUpgrade:ModifyCluster' :: ModifyCluster -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyCluster" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"AllowVersionUpgrade" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
allowVersionUpgrade,
        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
"ClusterType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clusterType,
        ByteString
"ClusterVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clusterVersion,
        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
"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
"MasterUserPassword" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
masterUserPassword,
        ByteString
"NewClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
newClusterIdentifier',
        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
"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
"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:/ 'newModifyClusterResponse' smart constructor.
data ModifyClusterResponse = ModifyClusterResponse'
  { ModifyClusterResponse -> Maybe Cluster
cluster :: Prelude.Maybe Cluster,
    -- | The response's http status code.
    ModifyClusterResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ModifyClusterResponse -> ModifyClusterResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyClusterResponse -> ModifyClusterResponse -> Bool
$c/= :: ModifyClusterResponse -> ModifyClusterResponse -> Bool
== :: ModifyClusterResponse -> ModifyClusterResponse -> Bool
$c== :: ModifyClusterResponse -> ModifyClusterResponse -> Bool
Prelude.Eq, ReadPrec [ModifyClusterResponse]
ReadPrec ModifyClusterResponse
Int -> ReadS ModifyClusterResponse
ReadS [ModifyClusterResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyClusterResponse]
$creadListPrec :: ReadPrec [ModifyClusterResponse]
readPrec :: ReadPrec ModifyClusterResponse
$creadPrec :: ReadPrec ModifyClusterResponse
readList :: ReadS [ModifyClusterResponse]
$creadList :: ReadS [ModifyClusterResponse]
readsPrec :: Int -> ReadS ModifyClusterResponse
$creadsPrec :: Int -> ReadS ModifyClusterResponse
Prelude.Read, Int -> ModifyClusterResponse -> ShowS
[ModifyClusterResponse] -> ShowS
ModifyClusterResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyClusterResponse] -> ShowS
$cshowList :: [ModifyClusterResponse] -> ShowS
show :: ModifyClusterResponse -> String
$cshow :: ModifyClusterResponse -> String
showsPrec :: Int -> ModifyClusterResponse -> ShowS
$cshowsPrec :: Int -> ModifyClusterResponse -> ShowS
Prelude.Show, forall x. Rep ModifyClusterResponse x -> ModifyClusterResponse
forall x. ModifyClusterResponse -> Rep ModifyClusterResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyClusterResponse x -> ModifyClusterResponse
$cfrom :: forall x. ModifyClusterResponse -> Rep ModifyClusterResponse x
Prelude.Generic)

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

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

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

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