{-# 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.UpdateShardCount
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the shard count of the specified stream to the specified number
-- of shards. This API is only supported for the data streams with the
-- provisioned capacity mode.
--
-- When invoking this API, it is recommended you use the @StreamARN@ input
-- parameter rather than the @StreamName@ input parameter.
--
-- Updating the shard count is an asynchronous operation. Upon receiving
-- the request, Kinesis Data Streams returns immediately and sets the
-- status of the stream to @UPDATING@. After the update is complete,
-- Kinesis Data Streams sets the status of the stream back to @ACTIVE@.
-- Depending on the size of the stream, the scaling action could take a few
-- minutes to complete. You can continue to read and write data to your
-- stream while its status is @UPDATING@.
--
-- To update the shard count, Kinesis Data Streams performs splits or
-- merges on individual shards. This can cause short-lived shards to be
-- created, in addition to the final shards. These short-lived shards count
-- towards your total shard limit for your account in the Region.
--
-- When using this operation, we recommend that you specify a target shard
-- count that is a multiple of 25% (25%, 50%, 75%, 100%). You can specify
-- any target value within your shard limit. However, if you specify a
-- target that isn\'t a multiple of 25%, the scaling action might take
-- longer to complete.
--
-- This operation has the following default limits. By default, you cannot
-- do the following:
--
-- -   Scale more than ten times per rolling 24-hour period per stream
--
-- -   Scale up to more than double your current shard count for a stream
--
-- -   Scale down below half your current shard count for a stream
--
-- -   Scale up to more than 10000 shards in a stream
--
-- -   Scale a stream with more than 10000 shards down unless the result is
--     less than 10000 shards
--
-- -   Scale up to more than the shard limit for your account
--
-- For the default limits for an Amazon Web Services account, see
-- <https://docs.aws.amazon.com/kinesis/latest/dev/service-sizes-and-limits.html Streams Limits>
-- in the /Amazon Kinesis Data Streams Developer Guide/. To request an
-- increase in the call rate limit, the shard limit for this API, or your
-- overall shard limit, use the
-- <https://console.aws.amazon.com/support/v1#/case/create?issueType=service-limit-increase&limitType=service-code-kinesis limits form>.
module Amazonka.Kinesis.UpdateShardCount
  ( -- * Creating a Request
    UpdateShardCount (..),
    newUpdateShardCount,

    -- * Request Lenses
    updateShardCount_streamARN,
    updateShardCount_streamName,
    updateShardCount_targetShardCount,
    updateShardCount_scalingType,

    -- * Destructuring the Response
    UpdateShardCountResponse (..),
    newUpdateShardCountResponse,

    -- * Response Lenses
    updateShardCountResponse_currentShardCount,
    updateShardCountResponse_streamARN,
    updateShardCountResponse_streamName,
    updateShardCountResponse_targetShardCount,
    updateShardCountResponse_httpStatus,
  )
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:/ 'newUpdateShardCount' smart constructor.
data UpdateShardCount = UpdateShardCount'
  { -- | The ARN of the stream.
    UpdateShardCount -> Maybe Text
streamARN :: Prelude.Maybe Prelude.Text,
    -- | The name of the stream.
    UpdateShardCount -> Maybe Text
streamName :: Prelude.Maybe Prelude.Text,
    -- | The new number of shards. This value has the following default limits.
    -- By default, you cannot do the following:
    --
    -- -   Set this value to more than double your current shard count for a
    --     stream.
    --
    -- -   Set this value below half your current shard count for a stream.
    --
    -- -   Set this value to more than 10000 shards in a stream (the default
    --     limit for shard count per stream is 10000 per account per region),
    --     unless you request a limit increase.
    --
    -- -   Scale a stream with more than 10000 shards down unless you set this
    --     value to less than 10000 shards.
    UpdateShardCount -> Natural
targetShardCount :: Prelude.Natural,
    -- | The scaling type. Uniform scaling creates shards of equal size.
    UpdateShardCount -> ScalingType
scalingType :: ScalingType
  }
  deriving (UpdateShardCount -> UpdateShardCount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateShardCount -> UpdateShardCount -> Bool
$c/= :: UpdateShardCount -> UpdateShardCount -> Bool
== :: UpdateShardCount -> UpdateShardCount -> Bool
$c== :: UpdateShardCount -> UpdateShardCount -> Bool
Prelude.Eq, ReadPrec [UpdateShardCount]
ReadPrec UpdateShardCount
Int -> ReadS UpdateShardCount
ReadS [UpdateShardCount]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateShardCount]
$creadListPrec :: ReadPrec [UpdateShardCount]
readPrec :: ReadPrec UpdateShardCount
$creadPrec :: ReadPrec UpdateShardCount
readList :: ReadS [UpdateShardCount]
$creadList :: ReadS [UpdateShardCount]
readsPrec :: Int -> ReadS UpdateShardCount
$creadsPrec :: Int -> ReadS UpdateShardCount
Prelude.Read, Int -> UpdateShardCount -> ShowS
[UpdateShardCount] -> ShowS
UpdateShardCount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateShardCount] -> ShowS
$cshowList :: [UpdateShardCount] -> ShowS
show :: UpdateShardCount -> String
$cshow :: UpdateShardCount -> String
showsPrec :: Int -> UpdateShardCount -> ShowS
$cshowsPrec :: Int -> UpdateShardCount -> ShowS
Prelude.Show, forall x. Rep UpdateShardCount x -> UpdateShardCount
forall x. UpdateShardCount -> Rep UpdateShardCount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateShardCount x -> UpdateShardCount
$cfrom :: forall x. UpdateShardCount -> Rep UpdateShardCount x
Prelude.Generic)

