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

    -- * Request Lenses
    modifyDBInstance_applyImmediately,
    modifyDBInstance_autoMinorVersionUpgrade,
    modifyDBInstance_cACertificateIdentifier,
    modifyDBInstance_copyTagsToSnapshot,
    modifyDBInstance_dbInstanceClass,
    modifyDBInstance_enablePerformanceInsights,
    modifyDBInstance_newDBInstanceIdentifier,
    modifyDBInstance_performanceInsightsKMSKeyId,
    modifyDBInstance_preferredMaintenanceWindow,
    modifyDBInstance_promotionTier,
    modifyDBInstance_dbInstanceIdentifier,

    -- * Destructuring the Response
    ModifyDBInstanceResponse (..),
    newModifyDBInstanceResponse,

    -- * Response Lenses
    modifyDBInstanceResponse_dbInstance,
    modifyDBInstanceResponse_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 ModifyDBInstance.
--
-- /See:/ 'newModifyDBInstance' smart constructor.
data ModifyDBInstance = ModifyDBInstance'
  { -- | 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 instance.
    --
    -- If this parameter is set to @false@, changes to the instance are applied
    -- during the next maintenance window. Some parameter changes can cause an
    -- outage and are applied on the next reboot.
    --
    -- Default: @false@
    ModifyDBInstance -> Maybe Bool
applyImmediately :: Prelude.Maybe Prelude.Bool,
    -- | This parameter does not apply to Amazon DocumentDB. Amazon DocumentDB
    -- does not perform minor version upgrades regardless of the value set.
    ModifyDBInstance -> Maybe Bool
autoMinorVersionUpgrade :: Prelude.Maybe Prelude.Bool,
    -- | Indicates the certificate that needs to be associated with the instance.
    ModifyDBInstance -> Maybe Text
cACertificateIdentifier :: Prelude.Maybe Prelude.Text,
    -- | A value that indicates whether to copy all tags from the DB instance to
    -- snapshots of the DB instance. By default, tags are not copied.
    ModifyDBInstance -> Maybe Bool
copyTagsToSnapshot :: Prelude.Maybe Prelude.Bool,
    -- | The new compute and memory capacity of the instance; for example,
    -- @db.r5.large@. Not all instance classes are available in all Amazon Web
    -- Services Regions.
    --
    -- If you modify the instance class, an outage occurs during the change.
    -- The change is applied during the next maintenance window, unless
    -- @ApplyImmediately@ is specified as @true@ for this request.
    --
    -- Default: Uses existing setting.
    ModifyDBInstance -> Maybe Text
dbInstanceClass :: Prelude.Maybe Prelude.Text,
    -- | A value that indicates whether to enable Performance Insights for the DB
    -- Instance. For more information, see
    -- <https://docs.aws.amazon.com/documentdb/latest/developerguide/performance-insights.html Using Amazon Performance Insights>.
    ModifyDBInstance -> Maybe Bool
enablePerformanceInsights :: Prelude.Maybe Prelude.Bool,
    -- | The new instance identifier for the instance when renaming an instance.
    -- When you change the instance identifier, an instance reboot occurs
    -- immediately if you set @Apply Immediately@ to @true@. It occurs during
    -- the next maintenance window if you set @Apply Immediately@ to @false@.
    -- 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: @mydbinstance@
    ModifyDBInstance -> Maybe Text
newDBInstanceIdentifier' :: Prelude.Maybe Prelude.Text,
    -- | The KMS key identifier for encryption of Performance Insights data.
    --
    -- The KMS key identifier is the key ARN, key ID, alias ARN, or alias name
    -- for the KMS key.
    --
    -- If you do not specify a value for PerformanceInsightsKMSKeyId, then
    -- Amazon DocumentDB uses your default KMS key. There is a default KMS key
    -- for your Amazon Web Services account. Your Amazon Web Services account
    -- has a different default KMS key for each Amazon Web Services region.
    ModifyDBInstance -> Maybe Text
performanceInsightsKMSKeyId :: Prelude.Maybe Prelude.Text,
    -- | The weekly time range (in UTC) during which system maintenance can
    -- occur, which might result in an outage. Changing this parameter doesn\'t
    -- result in an outage except in the following situation, and the change is
    -- asynchronously applied as soon as possible. If there are pending actions
    -- that cause a reboot, and the maintenance window is changed to include
    -- the current time, changing this parameter causes a reboot of the
    -- instance. If you are moving this window to the current time, there must
    -- be at least 30 minutes between the current time and end of the window to
    -- ensure that pending changes are applied.
    --
    -- Default: Uses existing setting.
    --
    -- Format: @ddd:hh24:mi-ddd:hh24:mi@
    --
    -- Valid days: Mon, Tue, Wed, Thu, Fri, Sat, Sun
    --
    -- Constraints: Must be at least 30 minutes.
    ModifyDBInstance -> Maybe Text
preferredMaintenanceWindow :: Prelude.Maybe Prelude.Text,
    -- | A value that specifies the order in which an Amazon DocumentDB replica
    -- is promoted to the primary instance after a failure of the existing
    -- primary instance.
    --
    -- Default: 1
    --
    -- Valid values: 0-15
    ModifyDBInstance -> Maybe Int
promotionTier :: Prelude.Maybe Prelude.Int,
    -- | The instance identifier. This value is stored as a lowercase string.
    --
    -- Constraints:
    --
    -- -   Must match the identifier of an existing @DBInstance@.
    ModifyDBInstance -> Text
dbInstanceIdentifier :: Prelude.Text
  }
  deriving (ModifyDBInstance -> ModifyDBInstance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyDBInstance -> ModifyDBInstance -> Bool
$c/= :: ModifyDBInstance -> ModifyDBInstance -> Bool
== :: ModifyDBInstance -> ModifyDBInstance -> Bool
$c== :: ModifyDBInstance -> ModifyDBInstance -> Bool
Prelude.Eq, ReadPrec [ModifyDBInstance]
ReadPrec ModifyDBInstance
Int -> ReadS ModifyDBInstance
ReadS [ModifyDBInstance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyDBInstance]
$creadListPrec :: ReadPrec [ModifyDBInstance]
readPrec :: ReadPrec ModifyDBInstance
$creadPrec :: ReadPrec ModifyDBInstance
readList :: ReadS [ModifyDBInstance]
$creadList :: ReadS [ModifyDBInstance]
readsPrec :: Int -> ReadS ModifyDBInstance
$creadsPrec :: Int -> ReadS ModifyDBInstance
Prelude.Read, Int -> ModifyDBInstance -> ShowS
[ModifyDBInstance] -> ShowS
ModifyDBInstance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyDBInstance] -> ShowS
$cshowList :: [ModifyDBInstance] -> ShowS
show :: ModifyDBInstance -> String
$cshow :: ModifyDBInstance -> String
showsPrec :: Int -> ModifyDBInstance -> ShowS
$cshowsPrec :: Int -> ModifyDBInstance -> ShowS
Prelude.Show, forall x. Rep ModifyDBInstance x -> ModifyDBInstance
forall x. ModifyDBInstance -> Rep ModifyDBInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyDBInstance x -> ModifyDBInstance
$cfrom :: forall x. ModifyDBInstance -> Rep ModifyDBInstance x
Prelude.Generic)

