{-# 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.ModifyCurrentDBClusterCapacity
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Set the capacity of an Aurora Serverless v1 DB cluster to a specific
-- value.
--
-- Aurora Serverless v1 scales seamlessly based on the workload on the DB
-- cluster. In some cases, the capacity might not scale fast enough to meet
-- a sudden change in workload, such as a large number of new transactions.
-- Call @ModifyCurrentDBClusterCapacity@ to set the capacity explicitly.
--
-- After this call sets the DB cluster capacity, Aurora Serverless v1 can
-- automatically scale the DB cluster based on the cooldown period for
-- scaling up and the cooldown period for scaling down.
--
-- For more information about Aurora Serverless v1, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/aurora-serverless.html Using Amazon Aurora Serverless v1>
-- in the /Amazon Aurora User Guide/.
--
-- If you call @ModifyCurrentDBClusterCapacity@ with the default
-- @TimeoutAction@, connections that prevent Aurora Serverless v1 from
-- finding a scaling point might be dropped. For more information about
-- scaling points, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/aurora-serverless.how-it-works.html#aurora-serverless.how-it-works.auto-scaling Autoscaling for Aurora Serverless v1>
-- in the /Amazon Aurora User Guide/.
--
-- This action only applies to Aurora Serverless v1 DB clusters.
module Amazonka.RDS.ModifyCurrentDBClusterCapacity
  ( -- * Creating a Request
    ModifyCurrentDBClusterCapacity (..),
    newModifyCurrentDBClusterCapacity,

    -- * Request Lenses
    modifyCurrentDBClusterCapacity_capacity,
    modifyCurrentDBClusterCapacity_secondsBeforeTimeout,
    modifyCurrentDBClusterCapacity_timeoutAction,
    modifyCurrentDBClusterCapacity_dbClusterIdentifier,

    -- * Destructuring the Response
    ModifyCurrentDBClusterCapacityResponse (..),
    newModifyCurrentDBClusterCapacityResponse,

    -- * Response Lenses
    modifyCurrentDBClusterCapacityResponse_currentCapacity,
    modifyCurrentDBClusterCapacityResponse_dbClusterIdentifier,
    modifyCurrentDBClusterCapacityResponse_pendingCapacity,
    modifyCurrentDBClusterCapacityResponse_secondsBeforeTimeout,
    modifyCurrentDBClusterCapacityResponse_timeoutAction,
    modifyCurrentDBClusterCapacityResponse_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:/ 'newModifyCurrentDBClusterCapacity' smart constructor.
data ModifyCurrentDBClusterCapacity = ModifyCurrentDBClusterCapacity'
  { -- | The DB cluster capacity.
    --
    -- When you change the capacity of a paused Aurora Serverless v1 DB
    -- cluster, it automatically resumes.
    --
    -- Constraints:
    --
    -- -   For Aurora MySQL, valid capacity values are @1@, @2@, @4@, @8@,
    --     @16@, @32@, @64@, @128@, and @256@.
    --
    -- -   For Aurora PostgreSQL, valid capacity values are @2@, @4@, @8@,
    --     @16@, @32@, @64@, @192@, and @384@.
    ModifyCurrentDBClusterCapacity -> Maybe Int
capacity :: Prelude.Maybe Prelude.Int,
    -- | The amount of time, in seconds, that Aurora Serverless v1 tries to find
    -- a scaling point to perform seamless scaling before enforcing the timeout
    -- action. The default is 300.
    --
    -- Specify a value between 10 and 600 seconds.
    ModifyCurrentDBClusterCapacity -> Maybe Int
secondsBeforeTimeout :: Prelude.Maybe Prelude.Int,
    -- | The action to take when the timeout is reached, either
    -- @ForceApplyCapacityChange@ or @RollbackCapacityChange@.
    --
    -- @ForceApplyCapacityChange@, the default, sets the capacity to the
    -- specified value as soon as possible.
    --
    -- @RollbackCapacityChange@ ignores the capacity change if a scaling point
    -- isn\'t found in the timeout period.
    ModifyCurrentDBClusterCapacity -> Maybe Text
timeoutAction :: Prelude.Maybe Prelude.Text,
    -- | The DB cluster identifier for the cluster being modified. This parameter
    -- isn\'t case-sensitive.
    --
    -- Constraints:
    --
    -- -   Must match the identifier of an existing DB cluster.
    ModifyCurrentDBClusterCapacity -> Text
dbClusterIdentifier :: Prelude.Text
  }
  deriving (ModifyCurrentDBClusterCapacity
-> ModifyCurrentDBClusterCapacity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyCurrentDBClusterCapacity
-> ModifyCurrentDBClusterCapacity -> Bool
$c/= :: ModifyCurrentDBClusterCapacity
-> ModifyCurrentDBClusterCapacity -> Bool
== :: ModifyCurrentDBClusterCapacity
-> ModifyCurrentDBClusterCapacity -> Bool
$c== :: ModifyCurrentDBClusterCapacity
-> ModifyCurrentDBClusterCapacity -> Bool
Prelude.Eq, ReadPrec [ModifyCurrentDBClusterCapacity]
ReadPrec ModifyCurrentDBClusterCapacity
Int -> ReadS ModifyCurrentDBClusterCapacity
ReadS [ModifyCurrentDBClusterCapacity]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyCurrentDBClusterCapacity]
$creadListPrec :: ReadPrec [ModifyCurrentDBClusterCapacity]
readPrec :: ReadPrec ModifyCurrentDBClusterCapacity
$creadPrec :: ReadPrec ModifyCurrentDBClusterCapacity
readList :: ReadS [ModifyCurrentDBClusterCapacity]
$creadList :: ReadS [ModifyCurrentDBClusterCapacity]
readsPrec :: Int -> ReadS ModifyCurrentDBClusterCapacity
$creadsPrec :: Int -> ReadS ModifyCurrentDBClusterCapacity
Prelude.Read, Int -> ModifyCurrentDBClusterCapacity -> ShowS
[ModifyCurrentDBClusterCapacity] -> ShowS
ModifyCurrentDBClusterCapacity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyCurrentDBClusterCapacity] -> ShowS
$cshowList :: [ModifyCurrentDBClusterCapacity] -> ShowS
show :: ModifyCurrentDBClusterCapacity -> String
$cshow :: ModifyCurrentDBClusterCapacity -> String
showsPrec :: Int -> ModifyCurrentDBClusterCapacity -> ShowS
$cshowsPrec :: Int -> ModifyCurrentDBClusterCapacity -> ShowS
Prelude.Show, forall x.
Rep ModifyCurrentDBClusterCapacity x
-> ModifyCurrentDBClusterCapacity
forall x.
ModifyCurrentDBClusterCapacity
-> Rep ModifyCurrentDBClusterCapacity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyCurrentDBClusterCapacity x
-> ModifyCurrentDBClusterCapacity
$cfrom :: forall x.
ModifyCurrentDBClusterCapacity
-> Rep ModifyCurrentDBClusterCapacity x
Prelude.Generic)