-- |
-- Create a value of 'UpdateShardCount' 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:
--
-- 'streamARN', 'updateShardCount_streamARN' - The ARN of the stream.
--
-- 'streamName', 'updateShardCount_streamName' - The name of the stream.
--
-- 'targetShardCount', 'updateShardCount_targetShardCount' - The new number of shards. This value has the following default limits.
-- By default, you cannot do the following:
--
-- -   Set this value to more than double your current shard count for a
--     stream.
--
-- -   Set this value below half your current shard count for a stream.
--
-- -   Set this value to more than 10000 shards in a stream (the default
--     limit for shard count per stream is 10000 per account per region),
--     unless you request a limit increase.
--
-- -   Scale a stream with more than 10000 shards down unless you set this
--     value to less than 10000 shards.
--
-- 'scalingType', 'updateShardCount_scalingType' - The scaling type. Uniform scaling creates shards of equal size.
newUpdateShardCount ::
  -- | 'targetShardCount'
  Prelude.Natural ->
  -- | 'scalingType'
  ScalingType ->
  UpdateShardCount
newUpdateShardCount :: Natural -> ScalingType -> UpdateShardCount
newUpdateShardCount Natural
pTargetShardCount_ ScalingType
pScalingType_ =
  UpdateShardCount'
    { $sel:streamARN:UpdateShardCount' :: Maybe Text
streamARN = forall a. Maybe a
Prelude.Nothing,
      $sel:streamName:UpdateShardCount' :: Maybe Text
streamName = forall a. Maybe a
Prelude.Nothing,
      $sel:targetShardCount:UpdateShardCount' :: Natural
targetShardCount = Natural
pTargetShardCount_,
      $sel:scalingType:UpdateShardCount' :: ScalingType
scalingType = ScalingType
pScalingType_
    }

-- | The ARN of the stream.
updateShardCount_streamARN :: Lens.Lens' UpdateShardCount (Prelude.Maybe Prelude.Text)
updateShardCount_streamARN :: Lens' UpdateShardCount (Maybe Text)
updateShardCount_streamARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateShardCount' {Maybe Text
streamARN :: Maybe Text
$sel:streamARN:UpdateShardCount' :: UpdateShardCount -> Maybe Text
streamARN} -> Maybe Text
streamARN) (\s :: UpdateShardCount
s@UpdateShardCount' {} Maybe Text
a -> UpdateShardCount
s {$sel:streamARN:UpdateShardCount' :: Maybe Text
streamARN = Maybe Text
a} :: UpdateShardCount)

-- | The name of the stream.
updateShardCount_streamName :: Lens.Lens' UpdateShardCount (Prelude.Maybe Prelude.Text)
updateShardCount_streamName :: Lens' UpdateShardCount (Maybe Text)
updateShardCount_streamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateShardCount' {Maybe Text
streamName :: Maybe Text
$sel:streamName:UpdateShardCount' :: UpdateShardCount -> Maybe Text
streamName} -> Maybe Text
streamName) (\s :: UpdateShardCount
s@UpdateShardCount' {} Maybe Text
a -> UpdateShardCount
s {$sel:streamName:UpdateShardCount' :: Maybe Text
streamName = Maybe Text
a} :: UpdateShardCount)

-- | The new number of shards. This value has the following default limits.
-- By default, you cannot do the following:
--
-- -   Set this value to more than double your current shard count for a
--     stream.
--
-- -   Set this value below half your current shard count for a stream.
--
-- -   Set this value to more than 10000 shards in a stream (the default
--     limit for shard count per stream is 10000 per account per region),
--     unless you request a limit increase.
--
-- -   Scale a stream with more than 10000 shards down unless you set this
--     value to less than 10000 shards.
updateShardCount_targetShardCount :: Lens.Lens' UpdateShardCount Prelude.Natural
updateShardCount_targetShardCount :: Lens' UpdateShardCount Natural
updateShardCount_targetShardCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateShardCount' {Natural
targetShardCount :: Natural
$sel:targetShardCount:UpdateShardCount' :: UpdateShardCount -> Natural
targetShardCount} -> Natural
targetShardCount) (\s :: UpdateShardCount
s@UpdateShardCount' {} Natural
a -> UpdateShardCount
s {$sel:targetShardCount:UpdateShardCount' :: Natural
targetShardCount = Natural
a} :: UpdateShardCount)

-- | The scaling type. Uniform scaling creates shards of equal size.
updateShardCount_scalingType :: Lens.Lens' UpdateShardCount ScalingType
updateShardCount_scalingType :: Lens' UpdateShardCount ScalingType
updateShardCount_scalingType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateShardCount' {ScalingType
scalingType :: ScalingType
$sel:scalingType:UpdateShardCount' :: UpdateShardCount -> ScalingType
scalingType} -> ScalingType
scalingType) (\s :: UpdateShardCount
s@UpdateShardCount' {} ScalingType
a -> UpdateShardCount
s {$sel:scalingType:UpdateShardCount' :: ScalingType
scalingType = ScalingType
a} :: UpdateShardCount)

instance Core.AWSRequest UpdateShardCount where
  type
    AWSResponse UpdateShardCount =
      UpdateShardCountResponse
  request :: (Service -> Service)
-> UpdateShardCount -> Request UpdateShardCount
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 UpdateShardCount
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateShardCount)))
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 Text
-> Maybe Text
-> Maybe Natural
-> Int
-> UpdateShardCountResponse
UpdateShardCountResponse'
            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
"CurrentShardCount")
            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
"StreamARN")
            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
"StreamName")
            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
"TargetShardCount")
            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 UpdateShardCount where
  hashWithSalt :: Int -> UpdateShardCount -> Int
hashWithSalt Int
_salt UpdateShardCount' {Natural
Maybe Text
ScalingType
scalingType :: ScalingType
targetShardCount :: Natural
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:scalingType:UpdateShardCount' :: UpdateShardCount -> ScalingType
$sel:targetShardCount:UpdateShardCount' :: UpdateShardCount -> Natural
$sel:streamName:UpdateShardCount' :: UpdateShardCount -> Maybe Text
$sel:streamARN:UpdateShardCount' :: UpdateShardCount -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
streamARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
streamName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
targetShardCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ScalingType
scalingType

instance Prelude.NFData UpdateShardCount where
  rnf :: UpdateShardCount -> ()
rnf UpdateShardCount' {Natural
Maybe Text
ScalingType
scalingType :: ScalingType
targetShardCount :: Natural
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:scalingType:UpdateShardCount' :: UpdateShardCount -> ScalingType
$sel:targetShardCount:UpdateShardCount' :: UpdateShardCount -> Natural
$sel:streamName:UpdateShardCount' :: UpdateShardCount -> Maybe Text
$sel:streamARN:UpdateShardCount' :: UpdateShardCount -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
targetShardCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ScalingType
scalingType

instance Data.ToHeaders UpdateShardCount where
  toHeaders :: UpdateShardCount -> 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.UpdateShardCount" ::
                          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 UpdateShardCount where
  toJSON :: UpdateShardCount -> Value
toJSON UpdateShardCount' {Natural
Maybe Text
ScalingType
scalingType :: ScalingType
targetShardCount :: Natural
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:scalingType:UpdateShardCount' :: UpdateShardCount -> ScalingType
$sel:targetShardCount:UpdateShardCount' :: UpdateShardCount -> Natural
$sel:streamName:UpdateShardCount' :: UpdateShardCount -> Maybe Text
$sel:streamARN:UpdateShardCount' :: UpdateShardCount -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"StreamARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
streamARN,
            (Key
"StreamName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
streamName,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TargetShardCount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
targetShardCount),
            forall a. a -> Maybe a
Prelude.Just (Key
"ScalingType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ScalingType
scalingType)
          ]
      )

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

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

-- | /See:/ 'newUpdateShardCountResponse' smart constructor.
data UpdateShardCountResponse = UpdateShardCountResponse'
  { -- | The current number of shards.
    UpdateShardCountResponse -> Maybe Natural
currentShardCount :: Prelude.Maybe Prelude.Natural,
    -- | The ARN of the stream.
    UpdateShardCountResponse -> Maybe Text
streamARN :: Prelude.Maybe Prelude.Text,
    -- | The name of the stream.
    UpdateShardCountResponse -> Maybe Text
streamName :: Prelude.Maybe Prelude.Text,
    -- | The updated number of shards.
    UpdateShardCountResponse -> Maybe Natural
targetShardCount :: Prelude.Maybe Prelude.Natural,
    -- | The response's http status code.
    UpdateShardCountResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateShardCountResponse -> UpdateShardCountResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateShardCountResponse -> UpdateShardCountResponse -> Bool
$c/= :: UpdateShardCountResponse -> UpdateShardCountResponse -> Bool
== :: UpdateShardCountResponse -> UpdateShardCountResponse -> Bool
$c== :: UpdateShardCountResponse -> UpdateShardCountResponse -> Bool
Prelude.Eq, ReadPrec [UpdateShardCountResponse]
ReadPrec UpdateShardCountResponse
Int -> ReadS UpdateShardCountResponse
ReadS [UpdateShardCountResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateShardCountResponse]
$creadListPrec :: ReadPrec [UpdateShardCountResponse]
readPrec :: ReadPrec UpdateShardCountResponse
$creadPrec :: ReadPrec UpdateShardCountResponse
readList :: ReadS [UpdateShardCountResponse]
$creadList :: ReadS [UpdateShardCountResponse]
readsPrec :: Int -> ReadS UpdateShardCountResponse
$creadsPrec :: Int -> ReadS UpdateShardCountResponse
Prelude.Read, Int -> UpdateShardCountResponse -> ShowS
[UpdateShardCountResponse] -> ShowS
UpdateShardCountResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateShardCountResponse] -> ShowS
$cshowList :: [UpdateShardCountResponse] -> ShowS
show :: UpdateShardCountResponse -> String
$cshow :: UpdateShardCountResponse -> String
showsPrec :: Int -> UpdateShardCountResponse -> ShowS
$cshowsPrec :: Int -> UpdateShardCountResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateShardCountResponse x -> UpdateShardCountResponse
forall x.
UpdateShardCountResponse -> Rep UpdateShardCountResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateShardCountResponse x -> UpdateShardCountResponse
$cfrom :: forall x.
UpdateShardCountResponse -> Rep UpdateShardCountResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateShardCountResponse' 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:
--
-- 'currentShardCount', 'updateShardCountResponse_currentShardCount' - The current number of shards.
--
-- 'streamARN', 'updateShardCountResponse_streamARN' - The ARN of the stream.
--
-- 'streamName', 'updateShardCountResponse_streamName' - The name of the stream.
--
-- 'targetShardCount', 'updateShardCountResponse_targetShardCount' - The updated number of shards.
--
-- 'httpStatus', 'updateShardCountResponse_httpStatus' - The response's http status code.
newUpdateShardCountResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateShardCountResponse
newUpdateShardCountResponse :: Int -> UpdateShardCountResponse
newUpdateShardCountResponse Int
pHttpStatus_ =
  UpdateShardCountResponse'
    { $sel:currentShardCount:UpdateShardCountResponse' :: Maybe Natural
currentShardCount =
        forall a. Maybe a
Prelude.Nothing,
      $sel:streamARN:UpdateShardCountResponse' :: Maybe Text
streamARN = forall a. Maybe a
Prelude.Nothing,
      $sel:streamName:UpdateShardCountResponse' :: Maybe Text
streamName = forall a. Maybe a
Prelude.Nothing,
      $sel:targetShardCount:UpdateShardCountResponse' :: Maybe Natural
targetShardCount = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateShardCountResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The current number of shards.
updateShardCountResponse_currentShardCount :: Lens.Lens' UpdateShardCountResponse (Prelude.Maybe Prelude.Natural)
updateShardCountResponse_currentShardCount :: Lens' UpdateShardCountResponse (Maybe Natural)
updateShardCountResponse_currentShardCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateShardCountResponse' {Maybe Natural
currentShardCount :: Maybe Natural
$sel:currentShardCount:UpdateShardCountResponse' :: UpdateShardCountResponse -> Maybe Natural
currentShardCount} -> Maybe Natural
currentShardCount) (\s :: UpdateShardCountResponse
s@UpdateShardCountResponse' {} Maybe Natural
a -> UpdateShardCountResponse
s {$sel:currentShardCount:UpdateShardCountResponse' :: Maybe Natural
currentShardCount = Maybe Natural
a} :: UpdateShardCountResponse)

-- | The ARN of the stream.
updateShardCountResponse_streamARN :: Lens.Lens' UpdateShardCountResponse (Prelude.Maybe Prelude.Text)
updateShardCountResponse_streamARN :: Lens' UpdateShardCountResponse (Maybe Text)
updateShardCountResponse_streamARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateShardCountResponse' {Maybe Text
streamARN :: Maybe Text
$sel:streamARN:UpdateShardCountResponse' :: UpdateShardCountResponse -> Maybe Text
streamARN} -> Maybe Text
streamARN) (\s :: UpdateShardCountResponse
s@UpdateShardCountResponse' {} Maybe Text
a -> UpdateShardCountResponse
s {$sel:streamARN:UpdateShardCountResponse' :: Maybe Text
streamARN = Maybe Text
a} :: UpdateShardCountResponse)

-- | The name of the stream.
updateShardCountResponse_streamName :: Lens.Lens' UpdateShardCountResponse (Prelude.Maybe Prelude.Text)
updateShardCountResponse_streamName :: Lens' UpdateShardCountResponse (Maybe Text)
updateShardCountResponse_streamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateShardCountResponse' {Maybe Text
streamName :: Maybe Text
$sel:streamName:UpdateShardCountResponse' :: UpdateShardCountResponse -> Maybe Text
streamName} -> Maybe Text
streamName) (\s :: UpdateShardCountResponse
s@UpdateShardCountResponse' {} Maybe Text
a -> UpdateShardCountResponse
s {$sel:streamName:UpdateShardCountResponse' :: Maybe Text
streamName = Maybe Text
a} :: UpdateShardCountResponse)

-- | The updated number of shards.
updateShardCountResponse_targetShardCount :: Lens.Lens' UpdateShardCountResponse (Prelude.Maybe Prelude.Natural)
updateShardCountResponse_targetShardCount :: Lens' UpdateShardCountResponse (Maybe Natural)
updateShardCountResponse_targetShardCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateShardCountResponse' {Maybe Natural
targetShardCount :: Maybe Natural
$sel:targetShardCount:UpdateShardCountResponse' :: UpdateShardCountResponse -> Maybe Natural
targetShardCount} -> Maybe Natural
targetShardCount) (\s :: UpdateShardCountResponse
s@UpdateShardCountResponse' {} Maybe Natural
a -> UpdateShardCountResponse
s {$sel:targetShardCount:UpdateShardCountResponse' :: Maybe Natural
targetShardCount = Maybe Natural
a} :: UpdateShardCountResponse)

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

instance Prelude.NFData UpdateShardCountResponse where
  rnf :: UpdateShardCountResponse -> ()
rnf UpdateShardCountResponse' {Int
Maybe Natural
Maybe Text
httpStatus :: Int
targetShardCount :: Maybe Natural
streamName :: Maybe Text
streamARN :: Maybe Text
currentShardCount :: Maybe Natural
$sel:httpStatus:UpdateShardCountResponse' :: UpdateShardCountResponse -> Int
$sel:targetShardCount:UpdateShardCountResponse' :: UpdateShardCountResponse -> Maybe Natural
$sel:streamName:UpdateShardCountResponse' :: UpdateShardCountResponse -> Maybe Text
$sel:streamARN:UpdateShardCountResponse' :: UpdateShardCountResponse -> Maybe Text
$sel:currentShardCount:UpdateShardCountResponse' :: UpdateShardCountResponse -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
currentShardCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
targetShardCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus