{-# 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.Kinesis.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)
--
-- Describes the shard limits and usage for the account.
--
-- If you update your account limits, the old limits might be returned for
-- a few minutes.
--
-- This operation has a limit of one transaction per second per account.
module Amazonka.Kinesis.DescribeLimits
  ( -- * Creating a Request
    DescribeLimits (..),
    newDescribeLimits,

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

    -- * Response Lenses
    describeLimitsResponse_httpStatus,
    describeLimitsResponse_shardLimit,
    describeLimitsResponse_openShardCount,
    describeLimitsResponse_onDemandStreamCount,
    describeLimitsResponse_onDemandStreamCountLimit,
  )
where

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

-- | /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 ->
          Int
-> Natural
-> Natural
-> Natural
-> Natural
-> DescribeLimitsResponse
DescribeLimitsResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ShardLimit")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"OpenShardCount")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"OnDemandStreamCount")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"OnDemandStreamCountLimit")
      )

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
"Kinesis_20131202.DescribeLimits" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          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

-- | /See:/ 'newDescribeLimitsResponse' smart constructor.
data DescribeLimitsResponse = DescribeLimitsResponse'
  { -- | The response's http status code.
    DescribeLimitsResponse -> Int
httpStatus :: Prelude.Int,
    -- | The maximum number of shards.
    DescribeLimitsResponse -> Natural
shardLimit :: Prelude.Natural,
    -- | The number of open shards.
    DescribeLimitsResponse -> Natural
openShardCount :: Prelude.Natural,
    -- | Indicates the number of data streams with the on-demand capacity mode.
    DescribeLimitsResponse -> Natural
onDemandStreamCount :: Prelude.Natural,
    -- | The maximum number of data streams with the on-demand capacity mode.
    DescribeLimitsResponse -> Natural
onDemandStreamCountLimit :: Prelude.Natural
  }
  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:
--
-- 'httpStatus', 'describeLimitsResponse_httpStatus' - The response's http status code.
--
-- 'shardLimit', 'describeLimitsResponse_shardLimit' - The maximum number of shards.
--
-- 'openShardCount', 'describeLimitsResponse_openShardCount' - The number of open shards.
--
-- 'onDemandStreamCount', 'describeLimitsResponse_onDemandStreamCount' - Indicates the number of data streams with the on-demand capacity mode.
--
-- 'onDemandStreamCountLimit', 'describeLimitsResponse_onDemandStreamCountLimit' - The maximum number of data streams with the on-demand capacity mode.
newDescribeLimitsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'shardLimit'
  Prelude.Natural ->
  -- | 'openShardCount'
  Prelude.Natural ->
  -- | 'onDemandStreamCount'
  Prelude.Natural ->
  -- | 'onDemandStreamCountLimit'
  Prelude.Natural ->
  DescribeLimitsResponse
newDescribeLimitsResponse :: Int
-> Natural
-> Natural
-> Natural
-> Natural
-> DescribeLimitsResponse
newDescribeLimitsResponse
  Int
pHttpStatus_
  Natural
pShardLimit_
  Natural
pOpenShardCount_
  Natural
pOnDemandStreamCount_
  Natural
pOnDemandStreamCountLimit_ =
    DescribeLimitsResponse'
      { $sel:httpStatus:DescribeLimitsResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:shardLimit:DescribeLimitsResponse' :: Natural
shardLimit = Natural
pShardLimit_,
        $sel:openShardCount:DescribeLimitsResponse' :: Natural
openShardCount = Natural
pOpenShardCount_,
        $sel:onDemandStreamCount:DescribeLimitsResponse' :: Natural
onDemandStreamCount = Natural
pOnDemandStreamCount_,
        $sel:onDemandStreamCountLimit:DescribeLimitsResponse' :: Natural
onDemandStreamCountLimit =
          Natural
pOnDemandStreamCountLimit_
      }

-- | 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)

-- | The maximum number of shards.
describeLimitsResponse_shardLimit :: Lens.Lens' DescribeLimitsResponse Prelude.Natural
describeLimitsResponse_shardLimit :: Lens' DescribeLimitsResponse Natural
describeLimitsResponse_shardLimit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLimitsResponse' {Natural
shardLimit :: Natural
$sel:shardLimit:DescribeLimitsResponse' :: DescribeLimitsResponse -> Natural
shardLimit} -> Natural
shardLimit) (\s :: DescribeLimitsResponse
s@DescribeLimitsResponse' {} Natural
a -> DescribeLimitsResponse
s {$sel:shardLimit:DescribeLimitsResponse' :: Natural
shardLimit = Natural
a} :: DescribeLimitsResponse)

-- | The number of open shards.
describeLimitsResponse_openShardCount :: Lens.Lens' DescribeLimitsResponse Prelude.Natural
describeLimitsResponse_openShardCount :: Lens' DescribeLimitsResponse Natural
describeLimitsResponse_openShardCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLimitsResponse' {Natural
openShardCount :: Natural
$sel:openShardCount:DescribeLimitsResponse' :: DescribeLimitsResponse -> Natural
openShardCount} -> Natural
openShardCount) (\s :: DescribeLimitsResponse
s@DescribeLimitsResponse' {} Natural
a -> DescribeLimitsResponse
s {$sel:openShardCount:DescribeLimitsResponse' :: Natural
openShardCount = Natural
a} :: DescribeLimitsResponse)

-- | Indicates the number of data streams with the on-demand capacity mode.
describeLimitsResponse_onDemandStreamCount :: Lens.Lens' DescribeLimitsResponse Prelude.Natural
describeLimitsResponse_onDemandStreamCount :: Lens' DescribeLimitsResponse Natural
describeLimitsResponse_onDemandStreamCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLimitsResponse' {Natural
onDemandStreamCount :: Natural
$sel:onDemandStreamCount:DescribeLimitsResponse' :: DescribeLimitsResponse -> Natural
onDemandStreamCount} -> Natural
onDemandStreamCount) (\s :: DescribeLimitsResponse
s@DescribeLimitsResponse' {} Natural
a -> DescribeLimitsResponse
s {$sel:onDemandStreamCount:DescribeLimitsResponse' :: Natural
onDemandStreamCount = Natural
a} :: DescribeLimitsResponse)

-- | The maximum number of data streams with the on-demand capacity mode.
describeLimitsResponse_onDemandStreamCountLimit :: Lens.Lens' DescribeLimitsResponse Prelude.Natural
describeLimitsResponse_onDemandStreamCountLimit :: Lens' DescribeLimitsResponse Natural
describeLimitsResponse_onDemandStreamCountLimit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLimitsResponse' {Natural
onDemandStreamCountLimit :: Natural
$sel:onDemandStreamCountLimit:DescribeLimitsResponse' :: DescribeLimitsResponse -> Natural
onDemandStreamCountLimit} -> Natural
onDemandStreamCountLimit) (\s :: DescribeLimitsResponse
s@DescribeLimitsResponse' {} Natural
a -> DescribeLimitsResponse
s {$sel:onDemandStreamCountLimit:DescribeLimitsResponse' :: Natural
onDemandStreamCountLimit = Natural
a} :: DescribeLimitsResponse)

instance Prelude.NFData DescribeLimitsResponse where
  rnf :: DescribeLimitsResponse -> ()
rnf DescribeLimitsResponse' {Int
Natural
onDemandStreamCountLimit :: Natural
onDemandStreamCount :: Natural
openShardCount :: Natural
shardLimit :: Natural
httpStatus :: Int
$sel:onDemandStreamCountLimit:DescribeLimitsResponse' :: DescribeLimitsResponse -> Natural
$sel:onDemandStreamCount:DescribeLimitsResponse' :: DescribeLimitsResponse -> Natural
$sel:openShardCount:DescribeLimitsResponse' :: DescribeLimitsResponse -> Natural
$sel:shardLimit:DescribeLimitsResponse' :: DescribeLimitsResponse -> Natural
$sel:httpStatus:DescribeLimitsResponse' :: DescribeLimitsResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
shardLimit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
openShardCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
onDemandStreamCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
onDemandStreamCountLimit