-- |
-- Create a value of 'ModifyCurrentDBClusterCapacity' 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:
--
-- 'capacity', 'modifyCurrentDBClusterCapacity_capacity' - The DB cluster capacity.
--
-- When you change the capacity of a paused Aurora Serverless v1 DB
-- cluster, it automatically resumes.
--
-- Constraints:
--
-- -   For Aurora MySQL, valid capacity values are @1@, @2@, @4@, @8@,
--     @16@, @32@, @64@, @128@, and @256@.
--
-- -   For Aurora PostgreSQL, valid capacity values are @2@, @4@, @8@,
--     @16@, @32@, @64@, @192@, and @384@.
--
-- 'secondsBeforeTimeout', 'modifyCurrentDBClusterCapacity_secondsBeforeTimeout' - The amount of time, in seconds, that Aurora Serverless v1 tries to find
-- a scaling point to perform seamless scaling before enforcing the timeout
-- action. The default is 300.
--
-- Specify a value between 10 and 600 seconds.
--
-- 'timeoutAction', 'modifyCurrentDBClusterCapacity_timeoutAction' - The action to take when the timeout is reached, either
-- @ForceApplyCapacityChange@ or @RollbackCapacityChange@.
--
-- @ForceApplyCapacityChange@, the default, sets the capacity to the
-- specified value as soon as possible.
--
-- @RollbackCapacityChange@ ignores the capacity change if a scaling point
-- isn\'t found in the timeout period.
--
-- 'dbClusterIdentifier', 'modifyCurrentDBClusterCapacity_dbClusterIdentifier' - The DB cluster identifier for the cluster being modified. This parameter
-- isn\'t case-sensitive.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DB cluster.
newModifyCurrentDBClusterCapacity ::
  -- | 'dbClusterIdentifier'
  Prelude.Text ->
  ModifyCurrentDBClusterCapacity
newModifyCurrentDBClusterCapacity :: Text -> ModifyCurrentDBClusterCapacity
newModifyCurrentDBClusterCapacity
  Text
pDBClusterIdentifier_ =
    ModifyCurrentDBClusterCapacity'
      { $sel:capacity:ModifyCurrentDBClusterCapacity' :: Maybe Int
capacity =
          forall a. Maybe a
Prelude.Nothing,
        $sel:secondsBeforeTimeout:ModifyCurrentDBClusterCapacity' :: Maybe Int
secondsBeforeTimeout = forall a. Maybe a
Prelude.Nothing,
        $sel:timeoutAction:ModifyCurrentDBClusterCapacity' :: Maybe Text
timeoutAction = forall a. Maybe a
Prelude.Nothing,
        $sel:dbClusterIdentifier:ModifyCurrentDBClusterCapacity' :: Text
dbClusterIdentifier = Text
pDBClusterIdentifier_
      }

-- | The DB cluster capacity.
--
-- When you change the capacity of a paused Aurora Serverless v1 DB
-- cluster, it automatically resumes.
--
-- Constraints:
--
-- -   For Aurora MySQL, valid capacity values are @1@, @2@, @4@, @8@,
--     @16@, @32@, @64@, @128@, and @256@.
--
-- -   For Aurora PostgreSQL, valid capacity values are @2@, @4@, @8@,
--     @16@, @32@, @64@, @192@, and @384@.
modifyCurrentDBClusterCapacity_capacity :: Lens.Lens' ModifyCurrentDBClusterCapacity (Prelude.Maybe Prelude.Int)
modifyCurrentDBClusterCapacity_capacity :: Lens' ModifyCurrentDBClusterCapacity (Maybe Int)
modifyCurrentDBClusterCapacity_capacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCurrentDBClusterCapacity' {Maybe Int
capacity :: Maybe Int
$sel:capacity:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Maybe Int
capacity} -> Maybe Int
capacity) (\s :: ModifyCurrentDBClusterCapacity
s@ModifyCurrentDBClusterCapacity' {} Maybe Int
a -> ModifyCurrentDBClusterCapacity
s {$sel:capacity:ModifyCurrentDBClusterCapacity' :: Maybe Int
capacity = Maybe Int
a} :: ModifyCurrentDBClusterCapacity)

-- | The amount of time, in seconds, that Aurora Serverless v1 tries to find
-- a scaling point to perform seamless scaling before enforcing the timeout
-- action. The default is 300.
--
-- Specify a value between 10 and 600 seconds.
modifyCurrentDBClusterCapacity_secondsBeforeTimeout :: Lens.Lens' ModifyCurrentDBClusterCapacity (Prelude.Maybe Prelude.Int)
modifyCurrentDBClusterCapacity_secondsBeforeTimeout :: Lens' ModifyCurrentDBClusterCapacity (Maybe Int)
modifyCurrentDBClusterCapacity_secondsBeforeTimeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCurrentDBClusterCapacity' {Maybe Int
secondsBeforeTimeout :: Maybe Int
$sel:secondsBeforeTimeout:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Maybe Int
secondsBeforeTimeout} -> Maybe Int
secondsBeforeTimeout) (\s :: ModifyCurrentDBClusterCapacity
s@ModifyCurrentDBClusterCapacity' {} Maybe Int
a -> ModifyCurrentDBClusterCapacity
s {$sel:secondsBeforeTimeout:ModifyCurrentDBClusterCapacity' :: Maybe Int
secondsBeforeTimeout = Maybe Int
a} :: ModifyCurrentDBClusterCapacity)

