{-# 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.DocumentDB.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)
--
-- Modifies a setting for an Amazon DocumentDB cluster. You can change one
-- or more database configuration parameters by specifying these parameters
-- and the new values in the request.
module Amazonka.DocumentDB.ModifyDBCluster
  ( -- * Creating a Request
    ModifyDBCluster (..),
    newModifyDBCluster,

    -- * Request Lenses
    modifyDBCluster_applyImmediately,
    modifyDBCluster_backupRetentionPeriod,
    modifyDBCluster_cloudwatchLogsExportConfiguration,
    modifyDBCluster_dbClusterParameterGroupName,
    modifyDBCluster_deletionProtection,
    modifyDBCluster_engineVersion,
    modifyDBCluster_masterUserPassword,
    modifyDBCluster_newDBClusterIdentifier,
    modifyDBCluster_port,
    modifyDBCluster_preferredBackupWindow,
    modifyDBCluster_preferredMaintenanceWindow,
    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.DocumentDB.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Represents the input to ModifyDBCluster.
--
-- /See:/ 'newModifyDBCluster' smart constructor.
data ModifyDBCluster = ModifyDBCluster'
  { -- | A value that specifies whether the changes in this request and any
    -- pending changes are asynchronously applied as soon as possible,
    -- regardless of the @PreferredMaintenanceWindow@ setting for the cluster.
    -- If this parameter is set to @false@, changes to the cluster are applied
    -- during the next maintenance window.
    --
    -- The @ApplyImmediately@ parameter affects only the
    -- @NewDBClusterIdentifier@ and @MasterUserPassword@ values. If you set
    -- this parameter value to @false@, the changes to the
    -- @NewDBClusterIdentifier@ and @MasterUserPassword@ 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
    -- Amazon CloudWatch Logs for a specific instance or cluster. The
    -- @EnableLogTypes@ and @DisableLogTypes@ arrays determine which logs are
    -- exported (or not exported) to CloudWatch Logs.
    ModifyDBCluster -> Maybe CloudwatchLogsExportConfiguration
cloudwatchLogsExportConfiguration :: Prelude.Maybe CloudwatchLogsExportConfiguration,
    -- | The name of the cluster parameter group to use for the cluster.
    ModifyDBCluster -> Maybe Text
dbClusterParameterGroupName :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether this cluster can be deleted. If @DeletionProtection@
    -- is enabled, the cluster cannot be deleted unless it is modified and
    -- @DeletionProtection@ is disabled. @DeletionProtection@ protects clusters
    -- from being accidentally deleted.
    ModifyDBCluster -> Maybe Bool
deletionProtection :: Prelude.Maybe Prelude.Bool,
    -- | The version number of the database engine to which you want to upgrade.
    -- Modifying engine version is not supported on Amazon DocumentDB.
    ModifyDBCluster -> Maybe Text
engineVersion :: Prelude.Maybe Prelude.Text,
    -- | The password for the master database user. This password can contain any
    -- printable ASCII character except forward slash (\/), double quote (\"),
    -- or the \"at\" symbol (\@).
    --
    -- Constraints: Must contain from 8 to 100 characters.
    ModifyDBCluster -> Maybe Text
masterUserPassword :: Prelude.Maybe Prelude.Text,
    -- | The new cluster identifier for the cluster when renaming a 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,
    -- | The port number on which the cluster accepts connections.
    --
    -- Constraints: Must be a value from @1150@ to @65535@.
    --
    -- Default: The same port as the original 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 Web Services 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 Web Services 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,
    -- | A list of virtual private cloud (VPC) security groups that the cluster
    -- will belong to.
    ModifyDBCluster -> Maybe [Text]
vpcSecurityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The cluster identifier for the cluster that is 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:
--
-- 'applyImmediately', 'modifyDBCluster_applyImmediately' - A value that specifies whether the changes in this request and any
-- pending changes are asynchronously applied as soon as possible,
-- regardless of the @PreferredMaintenanceWindow@ setting for the cluster.
-- If this parameter is set to @false@, changes to the cluster are applied
-- during the next maintenance window.
--
-- The @ApplyImmediately@ parameter affects only the
-- @NewDBClusterIdentifier@ and @MasterUserPassword@ values. If you set
-- this parameter value to @false@, the changes to the
-- @NewDBClusterIdentifier@ and @MasterUserPassword@ 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
-- Amazon CloudWatch Logs for a specific instance or cluster. The
-- @EnableLogTypes@ and @DisableLogTypes@ arrays determine which logs are
-- exported (or not exported) to CloudWatch Logs.
--
-- 'dbClusterParameterGroupName', 'modifyDBCluster_dbClusterParameterGroupName' - The name of the cluster parameter group to use for the cluster.
--
-- 'deletionProtection', 'modifyDBCluster_deletionProtection' - Specifies whether this cluster can be deleted. If @DeletionProtection@
-- is enabled, the cluster cannot be deleted unless it is modified and
-- @DeletionProtection@ is disabled. @DeletionProtection@ protects clusters
-- from being accidentally deleted.
--
-- 'engineVersion', 'modifyDBCluster_engineVersion' - The version number of the database engine to which you want to upgrade.
-- Modifying engine version is not supported on Amazon DocumentDB.
--
-- 'masterUserPassword', 'modifyDBCluster_masterUserPassword' - The password for the master database user. This password can contain any
-- printable ASCII character except forward slash (\/), double quote (\"),
-- or the \"at\" symbol (\@).
--
-- Constraints: Must contain from 8 to 100 characters.
--
-- 'newDBClusterIdentifier'', 'modifyDBCluster_newDBClusterIdentifier' - The new cluster identifier for the cluster when renaming a 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@
--
-- 'port', 'modifyDBCluster_port' - The port number on which the cluster accepts connections.
--
-- Constraints: Must be a value from @1150@ to @65535@.
--
-- Default: The same port as the original 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 Web Services 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 Web Services Region, occurring on a random
-- day of the week.
--
-- Valid days: Mon, Tue, Wed, Thu, Fri, Sat, Sun
--
-- Constraints: Minimum 30-minute window.
--
-- 'vpcSecurityGroupIds', 'modifyDBCluster_vpcSecurityGroupIds' - A list of virtual private cloud (VPC) security groups that the cluster
-- will belong to.
--
-- 'dbClusterIdentifier', 'modifyDBCluster_dbClusterIdentifier' - The cluster identifier for the cluster that is 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: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:dbClusterParameterGroupName:ModifyDBCluster' :: Maybe Text
dbClusterParameterGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:deletionProtection:ModifyDBCluster' :: Maybe Bool
deletionProtection = 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: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:vpcSecurityGroupIds:ModifyDBCluster' :: Maybe [Text]
vpcSecurityGroupIds = forall a. Maybe a
Prelude.Nothing,
      $sel:dbClusterIdentifier:ModifyDBCluster' :: Text
dbClusterIdentifier = Text
pDBClusterIdentifier_
    }

-- | A value that specifies whether the changes in this request and any
-- pending changes are asynchronously applied as soon as possible,
-- regardless of the @PreferredMaintenanceWindow@ setting for the cluster.
-- If this parameter is set to @false@, changes to the cluster are applied
-- during the next maintenance window.
--
-- The @ApplyImmediately@ parameter affects only the
-- @NewDBClusterIdentifier@ and @MasterUserPassword@ values. If you set
-- this parameter value to @false@, the changes to the
-- @NewDBClusterIdentifier@ and @MasterUserPassword@ 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
-- Amazon CloudWatch Logs for a specific instance or cluster. The
-- @EnableLogTypes@ and @DisableLogTypes@ arrays determine which logs are
-- exported (or not exported) to CloudWatch Logs.
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)

-- | The name of the cluster parameter group to use for the 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)

-- | Specifies whether this cluster can be deleted. If @DeletionProtection@
-- is enabled, the cluster cannot be deleted unless it is modified and
-- @DeletionProtection@ is disabled. @DeletionProtection@ protects clusters
-- from being accidentally deleted.
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)

-- | The version number of the database engine to which you want to upgrade.
-- Modifying engine version is not supported on Amazon DocumentDB.
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)

-- | The password for the master database user. This password can contain any
-- printable ASCII character except forward slash (\/), double quote (\"),
-- or the \"at\" symbol (\@).
--
-- Constraints: Must contain from 8 to 100 characters.
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 cluster identifier for the cluster when renaming a 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)

-- | The port number on which the cluster accepts connections.
--
-- Constraints: Must be a value from @1150@ to @65535@.
--
-- Default: The same port as the original 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 Web Services 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 Web Services 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)

-- | A list of virtual private cloud (VPC) security groups that the 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 cluster identifier for the cluster that is 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
Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
port :: Maybe Int
newDBClusterIdentifier' :: Maybe Text
masterUserPassword :: Maybe Text
engineVersion :: Maybe Text
deletionProtection :: Maybe Bool
dbClusterParameterGroupName :: Maybe Text
cloudwatchLogsExportConfiguration :: Maybe CloudwatchLogsExportConfiguration
backupRetentionPeriod :: Maybe Int
applyImmediately :: Maybe Bool
$sel:dbClusterIdentifier:ModifyDBCluster' :: ModifyDBCluster -> Text
$sel:vpcSecurityGroupIds:ModifyDBCluster' :: ModifyDBCluster -> Maybe [Text]
$sel:preferredMaintenanceWindow:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:preferredBackupWindow:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:port:ModifyDBCluster' :: ModifyDBCluster -> Maybe Int
$sel:newDBClusterIdentifier':ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:masterUserPassword:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:engineVersion:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:deletionProtection:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:dbClusterParameterGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:cloudwatchLogsExportConfiguration:ModifyDBCluster' :: ModifyDBCluster -> Maybe CloudwatchLogsExportConfiguration
$sel:backupRetentionPeriod:ModifyDBCluster' :: ModifyDBCluster -> Maybe Int
$sel:applyImmediately:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
..} =
    Int
_salt
      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 Text
dbClusterParameterGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
deletionProtection
      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 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 [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
Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
port :: Maybe Int
newDBClusterIdentifier' :: Maybe Text
masterUserPassword :: Maybe Text
engineVersion :: Maybe Text
deletionProtection :: Maybe Bool
dbClusterParameterGroupName :: Maybe Text
cloudwatchLogsExportConfiguration :: Maybe CloudwatchLogsExportConfiguration
backupRetentionPeriod :: Maybe Int
applyImmediately :: Maybe Bool
$sel:dbClusterIdentifier:ModifyDBCluster' :: ModifyDBCluster -> Text
$sel:vpcSecurityGroupIds:ModifyDBCluster' :: ModifyDBCluster -> Maybe [Text]
$sel:preferredMaintenanceWindow:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:preferredBackupWindow:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:port:ModifyDBCluster' :: ModifyDBCluster -> Maybe Int
$sel:newDBClusterIdentifier':ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:masterUserPassword:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:engineVersion:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:deletionProtection:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:dbClusterParameterGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:cloudwatchLogsExportConfiguration:ModifyDBCluster' :: ModifyDBCluster -> Maybe CloudwatchLogsExportConfiguration
$sel:backupRetentionPeriod:ModifyDBCluster' :: ModifyDBCluster -> Maybe Int
$sel:applyImmediately:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
..} =
    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 Text
dbClusterParameterGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deletionProtection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
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 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 [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
Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
port :: Maybe Int
newDBClusterIdentifier' :: Maybe Text
masterUserPassword :: Maybe Text
engineVersion :: Maybe Text
deletionProtection :: Maybe Bool
dbClusterParameterGroupName :: Maybe Text
cloudwatchLogsExportConfiguration :: Maybe CloudwatchLogsExportConfiguration
backupRetentionPeriod :: Maybe Int
applyImmediately :: Maybe Bool
$sel:dbClusterIdentifier:ModifyDBCluster' :: ModifyDBCluster -> Text
$sel:vpcSecurityGroupIds:ModifyDBCluster' :: ModifyDBCluster -> Maybe [Text]
$sel:preferredMaintenanceWindow:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:preferredBackupWindow:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:port:ModifyDBCluster' :: ModifyDBCluster -> Maybe Int
$sel:newDBClusterIdentifier':ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:masterUserPassword:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:engineVersion:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:deletionProtection:ModifyDBCluster' :: ModifyDBCluster -> Maybe Bool
$sel:dbClusterParameterGroupName:ModifyDBCluster' :: ModifyDBCluster -> Maybe Text
$sel:cloudwatchLogsExportConfiguration:ModifyDBCluster' :: ModifyDBCluster -> Maybe CloudwatchLogsExportConfiguration
$sel:backupRetentionPeriod:ModifyDBCluster' :: ModifyDBCluster -> Maybe Int
$sel:applyImmediately: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
"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
"DBClusterParameterGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbClusterParameterGroupName,
        ByteString
"DeletionProtection" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
deletionProtection,
        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
"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
"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