-- |
-- Create a value of 'ModifyDBInstance' 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', 'modifyDBInstance_applyImmediately' - 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 instance.
--
-- If this parameter is set to @false@, changes to the instance are applied
-- during the next maintenance window. Some parameter changes can cause an
-- outage and are applied on the next reboot.
--
-- Default: @false@
--
-- 'autoMinorVersionUpgrade', 'modifyDBInstance_autoMinorVersionUpgrade' - This parameter does not apply to Amazon DocumentDB. Amazon DocumentDB
-- does not perform minor version upgrades regardless of the value set.
--
-- 'cACertificateIdentifier', 'modifyDBInstance_cACertificateIdentifier' - Indicates the certificate that needs to be associated with the instance.
--
-- 'copyTagsToSnapshot', 'modifyDBInstance_copyTagsToSnapshot' - A value that indicates whether to copy all tags from the DB instance to
-- snapshots of the DB instance. By default, tags are not copied.
--
-- 'dbInstanceClass', 'modifyDBInstance_dbInstanceClass' - The new compute and memory capacity of the instance; for example,
-- @db.r5.large@. Not all instance classes are available in all Amazon Web
-- Services Regions.
--
-- If you modify the instance class, an outage occurs during the change.
-- The change is applied during the next maintenance window, unless
-- @ApplyImmediately@ is specified as @true@ for this request.
--
-- Default: Uses existing setting.
--
-- 'enablePerformanceInsights', 'modifyDBInstance_enablePerformanceInsights' - A value that indicates whether to enable Performance Insights for the DB
-- Instance. For more information, see
-- <https://docs.aws.amazon.com/documentdb/latest/developerguide/performance-insights.html Using Amazon Performance Insights>.
--
-- 'newDBInstanceIdentifier'', 'modifyDBInstance_newDBInstanceIdentifier' - The new instance identifier for the instance when renaming an instance.
-- When you change the instance identifier, an instance reboot occurs
-- immediately if you set @Apply Immediately@ to @true@. It occurs during
-- the next maintenance window if you set @Apply Immediately@ to @false@.
-- 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: @mydbinstance@
--
-- 'performanceInsightsKMSKeyId', 'modifyDBInstance_performanceInsightsKMSKeyId' - The KMS key identifier for encryption of Performance Insights data.
--
-- The KMS key identifier is the key ARN, key ID, alias ARN, or alias name
-- for the KMS key.
--
-- If you do not specify a value for PerformanceInsightsKMSKeyId, then
-- Amazon DocumentDB uses your default KMS key. There is a default KMS key
-- for your Amazon Web Services account. Your Amazon Web Services account
-- has a different default KMS key for each Amazon Web Services region.
--
-- 'preferredMaintenanceWindow', 'modifyDBInstance_preferredMaintenanceWindow' - The weekly time range (in UTC) during which system maintenance can
-- occur, which might result in an outage. Changing this parameter doesn\'t
-- result in an outage except in the following situation, and the change is
-- asynchronously applied as soon as possible. If there are pending actions
-- that cause a reboot, and the maintenance window is changed to include
-- the current time, changing this parameter causes a reboot of the
-- instance. If you are moving this window to the current time, there must
-- be at least 30 minutes between the current time and end of the window to
-- ensure that pending changes are applied.
--
-- Default: Uses existing setting.
--
-- Format: @ddd:hh24:mi-ddd:hh24:mi@
--
-- Valid days: Mon, Tue, Wed, Thu, Fri, Sat, Sun
--
-- Constraints: Must be at least 30 minutes.
--
-- 'promotionTier', 'modifyDBInstance_promotionTier' - A value that specifies the order in which an Amazon DocumentDB replica
-- is promoted to the primary instance after a failure of the existing
-- primary instance.
--
-- Default: 1
--
-- Valid values: 0-15
--
-- 'dbInstanceIdentifier', 'modifyDBInstance_dbInstanceIdentifier' - The instance identifier. This value is stored as a lowercase string.
--
-- Constraints:
--
-- -   Must match the identifier of an existing @DBInstance@.
newModifyDBInstance ::
  -- | 'dbInstanceIdentifier'
  Prelude.Text ->
  ModifyDBInstance