-- | The action to take when the timeout is reached, either
-- @ForceApplyCapacityChange@ or @RollbackCapacityChange@.
--
-- @ForceApplyCapacityChange@, the default, sets the capacity to the
-- specified value as soon as possible.
--
-- @RollbackCapacityChange@ ignores the capacity change if a scaling point
-- isn\'t found in the timeout period.
modifyCurrentDBClusterCapacity_timeoutAction :: Lens.Lens' ModifyCurrentDBClusterCapacity (Prelude.Maybe Prelude.Text)
modifyCurrentDBClusterCapacity_timeoutAction :: Lens' ModifyCurrentDBClusterCapacity (Maybe Text)
modifyCurrentDBClusterCapacity_timeoutAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCurrentDBClusterCapacity' {Maybe Text
timeoutAction :: Maybe Text
$sel:timeoutAction:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Maybe Text
timeoutAction} -> Maybe Text
timeoutAction) (\s :: ModifyCurrentDBClusterCapacity
s@ModifyCurrentDBClusterCapacity' {} Maybe Text
a -> ModifyCurrentDBClusterCapacity
s {$sel:timeoutAction:ModifyCurrentDBClusterCapacity' :: Maybe Text
timeoutAction = Maybe Text
a} :: ModifyCurrentDBClusterCapacity)

-- | The DB cluster identifier for the cluster being modified. This parameter
-- isn\'t case-sensitive.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DB cluster.
modifyCurrentDBClusterCapacity_dbClusterIdentifier :: Lens.Lens' ModifyCurrentDBClusterCapacity Prelude.Text
modifyCurrentDBClusterCapacity_dbClusterIdentifier :: Lens' ModifyCurrentDBClusterCapacity Text
modifyCurrentDBClusterCapacity_dbClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCurrentDBClusterCapacity' {Text
dbClusterIdentifier :: Text
$sel:dbClusterIdentifier:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Text
dbClusterIdentifier} -> Text
dbClusterIdentifier) (\s :: ModifyCurrentDBClusterCapacity
s@ModifyCurrentDBClusterCapacity' {} Text
a -> ModifyCurrentDBClusterCapacity
s {$sel:dbClusterIdentifier:ModifyCurrentDBClusterCapacity' :: Text
dbClusterIdentifier = Text
a} :: ModifyCurrentDBClusterCapacity)

instance
  Core.AWSRequest
    ModifyCurrentDBClusterCapacity
  where
  type
    AWSResponse ModifyCurrentDBClusterCapacity =
      ModifyCurrentDBClusterCapacityResponse
  request :: (Service -> Service)
-> ModifyCurrentDBClusterCapacity
-> Request ModifyCurrentDBClusterCapacity
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 ModifyCurrentDBClusterCapacity
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse ModifyCurrentDBClusterCapacity)))
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
"ModifyCurrentDBClusterCapacityResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Int
-> ModifyCurrentDBClusterCapacityResponse
ModifyCurrentDBClusterCapacityResponse'
            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
"CurrentCapacity")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DBClusterIdentifier")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"PendingCapacity")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"SecondsBeforeTimeout")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"TimeoutAction")
            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
    ModifyCurrentDBClusterCapacity
  where
  hashWithSalt :: Int -> ModifyCurrentDBClusterCapacity -> Int
hashWithSalt
    Int
_salt
    ModifyCurrentDBClusterCapacity' {Maybe Int
Maybe Text
Text
dbClusterIdentifier :: Text
timeoutAction :: Maybe Text
secondsBeforeTimeout :: Maybe Int
capacity :: Maybe Int
$sel:dbClusterIdentifier:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Text
$sel:timeoutAction:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Maybe Text
$sel:secondsBeforeTimeout:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Maybe Int
$sel:capacity:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Maybe Int
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
capacity
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
secondsBeforeTimeout
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
timeoutAction
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbClusterIdentifier

instance
  Prelude.NFData
    ModifyCurrentDBClusterCapacity
  where
  rnf :: ModifyCurrentDBClusterCapacity -> ()
rnf ModifyCurrentDBClusterCapacity' {Maybe Int
Maybe Text
Text
dbClusterIdentifier :: Text
timeoutAction :: Maybe Text
secondsBeforeTimeout :: Maybe Int
capacity :: Maybe Int
$sel:dbClusterIdentifier:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Text
$sel:timeoutAction:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Maybe Text
$sel:secondsBeforeTimeout:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Maybe Int
$sel:capacity:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
capacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
secondsBeforeTimeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
timeoutAction
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbClusterIdentifier

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

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

instance Data.ToQuery ModifyCurrentDBClusterCapacity where
  toQuery :: ModifyCurrentDBClusterCapacity -> QueryString
toQuery ModifyCurrentDBClusterCapacity' {Maybe Int
Maybe Text
Text
dbClusterIdentifier :: Text
timeoutAction :: Maybe Text
secondsBeforeTimeout :: Maybe Int
capacity :: Maybe Int
$sel:dbClusterIdentifier:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Text
$sel:timeoutAction:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Maybe Text
$sel:secondsBeforeTimeout:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Maybe Int
$sel:capacity:ModifyCurrentDBClusterCapacity' :: ModifyCurrentDBClusterCapacity -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ModifyCurrentDBClusterCapacity" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"Capacity" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
capacity,
        ByteString
"SecondsBeforeTimeout" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
secondsBeforeTimeout,
        ByteString
"TimeoutAction" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
timeoutAction,
        ByteString
"DBClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbClusterIdentifier
      ]

-- | /See:/ 'newModifyCurrentDBClusterCapacityResponse' smart constructor.
data ModifyCurrentDBClusterCapacityResponse = ModifyCurrentDBClusterCapacityResponse'
  { -- | The current capacity of the DB cluster.
    ModifyCurrentDBClusterCapacityResponse -> Maybe Int
currentCapacity :: Prelude.Maybe Prelude.Int,
    -- | A user-supplied DB cluster identifier. This identifier is the unique key
    -- that identifies a DB cluster.
    ModifyCurrentDBClusterCapacityResponse -> Maybe Text
dbClusterIdentifier :: Prelude.Maybe Prelude.Text,
    -- | A value that specifies the capacity that the DB cluster scales to next.
    ModifyCurrentDBClusterCapacityResponse -> Maybe Int
pendingCapacity :: Prelude.Maybe Prelude.Int,
    -- | The number of seconds before a call to @ModifyCurrentDBClusterCapacity@
    -- times out.
    ModifyCurrentDBClusterCapacityResponse -> Maybe Int
secondsBeforeTimeout :: Prelude.Maybe Prelude.Int,
    -- | The timeout action of a call to @ModifyCurrentDBClusterCapacity@, either
    -- @ForceApplyCapacityChange@ or @RollbackCapacityChange@.
    ModifyCurrentDBClusterCapacityResponse -> Maybe Text
timeoutAction :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ModifyCurrentDBClusterCapacityResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ModifyCurrentDBClusterCapacityResponse
-> ModifyCurrentDBClusterCapacityResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyCurrentDBClusterCapacityResponse
-> ModifyCurrentDBClusterCapacityResponse -> Bool
$c/= :: ModifyCurrentDBClusterCapacityResponse
-> ModifyCurrentDBClusterCapacityResponse -> Bool
== :: ModifyCurrentDBClusterCapacityResponse
-> ModifyCurrentDBClusterCapacityResponse -> Bool
$c== :: ModifyCurrentDBClusterCapacityResponse
-> ModifyCurrentDBClusterCapacityResponse -> Bool
Prelude.Eq, ReadPrec [ModifyCurrentDBClusterCapacityResponse]
ReadPrec ModifyCurrentDBClusterCapacityResponse
Int -> ReadS ModifyCurrentDBClusterCapacityResponse
ReadS [ModifyCurrentDBClusterCapacityResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyCurrentDBClusterCapacityResponse]
$creadListPrec :: ReadPrec [ModifyCurrentDBClusterCapacityResponse]
readPrec :: ReadPrec ModifyCurrentDBClusterCapacityResponse
$creadPrec :: ReadPrec ModifyCurrentDBClusterCapacityResponse
readList :: ReadS [ModifyCurrentDBClusterCapacityResponse]
$creadList :: ReadS [ModifyCurrentDBClusterCapacityResponse]
readsPrec :: Int -> ReadS ModifyCurrentDBClusterCapacityResponse
$creadsPrec :: Int -> ReadS ModifyCurrentDBClusterCapacityResponse
Prelude.Read, Int -> ModifyCurrentDBClusterCapacityResponse -> ShowS
[ModifyCurrentDBClusterCapacityResponse] -> ShowS
ModifyCurrentDBClusterCapacityResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyCurrentDBClusterCapacityResponse] -> ShowS
$cshowList :: [ModifyCurrentDBClusterCapacityResponse] -> ShowS
show :: ModifyCurrentDBClusterCapacityResponse -> String
$cshow :: ModifyCurrentDBClusterCapacityResponse -> String
showsPrec :: Int -> ModifyCurrentDBClusterCapacityResponse -> ShowS
$cshowsPrec :: Int -> ModifyCurrentDBClusterCapacityResponse -> ShowS
Prelude.Show, forall x.
Rep ModifyCurrentDBClusterCapacityResponse x
-> ModifyCurrentDBClusterCapacityResponse
forall x.
ModifyCurrentDBClusterCapacityResponse
-> Rep ModifyCurrentDBClusterCapacityResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyCurrentDBClusterCapacityResponse x
-> ModifyCurrentDBClusterCapacityResponse
$cfrom :: forall x.
ModifyCurrentDBClusterCapacityResponse
-> Rep ModifyCurrentDBClusterCapacityResponse x
Prelude.Generic)

-- |
-- Create a value of 'ModifyCurrentDBClusterCapacityResponse' 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:
--
-- 'currentCapacity', 'modifyCurrentDBClusterCapacityResponse_currentCapacity' - The current capacity of the DB cluster.
--
-- 'dbClusterIdentifier', 'modifyCurrentDBClusterCapacityResponse_dbClusterIdentifier' - A user-supplied DB cluster identifier. This identifier is the unique key
-- that identifies a DB cluster.
--
-- 'pendingCapacity', 'modifyCurrentDBClusterCapacityResponse_pendingCapacity' - A value that specifies the capacity that the DB cluster scales to next.
--
-- 'secondsBeforeTimeout', 'modifyCurrentDBClusterCapacityResponse_secondsBeforeTimeout' - The number of seconds before a call to @ModifyCurrentDBClusterCapacity@
-- times out.
--
-- 'timeoutAction', 'modifyCurrentDBClusterCapacityResponse_timeoutAction' - The timeout action of a call to @ModifyCurrentDBClusterCapacity@, either
-- @ForceApplyCapacityChange@ or @RollbackCapacityChange@.
--
-- 'httpStatus', 'modifyCurrentDBClusterCapacityResponse_httpStatus' - The response's http status code.
newModifyCurrentDBClusterCapacityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyCurrentDBClusterCapacityResponse
newModifyCurrentDBClusterCapacityResponse :: Int -> ModifyCurrentDBClusterCapacityResponse
newModifyCurrentDBClusterCapacityResponse
  Int
pHttpStatus_ =
    ModifyCurrentDBClusterCapacityResponse'
      { $sel:currentCapacity:ModifyCurrentDBClusterCapacityResponse' :: Maybe Int
currentCapacity =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dbClusterIdentifier:ModifyCurrentDBClusterCapacityResponse' :: Maybe Text
dbClusterIdentifier =
          forall a. Maybe a
Prelude.Nothing,
        $sel:pendingCapacity:ModifyCurrentDBClusterCapacityResponse' :: Maybe Int
pendingCapacity = forall a. Maybe a
Prelude.Nothing,
        $sel:secondsBeforeTimeout:ModifyCurrentDBClusterCapacityResponse' :: Maybe Int
secondsBeforeTimeout =
          forall a. Maybe a
Prelude.Nothing,
        $sel:timeoutAction:ModifyCurrentDBClusterCapacityResponse' :: Maybe Text
timeoutAction = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ModifyCurrentDBClusterCapacityResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The current capacity of the DB cluster.
modifyCurrentDBClusterCapacityResponse_currentCapacity :: Lens.Lens' ModifyCurrentDBClusterCapacityResponse (Prelude.Maybe Prelude.Int)
modifyCurrentDBClusterCapacityResponse_currentCapacity :: Lens' ModifyCurrentDBClusterCapacityResponse (Maybe Int)
modifyCurrentDBClusterCapacityResponse_currentCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCurrentDBClusterCapacityResponse' {Maybe Int
currentCapacity :: Maybe Int
$sel:currentCapacity:ModifyCurrentDBClusterCapacityResponse' :: ModifyCurrentDBClusterCapacityResponse -> Maybe Int
currentCapacity} -> Maybe Int
currentCapacity) (\s :: ModifyCurrentDBClusterCapacityResponse
s@ModifyCurrentDBClusterCapacityResponse' {} Maybe Int
a -> ModifyCurrentDBClusterCapacityResponse
s {$sel:currentCapacity:ModifyCurrentDBClusterCapacityResponse' :: Maybe Int
currentCapacity = Maybe Int
a} :: ModifyCurrentDBClusterCapacityResponse)

-- | A user-supplied DB cluster identifier. This identifier is the unique key
-- that identifies a DB cluster.
modifyCurrentDBClusterCapacityResponse_dbClusterIdentifier :: Lens.Lens' ModifyCurrentDBClusterCapacityResponse (Prelude.Maybe Prelude.Text)
modifyCurrentDBClusterCapacityResponse_dbClusterIdentifier :: Lens' ModifyCurrentDBClusterCapacityResponse (Maybe Text)
modifyCurrentDBClusterCapacityResponse_dbClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCurrentDBClusterCapacityResponse' {Maybe Text
dbClusterIdentifier :: Maybe Text
$sel:dbClusterIdentifier:ModifyCurrentDBClusterCapacityResponse' :: ModifyCurrentDBClusterCapacityResponse -> Maybe Text
dbClusterIdentifier} -> Maybe Text
dbClusterIdentifier) (\s :: ModifyCurrentDBClusterCapacityResponse
s@ModifyCurrentDBClusterCapacityResponse' {} Maybe Text
a -> ModifyCurrentDBClusterCapacityResponse
s {$sel:dbClusterIdentifier:ModifyCurrentDBClusterCapacityResponse' :: Maybe Text
dbClusterIdentifier = Maybe Text
a} :: ModifyCurrentDBClusterCapacityResponse)

-- | A value that specifies the capacity that the DB cluster scales to next.
modifyCurrentDBClusterCapacityResponse_pendingCapacity :: Lens.Lens' ModifyCurrentDBClusterCapacityResponse (Prelude.Maybe Prelude.Int)
modifyCurrentDBClusterCapacityResponse_pendingCapacity :: Lens' ModifyCurrentDBClusterCapacityResponse (Maybe Int)
modifyCurrentDBClusterCapacityResponse_pendingCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCurrentDBClusterCapacityResponse' {Maybe Int
pendingCapacity :: Maybe Int
$sel:pendingCapacity:ModifyCurrentDBClusterCapacityResponse' :: ModifyCurrentDBClusterCapacityResponse -> Maybe Int
pendingCapacity} -> Maybe Int
pendingCapacity) (\s :: ModifyCurrentDBClusterCapacityResponse
s@ModifyCurrentDBClusterCapacityResponse' {} Maybe Int
a -> ModifyCurrentDBClusterCapacityResponse
s {$sel:pendingCapacity:ModifyCurrentDBClusterCapacityResponse' :: Maybe Int
pendingCapacity = Maybe Int
a} :: ModifyCurrentDBClusterCapacityResponse)

-- | The number of seconds before a call to @ModifyCurrentDBClusterCapacity@
-- times out.
modifyCurrentDBClusterCapacityResponse_secondsBeforeTimeout :: Lens.Lens' ModifyCurrentDBClusterCapacityResponse (Prelude.Maybe Prelude.Int)
modifyCurrentDBClusterCapacityResponse_secondsBeforeTimeout :: Lens' ModifyCurrentDBClusterCapacityResponse (Maybe Int)
modifyCurrentDBClusterCapacityResponse_secondsBeforeTimeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCurrentDBClusterCapacityResponse' {Maybe Int
secondsBeforeTimeout :: Maybe Int
$sel:secondsBeforeTimeout:ModifyCurrentDBClusterCapacityResponse' :: ModifyCurrentDBClusterCapacityResponse -> Maybe Int
secondsBeforeTimeout} -> Maybe Int
secondsBeforeTimeout) (\s :: ModifyCurrentDBClusterCapacityResponse
s@ModifyCurrentDBClusterCapacityResponse' {} Maybe Int
a -> ModifyCurrentDBClusterCapacityResponse
s {$sel:secondsBeforeTimeout:ModifyCurrentDBClusterCapacityResponse' :: Maybe Int
secondsBeforeTimeout = Maybe Int
a} :: ModifyCurrentDBClusterCapacityResponse)

-- | The timeout action of a call to @ModifyCurrentDBClusterCapacity@, either
-- @ForceApplyCapacityChange@ or @RollbackCapacityChange@.
modifyCurrentDBClusterCapacityResponse_timeoutAction :: Lens.Lens' ModifyCurrentDBClusterCapacityResponse (Prelude.Maybe Prelude.Text)
modifyCurrentDBClusterCapacityResponse_timeoutAction :: Lens' ModifyCurrentDBClusterCapacityResponse (Maybe Text)
modifyCurrentDBClusterCapacityResponse_timeoutAction = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCurrentDBClusterCapacityResponse' {Maybe Text
timeoutAction :: Maybe Text
$sel:timeoutAction:ModifyCurrentDBClusterCapacityResponse' :: ModifyCurrentDBClusterCapacityResponse -> Maybe Text
timeoutAction} -> Maybe Text
timeoutAction) (\s :: ModifyCurrentDBClusterCapacityResponse
s@ModifyCurrentDBClusterCapacityResponse' {} Maybe Text
a -> ModifyCurrentDBClusterCapacityResponse
s {$sel:timeoutAction:ModifyCurrentDBClusterCapacityResponse' :: Maybe Text
timeoutAction = Maybe Text
a} :: ModifyCurrentDBClusterCapacityResponse)

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

instance
  Prelude.NFData
    ModifyCurrentDBClusterCapacityResponse
  where
  rnf :: ModifyCurrentDBClusterCapacityResponse -> ()
rnf ModifyCurrentDBClusterCapacityResponse' {Int
Maybe Int
Maybe Text
httpStatus :: Int
timeoutAction :: Maybe Text
secondsBeforeTimeout :: Maybe Int
pendingCapacity :: Maybe Int
dbClusterIdentifier :: Maybe Text
currentCapacity :: Maybe Int
$sel:httpStatus:ModifyCurrentDBClusterCapacityResponse' :: ModifyCurrentDBClusterCapacityResponse -> Int
$sel:timeoutAction:ModifyCurrentDBClusterCapacityResponse' :: ModifyCurrentDBClusterCapacityResponse -> Maybe Text
$sel:secondsBeforeTimeout:ModifyCurrentDBClusterCapacityResponse' :: ModifyCurrentDBClusterCapacityResponse -> Maybe Int
$sel:pendingCapacity:ModifyCurrentDBClusterCapacityResponse' :: ModifyCurrentDBClusterCapacityResponse -> Maybe Int
$sel:dbClusterIdentifier:ModifyCurrentDBClusterCapacityResponse' :: ModifyCurrentDBClusterCapacityResponse -> Maybe Text
$sel:currentCapacity:ModifyCurrentDBClusterCapacityResponse' :: ModifyCurrentDBClusterCapacityResponse -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
currentCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbClusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
pendingCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
secondsBeforeTimeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
timeoutAction
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus