{-# 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.Neptune.ModifyDBCluster
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modify a setting for a DB cluster. You can change one or more database
-- configuration parameters by specifying these parameters and the new
-- values in the request.
module Amazonka.Neptune.ModifyDBCluster
  ( -- * Creating a Request
    ModifyDBCluster (..),
    newModifyDBCluster,

    -- * Request Lenses
    modifyDBCluster_allowMajorVersionUpgrade,
    modifyDBCluster_applyImmediately,
    modifyDBCluster_backupRetentionPeriod,
    modifyDBCluster_cloudwatchLogsExportConfiguration,
    modifyDBCluster_copyTagsToSnapshot,
    modifyDBCluster_dbClusterParameterGroupName,
    modifyDBCluster_dbInstanceParameterGroupName,
    modifyDBCluster_deletionProtection,
    modifyDBCluster_enableIAMDatabaseAuthentication,
    modifyDBCluster_engineVersion,
    modifyDBCluster_masterUserPassword,
    modifyDBCluster_newDBClusterIdentifier,
    modifyDBCluster_optionGroupName,
    modifyDBCluster_port,
    modifyDBCluster_preferredBackupWindow,
    modifyDBCluster_preferredMaintenanceWindow,
    modifyDBCluster_serverlessV2ScalingConfiguration,
    modifyDBCluster_vpcSecurityGroupIds,
    modifyDBCluster_dbClusterIdentifier,

    -- * Destructuring the Response
    ModifyDBClusterResponse (..),
    newModifyDBClusterResponse,

    -- * Response Lenses
    modifyDBClusterResponse_dbCluster,
    modifyDBClusterResponse_httpStatus,
  )
where

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

-- | /See:/ 'newModifyDBCluster' smart constructor.
data ModifyDBCluster = ModifyDBCluster'
  { -- | A value that indicates whether upgrades between different major versions
    -- are allowed.
    --
    -- Constraints: You must set the allow-major-version-upgrade flag when
    -- providing an @EngineVersion@ parameter that uses a different major
    -- version than the DB cluster\'s current version.
    ModifyDBCluster -> Maybe Bool
allowMajorVersionUpgrade :: Prelude.Maybe Prelude.Bool,
    -- | A value that specifies whether the modifications in this request and any
    -- pending modifications are asynchronously applied as soon as possible,
    -- regardless of the @PreferredMaintenanceWindow@ setting for the DB
    -- cluster. If this parameter is set to @false@, changes to the DB cluster
    -- are applied during the next maintenance window.
    --
    -- The @ApplyImmediately@ parameter only affects @NewDBClusterIdentifier@
    -- values. If you set the @ApplyImmediately@ parameter value to false, then
    -- changes to @NewDBClusterIdentifier@ values are applied during the next
    -- maintenance window. All other changes are applied immediately,
    -- regardless of the value of the @ApplyImmediately@ parameter.
    --
    -- Default: @false@
    ModifyDBCluster -> Maybe Bool
applyImmediately :: Prelude.Maybe Prelude.Bool,
    -- | The number of days for which automated backups are retained. You must
    -- specify a minimum value of 1.
    --
    -- Default: 1
    --
    -- Constraints:
    --
    -- -   Must be a value from 1 to 35
    ModifyDBCluster -> Maybe Int
backupRetentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | The configuration setting for the log types to be enabled for export to
    -- CloudWatch Logs for a specific DB cluster.
    ModifyDBCluster -> Maybe CloudwatchLogsExportConfiguration
cloudwatchLogsExportConfiguration :: Prelude.Maybe CloudwatchLogsExportConfiguration,
    -- | /If set to @true@, tags are copied to any snapshot of the DB cluster
    -- that is created./
    ModifyDBCluster -> Maybe Bool
copyTagsToSnapshot :: Prelude.Maybe Prelude.Bool,
    -- | The name of the DB cluster parameter group to use for the DB cluster.
    ModifyDBCluster -> Maybe Text
dbClusterParameterGroupName :: Prelude.Maybe Prelude.Text,
    -- | The name of the DB parameter group to apply to all instances of the DB
    -- cluster.
    --
    -- When you apply a parameter group using @DBInstanceParameterGroupName@,
    -- parameter changes aren\'t applied during the next maintenance window but
    -- instead are applied immediately.
    --
    -- Default: The existing name setting
    --
    -- Constraints:
    --
    -- -   The DB parameter group must be in the same DB parameter group family
    --     as the target DB cluster version.
    --
    -- -   The @DBInstanceParameterGroupName@ parameter is only valid in
    --     combination with the @AllowMajorVersionUpgrade@ parameter.
    ModifyDBCluster -> Maybe Text
dbInstanceParameterGroupName :: Prelude.Maybe Prelude.Text,
    -- | A value that indicates whether the DB cluster has deletion protection
    -- enabled. The database can\'t be deleted when deletion protection is
    -- enabled. By default, deletion protection is disabled.
    ModifyDBCluster -> Maybe Bool
deletionProtection :: Prelude.Maybe Prelude.Bool,
    -- | True to enable mapping of Amazon Identity and Access Management (IAM)
    -- accounts to database accounts, and otherwise false.
    --
    -- Default: @false@
    ModifyDBCluster -> Maybe Bool
enableIAMDatabaseAuthentication :: Prelude.Maybe Prelude.Bool,
    -- | The version number of the database engine to which you want to upgrade.
    -- Changing this parameter results in an outage. The change is applied
    -- during the next maintenance window unless the @ApplyImmediately@
    -- parameter is set to true.
    --
    -- For a list of valid engine versions, see
    -- <https://docs.aws.amazon.com/neptune/latest/userguide/engine-releases.html Engine Releases for Amazon Neptune>,
    -- or call
    -- <https://docs.aws.amazon.com/neptune/latest/userguide/api-other-apis.html#DescribeDBEngineVersions DescribeDBEngineVersions>.
    ModifyDBCluster -> Maybe Text
engineVersion :: Prelude.Maybe Prelude.Text,
    -- | Not supported by Neptune.
    ModifyDBCluster -> Maybe Text
masterUserPassword :: Prelude.Maybe Prelude.Text,
    -- | The new DB cluster identifier for the DB cluster when renaming a DB
    -- cluster. This value is stored as a lowercase string.
    --
    -- Constraints:
    --
    -- -   Must contain from 1 to 63 letters, numbers, or hyphens
    --
    -- -   The first character must be a letter
    --
    -- -   Cannot end with a hyphen or contain two consecutive hyphens
    --
    -- Example: @my-cluster2@
    ModifyDBCluster -> Maybe Text
newDBClusterIdentifier' :: Prelude.Maybe Prelude.Text,
    -- | /Not supported by Neptune./
    ModifyDBCluster -> Maybe Text
optionGroupName :: Prelude.Maybe Prelude.Text,
    -- | The port number on which the DB cluster accepts connections.
    --
    -- Constraints: Value must be @1150-65535@
    --
    -- Default: The same port as the original DB cluster.
    ModifyDBCluster -> Maybe Int
port :: Prelude.Maybe Prelude.Int,
    -- | The daily time range during which automated backups are created if
    -- automated backups are enabled, using the @BackupRetentionPeriod@
    -- parameter.
    --
    -- The default is a 30-minute window selected at random from an 8-hour
    -- block of time for each Amazon Region.
    --
    -- Constraints:
    --
    -- -   Must be in the format @hh24:mi-hh24:mi@.
    --
    -- -   Must be in Universal Coordinated Time (UTC).
    --
    -- -   Must not conflict with the preferred maintenance window.
    --
    -- -   Must be at least 30 minutes.
    ModifyDBCluster -> Maybe Text
preferredBackupWindow :: Prelude.Maybe Prelude.Text,
    -- | The weekly time range during which system maintenance can occur, in
    -- Universal Coordinated Time (UTC).
    --
    -- Format: @ddd:hh24:mi-ddd:hh24:mi@
    --
    -- The default is a 30-minute window selected at random from an 8-hour
    -- block of time for each Amazon Region, occurring on a random day of the
    -- week.
    --
    -- Valid Days: Mon, Tue, Wed, Thu, Fri, Sat, Sun.
    --
    -- Constraints: Minimum 30-minute window.
    ModifyDBCluster -> Maybe Text
preferredMaintenanceWindow :: Prelude.Maybe Prelude.Text,
    ModifyDBCluster -> Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration :: Prelude.Maybe ServerlessV2ScalingConfiguration,
    -- | A list of VPC security groups that the DB cluster will belong to.
    ModifyDBCluster -> Maybe [Text]
vpcSecurityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The DB cluster identifier for the cluster being modified. This parameter
    -- is not case-sensitive.
    --
    -- Constraints:
    --
    -- -   Must match the identifier of an existing DBCluster.
    ModifyDBCluster -> Text
dbClusterIdentifier :: Prelude.Text
  }
  deriving (ModifyDBCluster -> ModifyDBCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyDBCluster -> ModifyDBCluster -> Bool
$c/= :: ModifyDBCluster -> ModifyDBCluster -> Bool
== :: ModifyDBCluster -> ModifyDBCluster -> Bool
$c== :: ModifyDBCluster -> ModifyDBCluster -> Bool
Prelude.Eq, ReadPrec [ModifyDBCluster]
ReadPrec ModifyDBCluster
Int -> ReadS ModifyDBCluster
ReadS [ModifyDBCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyDBCluster]
$creadListPrec :: ReadPrec [ModifyDBCluster]
readPrec :: ReadPrec ModifyDBCluster
$creadPrec :: ReadPrec ModifyDBCluster
readList :: ReadS [ModifyDBCluster]
$creadList :: ReadS [ModifyDBCluster]
readsPrec :: Int -> ReadS ModifyDBCluster
$creadsPrec :: Int -> ReadS ModifyDBCluster
Prelude.Read, Int -> ModifyDBCluster -> ShowS
[ModifyDBCluster] -> ShowS
ModifyDBCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyDBCluster] -> ShowS
$cshowList :: [ModifyDBCluster] -> ShowS
show :: ModifyDBCluster -> String
$cshow :: ModifyDBCluster -> String
showsPrec :: Int -> ModifyDBCluster -> ShowS
$cshowsPrec :: Int -> ModifyDBCluster -> ShowS
Prelude.Show, forall x. Rep ModifyDBCluster x -> ModifyDBCluster
forall x. ModifyDBCluster -> Rep ModifyDBCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyDBCluster x -> ModifyDBCluster
$cfrom :: forall x. ModifyDBCluster -> Rep ModifyDBCluster x
Prelude.Generic)

-- |
-- Create a value of 'ModifyDBCluster' 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:
--
-- 'allowMajorVersionUpgrade', 'modifyDBCluster_allowMajorVersionUpgrade' - A value that indicates whether upgrades between different major versions
-- are allowed.
--
-- Constraints: You must set the allow-major-version-upgrade flag when
-- providing an @EngineVersion@ parameter that uses a different major
-- version than the DB cluster\'s current version.
--
-- 'applyImmediately', 'modifyDBCluster_applyImmediately' - A value that specifies whether the modifications in this request and any
-- pending modifications are asynchronously applied as soon as possible,
-- regardless of the @PreferredMaintenanceWindow@ setting for the DB
-- cluster. If this parameter is set to @false@, changes to the DB cluster
-- are applied during the next maintenance window.
--
-- The @ApplyImmediately@ parameter only affects @NewDBClusterIdentifier@
-- values. If you set the @ApplyImmediately@ parameter value to false, then
-- changes to @NewDBClusterIdentifier@ values are applied during the next
-- maintenance window. All other changes are applied immediately,
-- regardless of the value of the @ApplyImmediately@ parameter.
--
-- Default: @false@
--
-- 'backupRetentionPeriod', 'modifyDBCluster_backupRetentionPeriod' - The number of days for which automated backups are retained. You must
-- specify a minimum value of 1.
--
-- Default: 1
--
-- Constraints:
--
-- -   Must be a value from 1 to 35
--
-- 'cloudwatchLogsExportConfiguration', 'modifyDBCluster_cloudwatchLogsExportConfiguration' - The configuration setting for the log types to be enabled for export to
-- CloudWatch Logs for a specific DB cluster.
--
-- 'copyTagsToSnapshot', 'modifyDBCluster_copyTagsToSnapshot' - /If set to @true@, tags are copied to any snapshot of the DB cluster
-- that is created./
--
-- 'dbClusterParameterGroupName', 'modifyDBCluster_dbClusterParameterGroupName' - The name of the DB cluster parameter group to use for the DB cluster.
--
-- 'dbInstanceParameterGroupName', 'modifyDBCluster_dbInstanceParameterGroupName' - The name of the DB parameter group to apply to all instances of the DB
-- cluster.
--
-- When you apply a parameter group using @DBInstanceParameterGroupName@,
-- parameter changes aren\'t applied during the next maintenance window but
-- instead are applied immediately.
--
-- Default: The existing name setting
--
-- Constraints:
--
-- -   The DB parameter group must be in the same DB parameter group family
--     as the target DB cluster version.
--
-- -   The @DBInstanceParameterGroupName@ parameter is only valid in
--     combination with the @AllowMajorVersionUpgrade@ parameter.
--
-- 'deletionProtection', 'modifyDBCluster_deletionProtection' - A value that indicates whether the DB cluster has deletion protection
-- enabled. The database can\'t be deleted when deletion protection is
-- enabled. By default, deletion protection is disabled.
--
-- 'enableIAMDatabaseAuthentication', 'modifyDBCluster_enableIAMDatabaseAuthentication' - True to enable mapping of Amazon Identity and Access Management (IAM)
-- accounts to database accounts, and otherwise false.
--
-- Default: @false@
--
-- 'engineVersion', 'modifyDBCluster_engineVersion' - The version number of the database engine to which you want to upgrade.
-- Changing this parameter results in an outage. The change is applied
-- during the next maintenance window unless the @ApplyImmediately@
-- parameter is set to true.
--
-- For a list of valid engine versions, see
-- <https://docs.aws.amazon.com/neptune/latest/userguide/engine-releases.html Engine Releases for Amazon Neptune>,
-- or call
-- <https://docs.aws.amazon.com/neptune/latest/userguide/api-other-apis.html#DescribeDBEngineVersions DescribeDBEngineVersions>.
--
-- 'masterUserPassword', 'modifyDBCluster_masterUserPassword' - Not supported by Neptune.
--
-- 'newDBClusterIdentifier'', 'modifyDBCluster_newDBClusterIdentifier' - The new DB cluster identifier for the DB cluster when renaming a DB
-- cluster. This value is stored as a lowercase string.
--
-- Constraints:
--
-- -   Must contain from 1 to 63 letters, numbers, or hyphens
--
-- -   The first character must be a letter
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens
--
-- Example: @my-cluster2@
--
-- 'optionGroupName', 'modifyDBCluster_optionGroupName' - /Not supported by Neptune./
--
-- 'port', 'modifyDBCluster_port' - The port number on which the DB cluster accepts connections.
--
-- Constraints: Value must be @1150-65535@
--
-- Default: The same port as the original DB cluster.
--
-- 'preferredBackupWindow', 'modifyDBCluster_preferredBackupWindow' - The daily time range during which automated backups are created if
-- automated backups are enabled, using the @BackupRetentionPeriod@
-- parameter.
--
-- The default is a 30-minute window selected at random from an 8-hour
-- block of time for each Amazon Region.
--
-- Constraints:
--
-- -   Must be in the format @hh24:mi-hh24:mi@.
--
-- -   Must be in Universal Coordinated Time (UTC).
--
-- -   Must not conflict with the preferred maintenance window.
--
-- -   Must be at least 30 minutes.
--
-- 'preferredMaintenanceWindow', 'modifyDBCluster_preferredMaintenanceWindow' - The weekly time range during which system maintenance can occur, in
-- Universal Coordinated Time (UTC).
--
-- Format: @ddd:hh24:mi-ddd:hh24:mi@
--
-- The default is a 30-minute window selected at random from an 8-hour
-- block of time for each Amazon Region, occurring on a random day of the
-- week.
--
-- Valid Days: Mon, Tue, Wed, Thu, Fri, Sat, Sun.
--
-- Constraints: Minimum 30-minute window.
--
-- 'serverlessV2ScalingConfiguration', 'modifyDBCluster_serverlessV2ScalingConfiguration' - Undocumented member.
--
-- 'vpcSecurityGroupIds', 'modifyDBCluster_vpcSecurityGroupIds' - A list of VPC security groups that the DB cluster will belong to.
--
-- 'dbClusterIdentifier', 'modifyDBCluster_dbClusterIdentifier' - The DB cluster identifier for the cluster being modified. This parameter
-- is not case-sensitive.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DBCluster.
newModifyDBCluster ::
  -- | 'dbClusterIdentifier'
  Prelude.Text ->
  ModifyDBCluster
newModifyDBCluster :: Text -> ModifyDBCluster
newModifyDBCluster Text
pDBClusterIdentifier_ =
  ModifyDBCluster'
    { $sel:allowMajorVersionUpgrade:ModifyDBCluster' :: Maybe Bool
allowMajorVersionUpgrade =
        forall a. Maybe a
Prelude.Nothing,
      $sel:applyImmediately:ModifyDBCluster' :: Maybe Bool
applyImmediately = forall a. Maybe a
Prelude.Nothing,
      $sel:backupRetentionPeriod:ModifyDBCluster' :: Maybe Int
backupRetentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:cloudwatchLogsExportConfiguration:ModifyDBCluster' :: Maybe CloudwatchLogsExportConfiguration
cloudwatchLogsExportConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:copyTagsToSnapshot:ModifyDBCluster' :: Maybe Bool
copyTagsToSnapshot = forall a. Maybe a
Prelude.Nothing,
      $sel:dbClusterParameterGroupName:ModifyDBCluster' :: Maybe Text
dbClusterParameterGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:dbInstanceParameterGroupName:ModifyDBCluster' :: Maybe Text
dbInstanceParameterGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:deletionProtection:ModifyDBCluster' :: Maybe Bool
deletionProtection = forall a. Maybe a
Prelude.Nothing,
      $sel:enableIAMDatabaseAuthentication:ModifyDBCluster' :: Maybe Bool
enableIAMDatabaseAuthentication = forall a. Maybe a
Prelude.Nothing,
      $sel:engineVersion:ModifyDBCluster' :: Maybe Text
engineVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:masterUserPassword:ModifyDBCluster' :: Maybe Text
masterUserPassword = forall a. Maybe a
Prelude.Nothing,
      $sel:newDBClusterIdentifier':ModifyDBCluster' :: Maybe Text
newDBClusterIdentifier' = forall a. Maybe a
Prelude.Nothing,
      $sel:optionGroupName:ModifyDBCluster' :: Maybe Text
optionGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:port:ModifyDBCluster' :: Maybe Int
port = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredBackupWindow:ModifyDBCluster' :: Maybe Text
preferredBackupWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredMaintenanceWindow:ModifyDBCluster' :: Maybe Text
preferredMaintenanceWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:serverlessV2ScalingConfiguration:ModifyDBCluster' :: Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcSecurityGroupIds:ModifyDBCluster' :: Maybe [Text]
vpcSecurityGroupIds = forall a. Maybe a
Prelude.Nothing,
      $sel:dbClusterIdentifier:ModifyDBCluster' :: Text
dbClusterIdentifier = Text
pDBClusterIdentifier_
    }

-- | A value that indicates whether upgrades between different major versions
-- are allowed.
--
-- Constraints: You must set the allow-major-version-upgrade flag when
-- providing an @EngineVersion@ parameter that uses a different major
-- version than the DB cluster\'s current version.
modifyDBCluster_allowMajorVersionUpgrade :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Bool)
modifyDBCluster_allowMajorVersionUpgrade :: Lens' ModifyDBCluster (Maybe Bool)
modifyDBCluster_allowMajorVersionUpgrade = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Bool
allowMajorVersionUpgrade :: Maybe Bool
$sel:allowMajorVersionUpgrade:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
allowMajorVersionUpgrade} -> Maybe Bool
allowMajorVersionUpgrade) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Bool
a -> ModifyDBCluster
s {$sel:allowMajorVersionUpgrade:ModifyDBCluster' :: Maybe Bool
allowMajorVersionUpgrade = Maybe Bool
a} :: ModifyDBCluster)

-- | A value that specifies whether the modifications in this request and any
-- pending modifications are asynchronously applied as soon as possible,
-- regardless of the @PreferredMaintenanceWindow@ setting for the DB
-- cluster. If this parameter is set to @false@, changes to the DB cluster
-- are applied during the next maintenance window.
--
-- The @ApplyImmediately@ parameter only affects @NewDBClusterIdentifier@
-- values. If you set the @ApplyImmediately@ parameter value to false, then
-- changes to @NewDBClusterIdentifier@ values are applied during the next
-- maintenance window. All other changes are applied immediately,
-- regardless of the value of the @ApplyImmediately@ parameter.
--
-- Default: @false@
modifyDBCluster_applyImmediately :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Bool)
modifyDBCluster_applyImmediately :: Lens' ModifyDBCluster (Maybe Bool)
modifyDBCluster_applyImmediately = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Bool
applyImmediately :: Maybe Bool
$sel:applyImmediately:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
applyImmediately} -> Maybe Bool
applyImmediately) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Bool
a -> ModifyDBCluster
s {$sel:applyImmediately:ModifyDBCluster' :: Maybe Bool
applyImmediately = Maybe Bool
a} :: ModifyDBCluster)

-- | The number of days for which automated backups are retained. You must
-- specify a minimum value of 1.
--
-- Default: 1
--
-- Constraints:
--
-- -   Must be a value from 1 to 35
modifyDBCluster_backupRetentionPeriod :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Int)
modifyDBCluster_backupRetentionPeriod :: Lens' ModifyDBCluster (Maybe Int)
modifyDBCluster_backupRetentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Int
backupRetentionPeriod :: Maybe Int
$sel:backupRetentionPeriod:ModifyDBCluster' :: ModifyDBCluster -> Maybe Int
backupRetentionPeriod} -> Maybe Int
backupRetentionPeriod) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Int
a -> ModifyDBCluster
s {$sel:backupRetentionPeriod:ModifyDBCluster' :: Maybe Int
backupRetentionPeriod = Maybe Int
a} :: ModifyDBCluster)

-- | The configuration setting for the log types to be enabled for export to
-- CloudWatch Logs for a specific DB cluster.
modifyDBCluster_cloudwatchLogsExportConfiguration :: Lens.Lens' ModifyDBCluster (Prelude.Maybe CloudwatchLogsExportConfiguration)
modifyDBCluster_cloudwatchLogsExportConfiguration :: Lens' ModifyDBCluster (Maybe CloudwatchLogsExportConfiguration)
modifyDBCluster_cloudwatchLogsExportConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe CloudwatchLogsExportConfiguration
cloudwatchLogsExportConfiguration :: Maybe CloudwatchLogsExportConfiguration
$sel:cloudwatchLogsExportConfiguration:ModifyDBCluster' :: ModifyDBCluster -> Maybe CloudwatchLogsExportConfiguration
cloudwatchLogsExportConfiguration} -> Maybe CloudwatchLogsExportConfiguration
cloudwatchLogsExportConfiguration) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe CloudwatchLogsExportConfiguration
a -> ModifyDBCluster
s {$sel:cloudwatchLogsExportConfiguration:ModifyDBCluster' :: Maybe CloudwatchLogsExportConfiguration
cloudwatchLogsExportConfiguration = Maybe CloudwatchLogsExportConfiguration
a} :: ModifyDBCluster)

-- | /If set to @true@, tags are copied to any snapshot of the DB cluster
-- that is created./
modifyDBCluster_copyTagsToSnapshot :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Bool)
modifyDBCluster_copyTagsToSnapshot :: Lens' ModifyDBCluster (Maybe Bool)
modifyDBCluster_copyTagsToSnapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Bool
copyTagsToSnapshot :: Maybe Bool
$sel:copyTagsToSnapshot:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
copyTagsToSnapshot} -> Maybe Bool
copyTagsToSnapshot) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Bool
a -> ModifyDBCluster
s {$sel:copyTagsToSnapshot:ModifyDBCluster' :: Maybe Bool
copyTagsToSnapshot = Maybe Bool
a} :: ModifyDBCluster)

-- | The name of the DB cluster parameter group to use for the DB cluster.
modifyDBCluster_dbClusterParameterGroupName :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Text)
modifyDBCluster_dbClusterParameterGroupName :: Lens' ModifyDBCluster (Maybe Text)
modifyDBCluster_dbClusterParameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Text
dbClusterParameterGroupName :: Maybe Text
$sel:dbClusterParameterGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
dbClusterParameterGroupName} -> Maybe Text
dbClusterParameterGroupName) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Text
a -> ModifyDBCluster
s {$sel:dbClusterParameterGroupName:ModifyDBCluster' :: Maybe Text
dbClusterParameterGroupName = Maybe Text
a} :: ModifyDBCluster)

-- | The name of the DB parameter group to apply to all instances of the DB
-- cluster.
--
-- When you apply a parameter group using @DBInstanceParameterGroupName@,
-- parameter changes aren\'t applied during the next maintenance window but
-- instead are applied immediately.
--
-- Default: The existing name setting
--
-- Constraints:
--
-- -   The DB parameter group must be in the same DB parameter group family
--     as the target DB cluster version.
--
-- -   The @DBInstanceParameterGroupName@ parameter is only valid in
--     combination with the @AllowMajorVersionUpgrade@ parameter.
modifyDBCluster_dbInstanceParameterGroupName :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Text)
modifyDBCluster_dbInstanceParameterGroupName :: Lens' ModifyDBCluster (Maybe Text)
modifyDBCluster_dbInstanceParameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Text
dbInstanceParameterGroupName :: Maybe Text
$sel:dbInstanceParameterGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
dbInstanceParameterGroupName} -> Maybe Text
dbInstanceParameterGroupName) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Text
a -> ModifyDBCluster
s {$sel:dbInstanceParameterGroupName:ModifyDBCluster' :: Maybe Text
dbInstanceParameterGroupName = Maybe Text
a} :: ModifyDBCluster)

-- | A value that indicates whether the DB cluster has deletion protection
-- enabled. The database can\'t be deleted when deletion protection is
-- enabled. By default, deletion protection is disabled.
modifyDBCluster_deletionProtection :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Bool)
modifyDBCluster_deletionProtection :: Lens' ModifyDBCluster (Maybe Bool)
modifyDBCluster_deletionProtection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Bool
deletionProtection :: Maybe Bool
$sel:deletionProtection:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
deletionProtection} -> Maybe Bool
deletionProtection) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Bool
a -> ModifyDBCluster
s {$sel:deletionProtection:ModifyDBCluster' :: Maybe Bool
deletionProtection = Maybe Bool
a} :: ModifyDBCluster)

-- | True to enable mapping of Amazon Identity and Access Management (IAM)
-- accounts to database accounts, and otherwise false.
--
-- Default: @false@
modifyDBCluster_enableIAMDatabaseAuthentication :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Bool)
modifyDBCluster_enableIAMDatabaseAuthentication :: Lens' ModifyDBCluster (Maybe Bool)
modifyDBCluster_enableIAMDatabaseAuthentication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Bool
enableIAMDatabaseAuthentication :: Maybe Bool
$sel:enableIAMDatabaseAuthentication:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
enableIAMDatabaseAuthentication} -> Maybe Bool
enableIAMDatabaseAuthentication) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Bool
a -> ModifyDBCluster
s {$sel:enableIAMDatabaseAuthentication:ModifyDBCluster' :: Maybe Bool
enableIAMDatabaseAuthentication = Maybe Bool
a} :: ModifyDBCluster)

-- | The version number of the database engine to which you want to upgrade.
-- Changing this parameter results in an outage. The change is applied
-- during the next maintenance window unless the @ApplyImmediately@
-- parameter is set to true.
--
-- For a list of valid engine versions, see
-- <https://docs.aws.amazon.com/neptune/latest/userguide/engine-releases.html Engine Releases for Amazon Neptune>,
-- or call
-- <https://docs.aws.amazon.com/neptune/latest/userguide/api-other-apis.html#DescribeDBEngineVersions DescribeDBEngineVersions>.
modifyDBCluster_engineVersion :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Text)
modifyDBCluster_engineVersion :: Lens' ModifyDBCluster (Maybe Text)
modifyDBCluster_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Text
engineVersion :: Maybe Text
$sel:engineVersion:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
engineVersion} -> Maybe Text
engineVersion) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Text
a -> ModifyDBCluster
s {$sel:engineVersion:ModifyDBCluster' :: Maybe Text
engineVersion = Maybe Text
a} :: ModifyDBCluster)

-- | Not supported by Neptune.
modifyDBCluster_masterUserPassword :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Text)
modifyDBCluster_masterUserPassword :: Lens' ModifyDBCluster (Maybe Text)
modifyDBCluster_masterUserPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Text
masterUserPassword :: Maybe Text
$sel:masterUserPassword:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
masterUserPassword} -> Maybe Text
masterUserPassword) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Text
a -> ModifyDBCluster
s {$sel:masterUserPassword:ModifyDBCluster' :: Maybe Text
masterUserPassword = Maybe Text
a} :: ModifyDBCluster)

-- | The new DB cluster identifier for the DB cluster when renaming a DB
-- cluster. This value is stored as a lowercase string.
--
-- Constraints:
--
-- -   Must contain from 1 to 63 letters, numbers, or hyphens
--
-- -   The first character must be a letter
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens
--
-- Example: @my-cluster2@
modifyDBCluster_newDBClusterIdentifier :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Text)
modifyDBCluster_newDBClusterIdentifier :: Lens' ModifyDBCluster (Maybe Text)
modifyDBCluster_newDBClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Text
newDBClusterIdentifier' :: Maybe Text
$sel:newDBClusterIdentifier':ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
newDBClusterIdentifier'} -> Maybe Text
newDBClusterIdentifier') (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Text
a -> ModifyDBCluster
s {$sel:newDBClusterIdentifier':ModifyDBCluster' :: Maybe Text
newDBClusterIdentifier' = Maybe Text
a} :: ModifyDBCluster)

-- | /Not supported by Neptune./
modifyDBCluster_optionGroupName :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Text)
modifyDBCluster_optionGroupName :: Lens' ModifyDBCluster (Maybe Text)
modifyDBCluster_optionGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Text
optionGroupName :: Maybe Text
$sel:optionGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
optionGroupName} -> Maybe Text
optionGroupName) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Text
a -> ModifyDBCluster
s {$sel:optionGroupName:ModifyDBCluster' :: Maybe Text
optionGroupName = Maybe Text
a} :: ModifyDBCluster)

-- | The port number on which the DB cluster accepts connections.
--
-- Constraints: Value must be @1150-65535@
--
-- Default: The same port as the original DB cluster.
modifyDBCluster_port :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Int)
modifyDBCluster_port :: Lens' ModifyDBCluster (Maybe Int)
modifyDBCluster_port = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Int
port :: Maybe Int
$sel:port:ModifyDBCluster' :: ModifyDBCluster -> Maybe Int
port} -> Maybe Int
port) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Int
a -> ModifyDBCluster
s {$sel:port:ModifyDBCluster' :: Maybe Int
port = Maybe Int
a} :: ModifyDBCluster)

-- | The daily time range during which automated backups are created if
-- automated backups are enabled, using the @BackupRetentionPeriod@
-- parameter.
--
-- The default is a 30-minute window selected at random from an 8-hour
-- block of time for each Amazon Region.
--
-- Constraints:
--
-- -   Must be in the format @hh24:mi-hh24:mi@.
--
-- -   Must be in Universal Coordinated Time (UTC).
--
-- -   Must not conflict with the preferred maintenance window.
--
-- -   Must be at least 30 minutes.
modifyDBCluster_preferredBackupWindow :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Text)
modifyDBCluster_preferredBackupWindow :: Lens' ModifyDBCluster (Maybe Text)
modifyDBCluster_preferredBackupWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Text
preferredBackupWindow :: Maybe Text
$sel:preferredBackupWindow:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
preferredBackupWindow} -> Maybe Text
preferredBackupWindow) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Text
a -> ModifyDBCluster
s {$sel:preferredBackupWindow:ModifyDBCluster' :: Maybe Text
preferredBackupWindow = Maybe Text
a} :: ModifyDBCluster)

-- | The weekly time range during which system maintenance can occur, in
-- Universal Coordinated Time (UTC).
--
-- Format: @ddd:hh24:mi-ddd:hh24:mi@
--
-- The default is a 30-minute window selected at random from an 8-hour
-- block of time for each Amazon Region, occurring on a random day of the
-- week.
--
-- Valid Days: Mon, Tue, Wed, Thu, Fri, Sat, Sun.
--
-- Constraints: Minimum 30-minute window.
modifyDBCluster_preferredMaintenanceWindow :: Lens.Lens' ModifyDBCluster (Prelude.Maybe Prelude.Text)
modifyDBCluster_preferredMaintenanceWindow :: Lens' ModifyDBCluster (Maybe Text)
modifyDBCluster_preferredMaintenanceWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe Text
preferredMaintenanceWindow :: Maybe Text
$sel:preferredMaintenanceWindow:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
preferredMaintenanceWindow} -> Maybe Text
preferredMaintenanceWindow) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe Text
a -> ModifyDBCluster
s {$sel:preferredMaintenanceWindow:ModifyDBCluster' :: Maybe Text
preferredMaintenanceWindow = Maybe Text
a} :: ModifyDBCluster)

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

-- | A list of VPC security groups that the DB cluster will belong to.
modifyDBCluster_vpcSecurityGroupIds :: Lens.Lens' ModifyDBCluster (Prelude.Maybe [Prelude.Text])
modifyDBCluster_vpcSecurityGroupIds :: Lens' ModifyDBCluster (Maybe [Text])
modifyDBCluster_vpcSecurityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Maybe [Text]
vpcSecurityGroupIds :: Maybe [Text]
$sel:vpcSecurityGroupIds:ModifyDBCluster' :: ModifyDBCluster -> Maybe [Text]
vpcSecurityGroupIds} -> Maybe [Text]
vpcSecurityGroupIds) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Maybe [Text]
a -> ModifyDBCluster
s {$sel:vpcSecurityGroupIds:ModifyDBCluster' :: Maybe [Text]
vpcSecurityGroupIds = Maybe [Text]
a} :: ModifyDBCluster) 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 DB cluster identifier for the cluster being modified. This parameter
-- is not case-sensitive.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DBCluster.
modifyDBCluster_dbClusterIdentifier :: Lens.Lens' ModifyDBCluster Prelude.Text
modifyDBCluster_dbClusterIdentifier :: Lens' ModifyDBCluster Text
modifyDBCluster_dbClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBCluster' {Text
dbClusterIdentifier :: Text
$sel:dbClusterIdentifier:ModifyDBCluster' :: ModifyDBCluster -> Text
dbClusterIdentifier} -> Text
dbClusterIdentifier) (\s :: ModifyDBCluster
s@ModifyDBCluster' {} Text
a -> ModifyDBCluster
s {$sel:dbClusterIdentifier:ModifyDBCluster' :: Text
dbClusterIdentifier = Text
a} :: ModifyDBCluster)

instance Core.AWSRequest ModifyDBCluster where
  type
    AWSResponse ModifyDBCluster =
      ModifyDBClusterResponse
  request :: (Service -> Service) -> ModifyDBCluster -> Request ModifyDBCluster
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 ModifyDBCluster
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ModifyDBCluster)))
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
"ModifyDBClusterResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBCluster -> Int -> ModifyDBClusterResponse
ModifyDBClusterResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DBCluster")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ModifyDBCluster where
  hashWithSalt :: Int -> ModifyDBCluster -> Int
hashWithSalt Int
_salt ModifyDBCluster' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Maybe CloudwatchLogsExportConfiguration
Maybe ServerlessV2ScalingConfiguration
Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
serverlessV2ScalingConfiguration :: Maybe ServerlessV2ScalingConfiguration
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
port :: Maybe Int
optionGroupName :: Maybe Text
newDBClusterIdentifier' :: Maybe Text
masterUserPassword :: Maybe Text
engineVersion :: Maybe Text
enableIAMDatabaseAuthentication :: Maybe Bool
deletionProtection :: Maybe Bool
dbInstanceParameterGroupName :: Maybe Text
dbClusterParameterGroupName :: Maybe Text
copyTagsToSnapshot :: Maybe Bool
cloudwatchLogsExportConfiguration :: Maybe CloudwatchLogsExportConfiguration
backupRetentionPeriod :: Maybe Int
applyImmediately :: Maybe Bool
allowMajorVersionUpgrade :: Maybe Bool
$sel:dbClusterIdentifier:ModifyDBCluster' :: ModifyDBCluster -> Text
$sel:vpcSecurityGroupIds:ModifyDBCluster' :: ModifyDBCluster -> Maybe [Text]
$sel:serverlessV2ScalingConfiguration:ModifyDBCluster' :: ModifyDBCluster -> Maybe ServerlessV2ScalingConfiguration
$sel:preferredMaintenanceWindow:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:preferredBackupWindow:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:port:ModifyDBCluster' :: ModifyDBCluster -> Maybe Int
$sel:optionGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:newDBClusterIdentifier':ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:masterUserPassword:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:engineVersion:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:enableIAMDatabaseAuthentication:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:deletionProtection:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:dbInstanceParameterGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:dbClusterParameterGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:copyTagsToSnapshot:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:cloudwatchLogsExportConfiguration:ModifyDBCluster' :: ModifyDBCluster -> Maybe CloudwatchLogsExportConfiguration
$sel:backupRetentionPeriod:ModifyDBCluster' :: ModifyDBCluster -> Maybe Int
$sel:applyImmediately:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:allowMajorVersionUpgrade:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
allowMajorVersionUpgrade
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
applyImmediately
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
backupRetentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CloudwatchLogsExportConfiguration
cloudwatchLogsExportConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
copyTagsToSnapshot
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbClusterParameterGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbInstanceParameterGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
deletionProtection
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableIAMDatabaseAuthentication
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
masterUserPassword
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
newDBClusterIdentifier'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
optionGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
port
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredBackupWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredMaintenanceWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
vpcSecurityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbClusterIdentifier

instance Prelude.NFData ModifyDBCluster where
  rnf :: ModifyDBCluster -> ()
rnf ModifyDBCluster' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Maybe CloudwatchLogsExportConfiguration
Maybe ServerlessV2ScalingConfiguration
Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
serverlessV2ScalingConfiguration :: Maybe ServerlessV2ScalingConfiguration
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
port :: Maybe Int
optionGroupName :: Maybe Text
newDBClusterIdentifier' :: Maybe Text
masterUserPassword :: Maybe Text
engineVersion :: Maybe Text
enableIAMDatabaseAuthentication :: Maybe Bool
deletionProtection :: Maybe Bool
dbInstanceParameterGroupName :: Maybe Text
dbClusterParameterGroupName :: Maybe Text
copyTagsToSnapshot :: Maybe Bool
cloudwatchLogsExportConfiguration :: Maybe CloudwatchLogsExportConfiguration
backupRetentionPeriod :: Maybe Int
applyImmediately :: Maybe Bool
allowMajorVersionUpgrade :: Maybe Bool
$sel:dbClusterIdentifier:ModifyDBCluster' :: ModifyDBCluster -> Text
$sel:vpcSecurityGroupIds:ModifyDBCluster' :: ModifyDBCluster -> Maybe [Text]
$sel:serverlessV2ScalingConfiguration:ModifyDBCluster' :: ModifyDBCluster -> Maybe ServerlessV2ScalingConfiguration
$sel:preferredMaintenanceWindow:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:preferredBackupWindow:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:port:ModifyDBCluster' :: ModifyDBCluster -> Maybe Int
$sel:optionGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:newDBClusterIdentifier':ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:masterUserPassword:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:engineVersion:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:enableIAMDatabaseAuthentication:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:deletionProtection:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:dbInstanceParameterGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:dbClusterParameterGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:copyTagsToSnapshot:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:cloudwatchLogsExportConfiguration:ModifyDBCluster' :: ModifyDBCluster -> Maybe CloudwatchLogsExportConfiguration
$sel:backupRetentionPeriod:ModifyDBCluster' :: ModifyDBCluster -> Maybe Int
$sel:applyImmediately:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:allowMajorVersionUpgrade:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
allowMajorVersionUpgrade
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
applyImmediately
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
backupRetentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CloudwatchLogsExportConfiguration
cloudwatchLogsExportConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
copyTagsToSnapshot
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbClusterParameterGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbInstanceParameterGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deletionProtection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableIAMDatabaseAuthentication
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
masterUserPassword
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
newDBClusterIdentifier'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
optionGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
port
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
preferredBackupWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
preferredMaintenanceWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
vpcSecurityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbClusterIdentifier

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

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

instance Data.ToQuery ModifyDBCluster where
  toQuery :: ModifyDBCluster -> QueryString
toQuery ModifyDBCluster' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe Text
Maybe CloudwatchLogsExportConfiguration
Maybe ServerlessV2ScalingConfiguration
Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
serverlessV2ScalingConfiguration :: Maybe ServerlessV2ScalingConfiguration
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
port :: Maybe Int
optionGroupName :: Maybe Text
newDBClusterIdentifier' :: Maybe Text
masterUserPassword :: Maybe Text
engineVersion :: Maybe Text
enableIAMDatabaseAuthentication :: Maybe Bool
deletionProtection :: Maybe Bool
dbInstanceParameterGroupName :: Maybe Text
dbClusterParameterGroupName :: Maybe Text
copyTagsToSnapshot :: Maybe Bool
cloudwatchLogsExportConfiguration :: Maybe CloudwatchLogsExportConfiguration
backupRetentionPeriod :: Maybe Int
applyImmediately :: Maybe Bool
allowMajorVersionUpgrade :: Maybe Bool
$sel:dbClusterIdentifier:ModifyDBCluster' :: ModifyDBCluster -> Text
$sel:vpcSecurityGroupIds:ModifyDBCluster' :: ModifyDBCluster -> Maybe [Text]
$sel:serverlessV2ScalingConfiguration:ModifyDBCluster' :: ModifyDBCluster -> Maybe ServerlessV2ScalingConfiguration
$sel:preferredMaintenanceWindow:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:preferredBackupWindow:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:port:ModifyDBCluster' :: ModifyDBCluster -> Maybe Int
$sel:optionGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:newDBClusterIdentifier':ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:masterUserPassword:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:engineVersion:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:enableIAMDatabaseAuthentication:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:deletionProtection:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:dbInstanceParameterGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:dbClusterParameterGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:copyTagsToSnapshot:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:cloudwatchLogsExportConfiguration:ModifyDBCluster' :: ModifyDBCluster -> Maybe CloudwatchLogsExportConfiguration
$sel:backupRetentionPeriod:ModifyDBCluster' :: ModifyDBCluster -> Maybe Int
$sel:applyImmediately:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:allowMajorVersionUpgrade:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyDBCluster" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"AllowMajorVersionUpgrade"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
allowMajorVersionUpgrade,
        ByteString
"ApplyImmediately" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
applyImmediately,
        ByteString
"BackupRetentionPeriod"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
backupRetentionPeriod,
        ByteString
"CloudwatchLogsExportConfiguration"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CloudwatchLogsExportConfiguration
cloudwatchLogsExportConfiguration,
        ByteString
"CopyTagsToSnapshot" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
copyTagsToSnapshot,
        ByteString
"DBClusterParameterGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbClusterParameterGroupName,
        ByteString
"DBInstanceParameterGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbInstanceParameterGroupName,
        ByteString
"DeletionProtection" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
deletionProtection,
        ByteString
"EnableIAMDatabaseAuthentication"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
enableIAMDatabaseAuthentication,
        ByteString
"EngineVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
engineVersion,
        ByteString
"MasterUserPassword" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
masterUserPassword,
        ByteString
"NewDBClusterIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
newDBClusterIdentifier',
        ByteString
"OptionGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
optionGroupName,
        ByteString
"Port" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
port,
        ByteString
"PreferredBackupWindow"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
preferredBackupWindow,
        ByteString
"PreferredMaintenanceWindow"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
preferredMaintenanceWindow,
        ByteString
"ServerlessV2ScalingConfiguration"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration,
        ByteString
"VpcSecurityGroupIds"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"VpcSecurityGroupId"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
vpcSecurityGroupIds
            ),
        ByteString
"DBClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbClusterIdentifier
      ]

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

-- |
-- Create a value of 'ModifyDBClusterResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'dbCluster', 'modifyDBClusterResponse_dbCluster' - Undocumented member.
--
-- 'httpStatus', 'modifyDBClusterResponse_httpStatus' - The response's http status code.
newModifyDBClusterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyDBClusterResponse
newModifyDBClusterResponse :: Int -> ModifyDBClusterResponse
newModifyDBClusterResponse Int
pHttpStatus_ =
  ModifyDBClusterResponse'
    { $sel:dbCluster:ModifyDBClusterResponse' :: Maybe DBCluster
dbCluster =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyDBClusterResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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