newModifyDBInstance :: Text -> ModifyDBInstance
newModifyDBInstance Text
pDBInstanceIdentifier_ =
  ModifyDBInstance'
    { $sel:applyImmediately:ModifyDBInstance' :: Maybe Bool
applyImmediately =
        forall a. Maybe a
Prelude.Nothing,
      $sel:autoMinorVersionUpgrade:ModifyDBInstance' :: Maybe Bool
autoMinorVersionUpgrade = forall a. Maybe a
Prelude.Nothing,
      $sel:cACertificateIdentifier:ModifyDBInstance' :: Maybe Text
cACertificateIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:copyTagsToSnapshot:ModifyDBInstance' :: Maybe Bool
copyTagsToSnapshot = forall a. Maybe a
Prelude.Nothing,
      $sel:dbInstanceClass:ModifyDBInstance' :: Maybe Text
dbInstanceClass = forall a. Maybe a
Prelude.Nothing,
      $sel:enablePerformanceInsights:ModifyDBInstance' :: Maybe Bool
enablePerformanceInsights = forall a. Maybe a
Prelude.Nothing,
      $sel:newDBInstanceIdentifier':ModifyDBInstance' :: Maybe Text
newDBInstanceIdentifier' = forall a. Maybe a
Prelude.Nothing,
      $sel:performanceInsightsKMSKeyId:ModifyDBInstance' :: Maybe Text
performanceInsightsKMSKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredMaintenanceWindow:ModifyDBInstance' :: Maybe Text
preferredMaintenanceWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:promotionTier:ModifyDBInstance' :: Maybe Int
promotionTier = forall a. Maybe a
Prelude.Nothing,
      $sel:dbInstanceIdentifier:ModifyDBInstance' :: Text
dbInstanceIdentifier = Text
pDBInstanceIdentifier_
    }

-- | 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 instance.
--
-- If this parameter is set to @false@, changes to the instance are applied
-- during the next maintenance window. Some parameter changes can cause an
-- outage and are applied on the next reboot.
--
-- Default: @false@
modifyDBInstance_applyImmediately :: Lens.Lens' ModifyDBInstance (Prelude.Maybe Prelude.Bool)
modifyDBInstance_applyImmediately :: Lens' ModifyDBInstance (Maybe Bool)
modifyDBInstance_applyImmediately = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBInstance' {Maybe Bool
applyImmediately :: Maybe Bool
$sel:applyImmediately:ModifyDBInstance' :: ModifyDBInstance -> Maybe Bool
applyImmediately} -> Maybe Bool
applyImmediately) (\s :: ModifyDBInstance
s@ModifyDBInstance' {} Maybe Bool
a -> ModifyDBInstance
s {$sel:applyImmediately:ModifyDBInstance' :: Maybe Bool
applyImmediately = Maybe Bool
a} :: ModifyDBInstance)

-- | This parameter does not apply to Amazon DocumentDB. Amazon DocumentDB
-- does not perform minor version upgrades regardless of the value set.
modifyDBInstance_autoMinorVersionUpgrade :: Lens.Lens' ModifyDBInstance (Prelude.Maybe Prelude.Bool)
modifyDBInstance_autoMinorVersionUpgrade :: Lens' ModifyDBInstance (Maybe Bool)
modifyDBInstance_autoMinorVersionUpgrade = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBInstance' {Maybe Bool
autoMinorVersionUpgrade :: Maybe Bool
$sel:autoMinorVersionUpgrade:ModifyDBInstance' :: ModifyDBInstance -> Maybe Bool
autoMinorVersionUpgrade} -> Maybe Bool
autoMinorVersionUpgrade) (\s :: ModifyDBInstance
s@ModifyDBInstance' {} Maybe Bool
a -> ModifyDBInstance
s {$sel:autoMinorVersionUpgrade:ModifyDBInstance' :: Maybe Bool
autoMinorVersionUpgrade = Maybe Bool
a} :: ModifyDBInstance)

-- | Indicates the certificate that needs to be associated with the instance.
modifyDBInstance_cACertificateIdentifier :: Lens.Lens' ModifyDBInstance (Prelude.Maybe Prelude.Text)
modifyDBInstance_cACertificateIdentifier :: Lens' ModifyDBInstance (Maybe Text)
modifyDBInstance_cACertificateIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBInstance' {Maybe Text
cACertificateIdentifier :: Maybe Text
$sel:cACertificateIdentifier:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
cACertificateIdentifier} -> Maybe Text
cACertificateIdentifier) (\s :: ModifyDBInstance
s@ModifyDBInstance' {} Maybe Text
a -> ModifyDBInstance
s {$sel:cACertificateIdentifier:ModifyDBInstance' :: Maybe Text
cACertificateIdentifier = Maybe Text
a} :: ModifyDBInstance)

-- | A value that indicates whether to copy all tags from the DB instance to
-- snapshots of the DB instance. By default, tags are not copied.
modifyDBInstance_copyTagsToSnapshot :: Lens.Lens' ModifyDBInstance (Prelude.Maybe Prelude.Bool)
modifyDBInstance_copyTagsToSnapshot :: Lens' ModifyDBInstance (Maybe Bool)
modifyDBInstance_copyTagsToSnapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBInstance' {Maybe Bool
copyTagsToSnapshot :: Maybe Bool
$sel:copyTagsToSnapshot:ModifyDBInstance' :: ModifyDBInstance -> Maybe Bool
copyTagsToSnapshot} -> Maybe Bool
copyTagsToSnapshot) (\s :: ModifyDBInstance
s@ModifyDBInstance' {} Maybe Bool
a -> ModifyDBInstance
s {$sel:copyTagsToSnapshot:ModifyDBInstance' :: Maybe Bool
copyTagsToSnapshot = Maybe Bool
a} :: ModifyDBInstance)

-- | The new compute and memory capacity of the instance; for example,
-- @db.r5.large@. Not all instance classes are available in all Amazon Web
-- Services Regions.
--
-- If you modify the instance class, an outage occurs during the change.
-- The change is applied during the next maintenance window, unless
-- @ApplyImmediately@ is specified as @true@ for this request.
--
-- Default: Uses existing setting.
modifyDBInstance_dbInstanceClass :: Lens.Lens' ModifyDBInstance (Prelude.Maybe Prelude.Text)
modifyDBInstance_dbInstanceClass :: Lens' ModifyDBInstance (Maybe Text)
modifyDBInstance_dbInstanceClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBInstance' {Maybe Text
dbInstanceClass :: Maybe Text
$sel:dbInstanceClass:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
dbInstanceClass} -> Maybe Text
dbInstanceClass) (\s :: ModifyDBInstance
s@ModifyDBInstance' {} Maybe Text
a -> ModifyDBInstance
s {$sel:dbInstanceClass:ModifyDBInstance' :: Maybe Text
dbInstanceClass = Maybe Text
a} :: ModifyDBInstance)

-- | A value that indicates whether to enable Performance Insights for the DB
-- Instance. For more information, see
-- <https://docs.aws.amazon.com/documentdb/latest/developerguide/performance-insights.html Using Amazon Performance Insights>.
modifyDBInstance_enablePerformanceInsights :: Lens.Lens' ModifyDBInstance (Prelude.Maybe Prelude.Bool)
modifyDBInstance_enablePerformanceInsights :: Lens' ModifyDBInstance (Maybe Bool)
modifyDBInstance_enablePerformanceInsights = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBInstance' {Maybe Bool
enablePerformanceInsights :: Maybe Bool
$sel:enablePerformanceInsights:ModifyDBInstance' :: ModifyDBInstance -> Maybe Bool
enablePerformanceInsights} -> Maybe Bool
enablePerformanceInsights) (\s :: ModifyDBInstance
s@ModifyDBInstance' {} Maybe Bool
a -> ModifyDBInstance
s {$sel:enablePerformanceInsights:ModifyDBInstance' :: Maybe Bool
enablePerformanceInsights = Maybe Bool
a} :: ModifyDBInstance)

-- | The new instance identifier for the instance when renaming an instance.
-- When you change the instance identifier, an instance reboot occurs
-- immediately if you set @Apply Immediately@ to @true@. It occurs during
-- the next maintenance window if you set @Apply Immediately@ to @false@.
-- 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: @mydbinstance@
modifyDBInstance_newDBInstanceIdentifier :: Lens.Lens' ModifyDBInstance (Prelude.Maybe Prelude.Text)
modifyDBInstance_newDBInstanceIdentifier :: Lens' ModifyDBInstance (Maybe Text)
modifyDBInstance_newDBInstanceIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBInstance' {Maybe Text
newDBInstanceIdentifier' :: Maybe Text
$sel:newDBInstanceIdentifier':ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
newDBInstanceIdentifier'} -> Maybe Text
newDBInstanceIdentifier') (\s :: ModifyDBInstance
s@ModifyDBInstance' {} Maybe Text
a -> ModifyDBInstance
s {$sel:newDBInstanceIdentifier':ModifyDBInstance' :: Maybe Text
newDBInstanceIdentifier' = Maybe Text
a} :: ModifyDBInstance)

-- | The KMS key identifier for encryption of Performance Insights data.
--
-- The KMS key identifier is the key ARN, key ID, alias ARN, or alias name
-- for the KMS key.
--
-- If you do not specify a value for PerformanceInsightsKMSKeyId, then
-- Amazon DocumentDB uses your default KMS key. There is a default KMS key
-- for your Amazon Web Services account. Your Amazon Web Services account
-- has a different default KMS key for each Amazon Web Services region.
modifyDBInstance_performanceInsightsKMSKeyId :: Lens.Lens' ModifyDBInstance (Prelude.Maybe Prelude.Text)
modifyDBInstance_performanceInsightsKMSKeyId :: Lens' ModifyDBInstance (Maybe Text)
modifyDBInstance_performanceInsightsKMSKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBInstance' {Maybe Text
performanceInsightsKMSKeyId :: Maybe Text
$sel:performanceInsightsKMSKeyId:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
performanceInsightsKMSKeyId} -> Maybe Text
performanceInsightsKMSKeyId) (\s :: ModifyDBInstance
s@ModifyDBInstance' {} Maybe Text
a -> ModifyDBInstance
s {$sel:performanceInsightsKMSKeyId:ModifyDBInstance' :: Maybe Text
performanceInsightsKMSKeyId = Maybe Text
a} :: ModifyDBInstance)

-- | The weekly time range (in UTC) during which system maintenance can
-- occur, which might result in an outage. Changing this parameter doesn\'t
-- result in an outage except in the following situation, and the change is
-- asynchronously applied as soon as possible. If there are pending actions
-- that cause a reboot, and the maintenance window is changed to include
-- the current time, changing this parameter causes a reboot of the
-- instance. If you are moving this window to the current time, there must
-- be at least 30 minutes between the current time and end of the window to
-- ensure that pending changes are applied.
--
-- Default: Uses existing setting.
--
-- Format: @ddd:hh24:mi-ddd:hh24:mi@
--
-- Valid days: Mon, Tue, Wed, Thu, Fri, Sat, Sun
--
-- Constraints: Must be at least 30 minutes.
modifyDBInstance_preferredMaintenanceWindow :: Lens.Lens' ModifyDBInstance (Prelude.Maybe Prelude.Text)
modifyDBInstance_preferredMaintenanceWindow :: Lens' ModifyDBInstance (Maybe Text)
modifyDBInstance_preferredMaintenanceWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBInstance' {Maybe Text
preferredMaintenanceWindow :: Maybe Text
$sel:preferredMaintenanceWindow:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
preferredMaintenanceWindow} -> Maybe Text
preferredMaintenanceWindow) (\s :: ModifyDBInstance
s@ModifyDBInstance' {} Maybe Text
a -> ModifyDBInstance
s {$sel:preferredMaintenanceWindow:ModifyDBInstance' :: Maybe Text
preferredMaintenanceWindow = Maybe Text
a} :: ModifyDBInstance)

-- | A value that specifies the order in which an Amazon DocumentDB replica
-- is promoted to the primary instance after a failure of the existing
-- primary instance.
--
-- Default: 1
--
-- Valid values: 0-15
modifyDBInstance_promotionTier :: Lens.Lens' ModifyDBInstance (Prelude.Maybe Prelude.Int)
modifyDBInstance_promotionTier :: Lens' ModifyDBInstance (Maybe Int)
modifyDBInstance_promotionTier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBInstance' {Maybe Int
promotionTier :: Maybe Int
$sel:promotionTier:ModifyDBInstance' :: ModifyDBInstance -> Maybe Int
promotionTier} -> Maybe Int
promotionTier) (\s :: ModifyDBInstance
s@ModifyDBInstance' {} Maybe Int
a -> ModifyDBInstance
s {$sel:promotionTier:ModifyDBInstance' :: Maybe Int
promotionTier = Maybe Int
a} :: ModifyDBInstance)

-- | The instance identifier. This value is stored as a lowercase string.
--
-- Constraints:
--
-- -   Must match the identifier of an existing @DBInstance@.
modifyDBInstance_dbInstanceIdentifier :: Lens.Lens' ModifyDBInstance Prelude.Text
modifyDBInstance_dbInstanceIdentifier :: Lens' ModifyDBInstance Text
modifyDBInstance_dbInstanceIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBInstance' {Text
dbInstanceIdentifier :: Text
$sel:dbInstanceIdentifier:ModifyDBInstance' :: ModifyDBInstance -> Text
dbInstanceIdentifier} -> Text
dbInstanceIdentifier) (\s :: ModifyDBInstance
s@ModifyDBInstance' {} Text
a -> ModifyDBInstance
s {$sel:dbInstanceIdentifier:ModifyDBInstance' :: Text
dbInstanceIdentifier = Text
a} :: ModifyDBInstance)

instance Core.AWSRequest ModifyDBInstance where
  type
    AWSResponse ModifyDBInstance =
      ModifyDBInstanceResponse
  request :: (Service -> Service)
-> ModifyDBInstance -> Request ModifyDBInstance
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 ModifyDBInstance
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ModifyDBInstance)))
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
"ModifyDBInstanceResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBInstance -> Int -> ModifyDBInstanceResponse
ModifyDBInstanceResponse'
            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
"DBInstance")
            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 ModifyDBInstance where
  hashWithSalt :: Int -> ModifyDBInstance -> Int
hashWithSalt Int
_salt ModifyDBInstance' {Maybe Bool
Maybe Int
Maybe Text
Text
dbInstanceIdentifier :: Text
promotionTier :: Maybe Int
preferredMaintenanceWindow :: Maybe Text
performanceInsightsKMSKeyId :: Maybe Text
newDBInstanceIdentifier' :: Maybe Text
enablePerformanceInsights :: Maybe Bool
dbInstanceClass :: Maybe Text
copyTagsToSnapshot :: Maybe Bool
cACertificateIdentifier :: Maybe Text
autoMinorVersionUpgrade :: Maybe Bool
applyImmediately :: Maybe Bool
$sel:dbInstanceIdentifier:ModifyDBInstance' :: ModifyDBInstance -> Text
$sel:promotionTier:ModifyDBInstance' :: ModifyDBInstance -> Maybe Int
$sel:preferredMaintenanceWindow:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:performanceInsightsKMSKeyId:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:newDBInstanceIdentifier':ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:enablePerformanceInsights:ModifyDBInstance' :: ModifyDBInstance -> Maybe Bool
$sel:dbInstanceClass:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:copyTagsToSnapshot:ModifyDBInstance' :: ModifyDBInstance -> Maybe Bool
$sel:cACertificateIdentifier:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:autoMinorVersionUpgrade:ModifyDBInstance' :: ModifyDBInstance -> Maybe Bool
$sel:applyImmediately:ModifyDBInstance' :: ModifyDBInstance -> 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 Bool
autoMinorVersionUpgrade
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cACertificateIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
copyTagsToSnapshot
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbInstanceClass
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enablePerformanceInsights
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
newDBInstanceIdentifier'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
performanceInsightsKMSKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredMaintenanceWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
promotionTier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbInstanceIdentifier

instance Prelude.NFData ModifyDBInstance where
  rnf :: ModifyDBInstance -> ()
rnf ModifyDBInstance' {Maybe Bool
Maybe Int
Maybe Text
Text
dbInstanceIdentifier :: Text
promotionTier :: Maybe Int
preferredMaintenanceWindow :: Maybe Text
performanceInsightsKMSKeyId :: Maybe Text
newDBInstanceIdentifier' :: Maybe Text
enablePerformanceInsights :: Maybe Bool
dbInstanceClass :: Maybe Text
copyTagsToSnapshot :: Maybe Bool
cACertificateIdentifier :: Maybe Text
autoMinorVersionUpgrade :: Maybe Bool
applyImmediately :: Maybe Bool
$sel:dbInstanceIdentifier:ModifyDBInstance' :: ModifyDBInstance -> Text
$sel:promotionTier:ModifyDBInstance' :: ModifyDBInstance -> Maybe Int
$sel:preferredMaintenanceWindow:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:performanceInsightsKMSKeyId:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:newDBInstanceIdentifier':ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:enablePerformanceInsights:ModifyDBInstance' :: ModifyDBInstance -> Maybe Bool
$sel:dbInstanceClass:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:copyTagsToSnapshot:ModifyDBInstance' :: ModifyDBInstance -> Maybe Bool
$sel:cACertificateIdentifier:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:autoMinorVersionUpgrade:ModifyDBInstance' :: ModifyDBInstance -> Maybe Bool
$sel:applyImmediately:ModifyDBInstance' :: ModifyDBInstance -> 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 Bool
autoMinorVersionUpgrade
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cACertificateIdentifier
      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
dbInstanceClass
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enablePerformanceInsights
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
newDBInstanceIdentifier'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
performanceInsightsKMSKeyId
      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 Int
promotionTier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbInstanceIdentifier

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

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

instance Data.ToQuery ModifyDBInstance where
  toQuery :: ModifyDBInstance -> QueryString
toQuery ModifyDBInstance' {Maybe Bool
Maybe Int
Maybe Text
Text
dbInstanceIdentifier :: Text
promotionTier :: Maybe Int
preferredMaintenanceWindow :: Maybe Text
performanceInsightsKMSKeyId :: Maybe Text
newDBInstanceIdentifier' :: Maybe Text
enablePerformanceInsights :: Maybe Bool
dbInstanceClass :: Maybe Text
copyTagsToSnapshot :: Maybe Bool
cACertificateIdentifier :: Maybe Text
autoMinorVersionUpgrade :: Maybe Bool
applyImmediately :: Maybe Bool
$sel:dbInstanceIdentifier:ModifyDBInstance' :: ModifyDBInstance -> Text
$sel:promotionTier:ModifyDBInstance' :: ModifyDBInstance -> Maybe Int
$sel:preferredMaintenanceWindow:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:performanceInsightsKMSKeyId:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:newDBInstanceIdentifier':ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:enablePerformanceInsights:ModifyDBInstance' :: ModifyDBInstance -> Maybe Bool
$sel:dbInstanceClass:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:copyTagsToSnapshot:ModifyDBInstance' :: ModifyDBInstance -> Maybe Bool
$sel:cACertificateIdentifier:ModifyDBInstance' :: ModifyDBInstance -> Maybe Text
$sel:autoMinorVersionUpgrade:ModifyDBInstance' :: ModifyDBInstance -> Maybe Bool
$sel:applyImmediately:ModifyDBInstance' :: ModifyDBInstance -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyDBInstance" :: 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
"AutoMinorVersionUpgrade"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
autoMinorVersionUpgrade,
        ByteString
"CACertificateIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
cACertificateIdentifier,
        ByteString
"CopyTagsToSnapshot" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
copyTagsToSnapshot,
        ByteString
"DBInstanceClass" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbInstanceClass,
        ByteString
"EnablePerformanceInsights"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
enablePerformanceInsights,
        ByteString
"NewDBInstanceIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
newDBInstanceIdentifier',
        ByteString
"PerformanceInsightsKMSKeyId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
performanceInsightsKMSKeyId,
        ByteString
"PreferredMaintenanceWindow"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
preferredMaintenanceWindow,
        ByteString
"PromotionTier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
promotionTier,
        ByteString
"DBInstanceIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbInstanceIdentifier
      ]

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

-- |
-- Create a value of 'ModifyDBInstanceResponse' 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:
--
-- 'dbInstance', 'modifyDBInstanceResponse_dbInstance' - Undocumented member.
--
-- 'httpStatus', 'modifyDBInstanceResponse_httpStatus' - The response's http status code.
newModifyDBInstanceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyDBInstanceResponse
newModifyDBInstanceResponse :: Int -> ModifyDBInstanceResponse
newModifyDBInstanceResponse Int
pHttpStatus_ =
  ModifyDBInstanceResponse'
    { $sel:dbInstance:ModifyDBInstanceResponse' :: Maybe DBInstance
dbInstance =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyDBInstanceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
modifyDBInstanceResponse_dbInstance :: Lens.Lens' ModifyDBInstanceResponse (Prelude.Maybe DBInstance)
modifyDBInstanceResponse_dbInstance :: Lens' ModifyDBInstanceResponse (Maybe DBInstance)
modifyDBInstanceResponse_dbInstance = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBInstanceResponse' {Maybe DBInstance
dbInstance :: Maybe DBInstance
$sel:dbInstance:ModifyDBInstanceResponse' :: ModifyDBInstanceResponse -> Maybe DBInstance
dbInstance} -> Maybe DBInstance
dbInstance) (\s :: ModifyDBInstanceResponse
s@ModifyDBInstanceResponse' {} Maybe DBInstance
a -> ModifyDBInstanceResponse
s {$sel:dbInstance:ModifyDBInstanceResponse' :: Maybe DBInstance
dbInstance = Maybe DBInstance
a} :: ModifyDBInstanceResponse)

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

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