{-# 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.DynamoDB.DescribeLimits
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the current provisioned-capacity quotas for your Amazon Web
-- Services account in a Region, both for the Region as a whole and for any
-- one DynamoDB table that you create there.
--
-- When you establish an Amazon Web Services account, the account has
-- initial quotas on the maximum read capacity units and write capacity
-- units that you can provision across all of your DynamoDB tables in a
-- given Region. Also, there are per-table quotas that apply when you
-- create a table there. For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/Limits.html Service, Account, and Table Quotas>
-- page in the /Amazon DynamoDB Developer Guide/.
--
-- Although you can increase these quotas by filing a case at
-- <https://console.aws.amazon.com/support/home#/ Amazon Web Services Support Center>,
-- obtaining the increase is not instantaneous. The @DescribeLimits@ action
-- lets you write code to compare the capacity you are currently using to
-- those quotas imposed by your account so that you have enough time to
-- apply for an increase before you hit a quota.
--
-- For example, you could use one of the Amazon Web Services SDKs to do the
-- following:
--
-- 1.  Call @DescribeLimits@ for a particular Region to obtain your current
--     account quotas on provisioned capacity there.
--
-- 2.  Create a variable to hold the aggregate read capacity units
--     provisioned for all your tables in that Region, and one to hold the
--     aggregate write capacity units. Zero them both.
--
-- 3.  Call @ListTables@ to obtain a list of all your DynamoDB tables.
--
-- 4.  For each table name listed by @ListTables@, do the following:
--
--     -   Call @DescribeTable@ with the table name.
--
--     -   Use the data returned by @DescribeTable@ to add the read
--         capacity units and write capacity units provisioned for the
--         table itself to your variables.
--
--     -   If the table has one or more global secondary indexes (GSIs),
--         loop over these GSIs and add their provisioned capacity values
--         to your variables as well.
--
-- 5.  Report the account quotas for that Region returned by
--     @DescribeLimits@, along with the total current provisioned capacity
--     levels you have calculated.
--
-- This will let you see whether you are getting close to your
-- account-level quotas.
--
-- The per-table quotas apply only when you are creating a new table. They
-- restrict the sum of the provisioned capacity of the new table itself and
-- all its global secondary indexes.
--
-- For existing tables and their GSIs, DynamoDB doesn\'t let you increase
-- provisioned capacity extremely rapidly, but the only quota that applies
-- is that the aggregate provisioned capacity over all your tables and GSIs
-- cannot exceed either of the per-account quotas.
--
-- @DescribeLimits@ should only be called periodically. You can expect
-- throttling errors if you call it more than once in a minute.
--
-- The @DescribeLimits@ Request element has no content.
module Amazonka.DynamoDB.DescribeLimits
  ( -- * Creating a Request
    DescribeLimits (..),
    newDescribeLimits,

    -- * Destructuring the Response
    DescribeLimitsResponse (..),
    newDescribeLimitsResponse,

    -- * Response Lenses
    describeLimitsResponse_accountMaxReadCapacityUnits,
    describeLimitsResponse_accountMaxWriteCapacityUnits,
    describeLimitsResponse_tableMaxReadCapacityUnits,
    describeLimitsResponse_tableMaxWriteCapacityUnits,
    describeLimitsResponse_httpStatus,
  )
where

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

-- | Represents the input of a @DescribeLimits@ operation. Has no content.
--
-- /See:/ 'newDescribeLimits' smart constructor.
data DescribeLimits = DescribeLimits'
  {
  }
  deriving (DescribeLimits -> DescribeLimits -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeLimits -> DescribeLimits -> Bool
$c/= :: DescribeLimits -> DescribeLimits -> Bool
== :: DescribeLimits -> DescribeLimits -> Bool
$c== :: DescribeLimits -> DescribeLimits -> Bool
Prelude.Eq, ReadPrec [DescribeLimits]
ReadPrec DescribeLimits
Int -> ReadS DescribeLimits
ReadS [DescribeLimits]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeLimits]
$creadListPrec :: ReadPrec [DescribeLimits]
readPrec :: ReadPrec DescribeLimits
$creadPrec :: ReadPrec DescribeLimits
readList :: ReadS [DescribeLimits]
$creadList :: ReadS [DescribeLimits]
readsPrec :: Int -> ReadS DescribeLimits
$creadsPrec :: Int -> ReadS DescribeLimits
Prelude.Read, Int -> DescribeLimits -> ShowS
[DescribeLimits] -> ShowS
DescribeLimits -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeLimits] -> ShowS
$cshowList :: [DescribeLimits] -> ShowS
show :: DescribeLimits -> String
$cshow :: DescribeLimits -> String
showsPrec :: Int -> DescribeLimits -> ShowS
$cshowsPrec :: Int -> DescribeLimits -> ShowS
Prelude.Show, forall x. Rep DescribeLimits x -> DescribeLimits
forall x. DescribeLimits -> Rep DescribeLimits x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeLimits x -> DescribeLimits
$cfrom :: forall x. DescribeLimits -> Rep DescribeLimits x
Prelude.Generic)

-- |
-- Create a value of 'DescribeLimits' 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.
newDescribeLimits ::
  DescribeLimits
newDescribeLimits :: DescribeLimits
newDescribeLimits = DescribeLimits
DescribeLimits'

instance Core.AWSRequest DescribeLimits where
  type
    AWSResponse DescribeLimits =
      DescribeLimitsResponse
  request :: (Service -> Service) -> DescribeLimits -> Request DescribeLimits
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeLimits
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeLimits)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Int
-> DescribeLimitsResponse
DescribeLimitsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"AccountMaxReadCapacityUnits")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"AccountMaxWriteCapacityUnits")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TableMaxReadCapacityUnits")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TableMaxWriteCapacityUnits")
            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 DescribeLimits where
  hashWithSalt :: Int -> DescribeLimits -> Int
hashWithSalt Int
_salt DescribeLimits
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

instance Prelude.NFData DescribeLimits where
  rnf :: DescribeLimits -> ()
rnf DescribeLimits
_ = ()

instance Data.ToHeaders DescribeLimits where
  toHeaders :: DescribeLimits -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"DynamoDB_20120810.DescribeLimits" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DescribeLimits where
  toJSON :: DescribeLimits -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

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

instance Data.ToQuery DescribeLimits where
  toQuery :: DescribeLimits -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | Represents the output of a @DescribeLimits@ operation.
