{-# 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.RDS.PromoteReadReplica
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Promotes a read replica DB instance to a standalone DB instance.
--
-- -   Backup duration is a function of the amount of changes to the
--     database since the previous backup. If you plan to promote a read
--     replica to a standalone instance, we recommend that you enable
--     backups and complete at least one backup prior to promotion. In
--     addition, a read replica cannot be promoted to a standalone instance
--     when it is in the @backing-up@ status. If you have enabled backups
--     on your read replica, configure the automated backup window so that
--     daily backups do not interfere with read replica promotion.
--
-- -   This command doesn\'t apply to Aurora MySQL, Aurora PostgreSQL, or
--     RDS Custom.
module Amazonka.RDS.PromoteReadReplica
  ( -- * Creating a Request
    PromoteReadReplica (..),
    newPromoteReadReplica,

    -- * Request Lenses
    promoteReadReplica_backupRetentionPeriod,
    promoteReadReplica_preferredBackupWindow,
    promoteReadReplica_dbInstanceIdentifier,

    -- * Destructuring the Response
    PromoteReadReplicaResponse (..),
    newPromoteReadReplicaResponse,

    -- * Response Lenses
    promoteReadReplicaResponse_dbInstance,
    promoteReadReplicaResponse_httpStatus,
  )
where

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

-- |
--
-- /See:/ 'newPromoteReadReplica' smart constructor.
data PromoteReadReplica = PromoteReadReplica'
  { -- | The number of days for which automated backups are retained. Setting
    -- this parameter to a positive number enables backups. Setting this
    -- parameter to 0 disables automated backups.
    --
    -- Default: 1
    --
    -- Constraints:
    --
    -- -   Must be a value from 0 to 35.
    --
    -- -   Can\'t be set to 0 if the DB instance is a source to read replicas.
    PromoteReadReplica -> Maybe Int
backupRetentionPeriod :: 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. To see the time
    -- blocks available, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/AdjustingTheMaintenanceWindow.html Adjusting the Preferred Maintenance Window>
    -- in the /Amazon RDS User Guide./
    --
    -- 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.
    PromoteReadReplica -> Maybe Text
preferredBackupWindow :: Prelude.Maybe Prelude.Text,
    -- | The DB instance identifier. This value is stored as a lowercase string.
    --
    -- Constraints:
    --
    -- -   Must match the identifier of an existing read replica DB instance.
    --
    -- Example: @mydbinstance@
    PromoteReadReplica -> Text
dbInstanceIdentifier :: Prelude.Text
  }
  deriving (PromoteReadReplica -> PromoteReadReplica -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PromoteReadReplica -> PromoteReadReplica -> Bool
$c/= :: PromoteReadReplica -> PromoteReadReplica -> Bool
== :: PromoteReadReplica -> PromoteReadReplica -> Bool
$c== :: PromoteReadReplica -> PromoteReadReplica -> Bool
Prelude.Eq, ReadPrec [PromoteReadReplica]
ReadPrec PromoteReadReplica
Int -> ReadS PromoteReadReplica
ReadS [PromoteReadReplica]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PromoteReadReplica]
$creadListPrec :: ReadPrec [PromoteReadReplica]
readPrec :: ReadPrec PromoteReadReplica
$creadPrec :: ReadPrec PromoteReadReplica
readList :: ReadS [PromoteReadReplica]
$creadList :: ReadS [PromoteReadReplica]
readsPrec :: Int -> ReadS PromoteReadReplica
$creadsPrec :: Int -> ReadS PromoteReadReplica
Prelude.Read, Int -> PromoteReadReplica -> ShowS
[PromoteReadReplica] -> ShowS
PromoteReadReplica -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PromoteReadReplica] -> ShowS
$cshowList :: [PromoteReadReplica] -> ShowS
show :: PromoteReadReplica -> String
$cshow :: PromoteReadReplica -> String
showsPrec :: Int -> PromoteReadReplica -> ShowS
$cshowsPrec :: Int -> PromoteReadReplica -> ShowS
Prelude.Show, forall x. Rep PromoteReadReplica x -> PromoteReadReplica
forall x. PromoteReadReplica -> Rep PromoteReadReplica x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PromoteReadReplica x -> PromoteReadReplica
$cfrom :: forall x. PromoteReadReplica -> Rep PromoteReadReplica x
Prelude.Generic)

-- |
-- Create a value of 'PromoteReadReplica' 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:
--
-- 'backupRetentionPeriod', 'promoteReadReplica_backupRetentionPeriod' - The number of days for which automated backups are retained. Setting
-- this parameter to a positive number enables backups. Setting this
-- parameter to 0 disables automated backups.
--
-- Default: 1
--
-- Constraints:
--
-- -   Must be a value from 0 to 35.
--
-- -   Can\'t be set to 0 if the DB instance is a source to read replicas.
--
-- 'preferredBackupWindow', 'promoteReadReplica_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. To see the time
-- blocks available, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/AdjustingTheMaintenanceWindow.html Adjusting the Preferred Maintenance Window>
-- in the /Amazon RDS User Guide./
--
-- 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.
--
-- 'dbInstanceIdentifier', 'promoteReadReplica_dbInstanceIdentifier' - The DB instance identifier. This value is stored as a lowercase string.
--
-- Constraints:
--
-- -   Must match the identifier of an existing read replica DB instance.
--
-- Example: @mydbinstance@
newPromoteReadReplica ::
  -- | 'dbInstanceIdentifier'
  Prelude.Text ->
  PromoteReadReplica
newPromoteReadReplica :: Text -> PromoteReadReplica
newPromoteReadReplica Text
pDBInstanceIdentifier_ =
  PromoteReadReplica'
    { $sel:backupRetentionPeriod:PromoteReadReplica' :: Maybe Int
backupRetentionPeriod =
        forall a. Maybe a
Prelude.Nothing,
      $sel:preferredBackupWindow:PromoteReadReplica' :: Maybe Text
preferredBackupWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:dbInstanceIdentifier:PromoteReadReplica' :: Text
dbInstanceIdentifier = Text
pDBInstanceIdentifier_
    }

-- | The number of days for which automated backups are retained. Setting
-- this parameter to a positive number enables backups. Setting this
-- parameter to 0 disables automated backups.
--
-- Default: 1
--
-- Constraints:
--
-- -   Must be a value from 0 to 35.
--
-- -   Can\'t be set to 0 if the DB instance is a source to read replicas.
promoteReadReplica_backupRetentionPeriod :: Lens.Lens' PromoteReadReplica (Prelude.Maybe Prelude.Int)
promoteReadReplica_backupRetentionPeriod :: Lens' PromoteReadReplica (Maybe Int)
promoteReadReplica_backupRetentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PromoteReadReplica' {Maybe Int
backupRetentionPeriod :: Maybe Int
$sel:backupRetentionPeriod:PromoteReadReplica' :: PromoteReadReplica -> Maybe Int
backupRetentionPeriod} -> Maybe Int
backupRetentionPeriod) (\s :: PromoteReadReplica
s@PromoteReadReplica' {} Maybe Int
a -> PromoteReadReplica
s {$sel:backupRetentionPeriod:PromoteReadReplica' :: Maybe Int
backupRetentionPeriod = Maybe Int
a} :: PromoteReadReplica)

-- | 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. To see the time
-- blocks available, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/AdjustingTheMaintenanceWindow.html Adjusting the Preferred Maintenance Window>
-- in the /Amazon RDS User Guide./
--
-- 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.
promoteReadReplica_preferredBackupWindow :: Lens.Lens' PromoteReadReplica (Prelude.Maybe Prelude.Text)
promoteReadReplica_preferredBackupWindow :: Lens' PromoteReadReplica (Maybe Text)
promoteReadReplica_preferredBackupWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PromoteReadReplica' {Maybe Text
preferredBackupWindow :: Maybe Text
$sel:preferredBackupWindow:PromoteReadReplica' :: PromoteReadReplica -> Maybe Text
preferredBackupWindow} -> Maybe Text
preferredBackupWindow) (\s :: PromoteReadReplica
s@PromoteReadReplica' {} Maybe Text
a -> PromoteReadReplica
s {$sel:preferredBackupWindow:PromoteReadReplica' :: Maybe Text
preferredBackupWindow = Maybe Text
a} :: PromoteReadReplica)

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

instance Core.AWSRequest PromoteReadReplica where
  type
    AWSResponse PromoteReadReplica =
      PromoteReadReplicaResponse
  request :: (Service -> Service)
-> PromoteReadReplica -> Request PromoteReadReplica
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 PromoteReadReplica
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PromoteReadReplica)))
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
"PromoteReadReplicaResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBInstance -> Int -> PromoteReadReplicaResponse
PromoteReadReplicaResponse'
            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 PromoteReadReplica where
  hashWithSalt :: Int -> PromoteReadReplica -> Int
hashWithSalt Int
_salt PromoteReadReplica' {Maybe Int
Maybe Text
Text
dbInstanceIdentifier :: Text
preferredBackupWindow :: Maybe Text
backupRetentionPeriod :: Maybe Int
$sel:dbInstanceIdentifier:PromoteReadReplica' :: PromoteReadReplica -> Text
$sel:preferredBackupWindow:PromoteReadReplica' :: PromoteReadReplica -> Maybe Text
$sel:backupRetentionPeriod:PromoteReadReplica' :: PromoteReadReplica -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
backupRetentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredBackupWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbInstanceIdentifier

instance Prelude.NFData PromoteReadReplica where
  rnf :: PromoteReadReplica -> ()
rnf PromoteReadReplica' {Maybe Int
Maybe Text
Text
dbInstanceIdentifier :: Text
preferredBackupWindow :: Maybe Text
backupRetentionPeriod :: Maybe Int
$sel:dbInstanceIdentifier:PromoteReadReplica' :: PromoteReadReplica -> Text
$sel:preferredBackupWindow:PromoteReadReplica' :: PromoteReadReplica -> Maybe Text
$sel:backupRetentionPeriod:PromoteReadReplica' :: PromoteReadReplica -> Maybe Int
..} =
    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 Text
preferredBackupWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbInstanceIdentifier

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

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

instance Data.ToQuery PromoteReadReplica where
  toQuery :: PromoteReadReplica -> QueryString
toQuery PromoteReadReplica' {Maybe Int
Maybe Text
Text
dbInstanceIdentifier :: Text
preferredBackupWindow :: Maybe Text
backupRetentionPeriod :: Maybe Int
$sel:dbInstanceIdentifier:PromoteReadReplica' :: PromoteReadReplica -> Text
$sel:preferredBackupWindow:PromoteReadReplica' :: PromoteReadReplica -> Maybe Text
$sel:backupRetentionPeriod:PromoteReadReplica' :: PromoteReadReplica -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"PromoteReadReplica" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"BackupRetentionPeriod"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
backupRetentionPeriod,
        ByteString
"PreferredBackupWindow"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
preferredBackupWindow,
        ByteString
"DBInstanceIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbInstanceIdentifier
      ]

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

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

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

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

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