--
-- /See:/ 'newDescribeLimitsResponse' smart constructor.
data DescribeLimitsResponse = DescribeLimitsResponse'
  { -- | The maximum total read capacity units that your account allows you to
    -- provision across all of your tables in this Region.
    DescribeLimitsResponse -> Maybe Natural
accountMaxReadCapacityUnits :: Prelude.Maybe Prelude.Natural,
    -- | The maximum total write capacity units that your account allows you to
    -- provision across all of your tables in this Region.
    DescribeLimitsResponse -> Maybe Natural
accountMaxWriteCapacityUnits :: Prelude.Maybe Prelude.Natural,
    -- | The maximum read capacity units that your account allows you to
    -- provision for a new table that you are creating in this Region,
    -- including the read capacity units provisioned for its global secondary
    -- indexes (GSIs).
    DescribeLimitsResponse -> Maybe Natural
tableMaxReadCapacityUnits :: Prelude.Maybe Prelude.Natural,
    -- | The maximum write capacity units that your account allows you to
    -- provision for a new table that you are creating in this Region,
    -- including the write capacity units provisioned for its global secondary
    -- indexes (GSIs).
    DescribeLimitsResponse -> Maybe Natural
tableMaxWriteCapacityUnits :: Prelude.Maybe Prelude.Natural,
    -- | The response's http status code.
    DescribeLimitsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeLimitsResponse -> DescribeLimitsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeLimitsResponse -> DescribeLimitsResponse -> Bool
$c/= :: DescribeLimitsResponse -> DescribeLimitsResponse -> Bool
== :: DescribeLimitsResponse -> DescribeLimitsResponse -> Bool
$c== :: DescribeLimitsResponse -> DescribeLimitsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeLimitsResponse]
ReadPrec DescribeLimitsResponse
Int -> ReadS DescribeLimitsResponse
ReadS [DescribeLimitsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeLimitsResponse]
$creadListPrec :: ReadPrec [DescribeLimitsResponse]
readPrec :: ReadPrec DescribeLimitsResponse
$creadPrec :: ReadPrec DescribeLimitsResponse
readList :: ReadS [DescribeLimitsResponse]
$creadList :: ReadS [DescribeLimitsResponse]
readsPrec :: Int -> ReadS DescribeLimitsResponse
$creadsPrec :: Int -> ReadS DescribeLimitsResponse
Prelude.Read, Int -> DescribeLimitsResponse -> ShowS
[DescribeLimitsResponse] -> ShowS
DescribeLimitsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeLimitsResponse] -> ShowS
$cshowList :: [DescribeLimitsResponse] -> ShowS
show :: DescribeLimitsResponse -> String
$cshow :: DescribeLimitsResponse -> String
showsPrec :: Int -> DescribeLimitsResponse -> ShowS
$cshowsPrec :: Int -> DescribeLimitsResponse -> ShowS
Prelude.Show, forall x. Rep DescribeLimitsResponse x -> DescribeLimitsResponse
forall x. DescribeLimitsResponse -> Rep DescribeLimitsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeLimitsResponse x -> DescribeLimitsResponse
$cfrom :: forall x. DescribeLimitsResponse -> Rep DescribeLimitsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeLimitsResponse' 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:
--
-- 'accountMaxReadCapacityUnits', 'describeLimitsResponse_accountMaxReadCapacityUnits' - The maximum total read capacity units that your account allows you to
-- provision across all of your tables in this Region.
--
-- 'accountMaxWriteCapacityUnits', 'describeLimitsResponse_accountMaxWriteCapacityUnits' - The maximum total write capacity units that your account allows you to
-- provision across all of your tables in this Region.
--
-- 'tableMaxReadCapacityUnits', 'describeLimitsResponse_tableMaxReadCapacityUnits' - The maximum read capacity units that your account allows you to
-- provision for a new table that you are creating in this Region,
-- including the read capacity units provisioned for its global secondary
-- indexes (GSIs).
--
-- 'tableMaxWriteCapacityUnits', 'describeLimitsResponse_tableMaxWriteCapacityUnits' - The maximum write capacity units that your account allows you to
-- provision for a new table that you are creating in this Region,
-- including the write capacity units provisioned for its global secondary
-- indexes (GSIs).
--
-- 'httpStatus', 'describeLimitsResponse_httpStatus' - The response's http status code.
newDescribeLimitsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeLimitsResponse
newDescribeLimitsResponse :: Int -> DescribeLimitsResponse
newDescribeLimitsResponse Int
pHttpStatus_ =
  DescribeLimitsResponse'
    { $sel:accountMaxReadCapacityUnits:DescribeLimitsResponse' :: Maybe Natural
accountMaxReadCapacityUnits =
        forall a. Maybe a
Prelude.Nothing,
      $sel:accountMaxWriteCapacityUnits:DescribeLimitsResponse' :: Maybe Natural
accountMaxWriteCapacityUnits = forall a. Maybe a
Prelude.Nothing,
      $sel:tableMaxReadCapacityUnits:DescribeLimitsResponse' :: Maybe Natural
tableMaxReadCapacityUnits = forall a. Maybe a
Prelude.Nothing,
      $sel:tableMaxWriteCapacityUnits:DescribeLimitsResponse' :: Maybe Natural
tableMaxWriteCapacityUnits = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeLimitsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The maximum total read capacity units that your account allows you to
-- provision across all of your tables in this Region.
describeLimitsResponse_accountMaxReadCapacityUnits :: Lens.Lens' DescribeLimitsResponse (Prelude.Maybe Prelude.Natural)
describeLimitsResponse_accountMaxReadCapacityUnits :: Lens' DescribeLimitsResponse (Maybe Natural)
describeLimitsResponse_accountMaxReadCapacityUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLimitsResponse' {Maybe Natural
accountMaxReadCapacityUnits :: Maybe Natural
$sel:accountMaxReadCapacityUnits:DescribeLimitsResponse' :: DescribeLimitsResponse -> Maybe Natural
accountMaxReadCapacityUnits} -> Maybe Natural
accountMaxReadCapacityUnits) (\s :: DescribeLimitsResponse
s@DescribeLimitsResponse' {} Maybe Natural
a -> DescribeLimitsResponse
s {$sel:accountMaxReadCapacityUnits:DescribeLimitsResponse' :: Maybe Natural
accountMaxReadCapacityUnits = Maybe Natural
a} :: DescribeLimitsResponse)

-- | The maximum total write capacity units that your account allows you to
-- provision across all of your tables in this Region.
describeLimitsResponse_accountMaxWriteCapacityUnits :: Lens.Lens' DescribeLimitsResponse (Prelude.Maybe Prelude.Natural)
describeLimitsResponse_accountMaxWriteCapacityUnits :: Lens' DescribeLimitsResponse (Maybe Natural)
describeLimitsResponse_accountMaxWriteCapacityUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLimitsResponse' {Maybe Natural
accountMaxWriteCapacityUnits :: Maybe Natural
$sel:accountMaxWriteCapacityUnits:DescribeLimitsResponse' :: DescribeLimitsResponse -> Maybe Natural
accountMaxWriteCapacityUnits} -> Maybe Natural
accountMaxWriteCapacityUnits) (\s :: DescribeLimitsResponse
s@DescribeLimitsResponse' {} Maybe Natural
a -> DescribeLimitsResponse
s {$sel:accountMaxWriteCapacityUnits:DescribeLimitsResponse' :: Maybe Natural
accountMaxWriteCapacityUnits = Maybe Natural
a} :: DescribeLimitsResponse)

-- | The maximum read capacity units that your account allows you to
-- provision for a new table that you are creating in this Region,
-- including the read capacity units provisioned for its global secondary
-- indexes (GSIs).
describeLimitsResponse_tableMaxReadCapacityUnits :: Lens.Lens' DescribeLimitsResponse (Prelude.Maybe Prelude.Natural)
describeLimitsResponse_tableMaxReadCapacityUnits :: Lens' DescribeLimitsResponse (Maybe Natural)
describeLimitsResponse_tableMaxReadCapacityUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLimitsResponse' {Maybe Natural
tableMaxReadCapacityUnits :: Maybe Natural
$sel:tableMaxReadCapacityUnits:DescribeLimitsResponse' :: DescribeLimitsResponse -> Maybe Natural
tableMaxReadCapacityUnits} -> Maybe Natural
tableMaxReadCapacityUnits) (\s :: DescribeLimitsResponse
s@DescribeLimitsResponse' {} Maybe Natural
a -> DescribeLimitsResponse
s {$sel:tableMaxReadCapacityUnits:DescribeLimitsResponse' :: Maybe Natural
tableMaxReadCapacityUnits = Maybe Natural
a} :: DescribeLimitsResponse)

-- | The maximum write capacity units that your account allows you to
-- provision for a new table that you are creating in this Region,
-- including the write capacity units provisioned for its global secondary
-- indexes (GSIs).
describeLimitsResponse_tableMaxWriteCapacityUnits :: Lens.Lens' DescribeLimitsResponse (Prelude.Maybe Prelude.Natural)
describeLimitsResponse_tableMaxWriteCapacityUnits :: Lens' DescribeLimitsResponse (Maybe Natural)
describeLimitsResponse_tableMaxWriteCapacityUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLimitsResponse' {Maybe Natural
tableMaxWriteCapacityUnits :: Maybe Natural
$sel:tableMaxWriteCapacityUnits:DescribeLimitsResponse' :: DescribeLimitsResponse -> Maybe Natural
tableMaxWriteCapacityUnits} -> Maybe Natural
tableMaxWriteCapacityUnits) (\s :: DescribeLimitsResponse
s@DescribeLimitsResponse' {} Maybe Natural
a -> DescribeLimitsResponse
s {$sel:tableMaxWriteCapacityUnits:DescribeLimitsResponse' :: Maybe Natural
tableMaxWriteCapacityUnits = Maybe Natural
a} :: DescribeLimitsResponse)

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

instance Prelude.NFData DescribeLimitsResponse where
  rnf :: DescribeLimitsResponse -> ()
rnf DescribeLimitsResponse' {Int
Maybe Natural
httpStatus :: Int
tableMaxWriteCapacityUnits :: Maybe Natural
tableMaxReadCapacityUnits :: Maybe Natural
accountMaxWriteCapacityUnits :: Maybe Natural
accountMaxReadCapacityUnits :: Maybe Natural
$sel:httpStatus:DescribeLimitsResponse' :: DescribeLimitsResponse -> Int
$sel:tableMaxWriteCapacityUnits:DescribeLimitsResponse' :: DescribeLimitsResponse -> Maybe Natural
$sel:tableMaxReadCapacityUnits:DescribeLimitsResponse' :: DescribeLimitsResponse -> Maybe Natural
$sel:accountMaxWriteCapacityUnits:DescribeLimitsResponse' :: DescribeLimitsResponse -> Maybe Natural
$sel:accountMaxReadCapacityUnits:DescribeLimitsResponse' :: DescribeLimitsResponse -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
accountMaxReadCapacityUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
accountMaxWriteCapacityUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
tableMaxReadCapacityUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
tableMaxWriteCapacityUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus