{-# 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.UpdateTableReplicaAutoScaling
-- 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 auto scaling settings on your global tables at once.
--
-- This operation only applies to
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/globaltables.V2.html Version 2019.11.21>
-- of global tables.
module Amazonka.DynamoDB.UpdateTableReplicaAutoScaling
  ( -- * Creating a Request
    UpdateTableReplicaAutoScaling (..),
    newUpdateTableReplicaAutoScaling,

    -- * Request Lenses
    updateTableReplicaAutoScaling_globalSecondaryIndexUpdates,
    updateTableReplicaAutoScaling_provisionedWriteCapacityAutoScalingUpdate,
    updateTableReplicaAutoScaling_replicaUpdates,
    updateTableReplicaAutoScaling_tableName,

    -- * Destructuring the Response
    UpdateTableReplicaAutoScalingResponse (..),
    newUpdateTableReplicaAutoScalingResponse,

    -- * Response Lenses
    updateTableReplicaAutoScalingResponse_tableAutoScalingDescription,
    updateTableReplicaAutoScalingResponse_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

-- | /See:/ 'newUpdateTableReplicaAutoScaling' smart constructor.
data UpdateTableReplicaAutoScaling = UpdateTableReplicaAutoScaling'
  { -- | Represents the auto scaling settings of the global secondary indexes of
    -- the replica to be updated.
    UpdateTableReplicaAutoScaling
-> Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
globalSecondaryIndexUpdates :: Prelude.Maybe (Prelude.NonEmpty GlobalSecondaryIndexAutoScalingUpdate),
    UpdateTableReplicaAutoScaling -> Maybe AutoScalingSettingsUpdate
provisionedWriteCapacityAutoScalingUpdate :: Prelude.Maybe AutoScalingSettingsUpdate,
    -- | Represents the auto scaling settings of replicas of the table that will
    -- be modified.
    UpdateTableReplicaAutoScaling
-> Maybe (NonEmpty ReplicaAutoScalingUpdate)
replicaUpdates :: Prelude.Maybe (Prelude.NonEmpty ReplicaAutoScalingUpdate),
    -- | The name of the global table to be updated.
    UpdateTableReplicaAutoScaling -> Text
tableName :: Prelude.Text
  }
  deriving (UpdateTableReplicaAutoScaling
-> UpdateTableReplicaAutoScaling -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTableReplicaAutoScaling
-> UpdateTableReplicaAutoScaling -> Bool
$c/= :: UpdateTableReplicaAutoScaling
-> UpdateTableReplicaAutoScaling -> Bool
== :: UpdateTableReplicaAutoScaling
-> UpdateTableReplicaAutoScaling -> Bool
$c== :: UpdateTableReplicaAutoScaling
-> UpdateTableReplicaAutoScaling -> Bool
Prelude.Eq, ReadPrec [UpdateTableReplicaAutoScaling]
ReadPrec UpdateTableReplicaAutoScaling
Int -> ReadS UpdateTableReplicaAutoScaling
ReadS [UpdateTableReplicaAutoScaling]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTableReplicaAutoScaling]
$creadListPrec :: ReadPrec [UpdateTableReplicaAutoScaling]
readPrec :: ReadPrec UpdateTableReplicaAutoScaling
$creadPrec :: ReadPrec UpdateTableReplicaAutoScaling
readList :: ReadS [UpdateTableReplicaAutoScaling]
$creadList :: ReadS [UpdateTableReplicaAutoScaling]
readsPrec :: Int -> ReadS UpdateTableReplicaAutoScaling
$creadsPrec :: Int -> ReadS UpdateTableReplicaAutoScaling
Prelude.Read, Int -> UpdateTableReplicaAutoScaling -> ShowS
[UpdateTableReplicaAutoScaling] -> ShowS
UpdateTableReplicaAutoScaling -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTableReplicaAutoScaling] -> ShowS
$cshowList :: [UpdateTableReplicaAutoScaling] -> ShowS
show :: UpdateTableReplicaAutoScaling -> String
$cshow :: UpdateTableReplicaAutoScaling -> String
showsPrec :: Int -> UpdateTableReplicaAutoScaling -> ShowS
$cshowsPrec :: Int -> UpdateTableReplicaAutoScaling -> ShowS
Prelude.Show, forall x.
Rep UpdateTableReplicaAutoScaling x
-> UpdateTableReplicaAutoScaling
forall x.
UpdateTableReplicaAutoScaling
-> Rep UpdateTableReplicaAutoScaling x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateTableReplicaAutoScaling x
-> UpdateTableReplicaAutoScaling
$cfrom :: forall x.
UpdateTableReplicaAutoScaling
-> Rep UpdateTableReplicaAutoScaling x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTableReplicaAutoScaling' 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:
--
-- 'globalSecondaryIndexUpdates', 'updateTableReplicaAutoScaling_globalSecondaryIndexUpdates' - Represents the auto scaling settings of the global secondary indexes of
-- the replica to be updated.
--
-- 'provisionedWriteCapacityAutoScalingUpdate', 'updateTableReplicaAutoScaling_provisionedWriteCapacityAutoScalingUpdate' - Undocumented member.
--
-- 'replicaUpdates', 'updateTableReplicaAutoScaling_replicaUpdates' - Represents the auto scaling settings of replicas of the table that will
-- be modified.
--
-- 'tableName', 'updateTableReplicaAutoScaling_tableName' - The name of the global table to be updated.
newUpdateTableReplicaAutoScaling ::
  -- | 'tableName'
  Prelude.Text ->
  UpdateTableReplicaAutoScaling
newUpdateTableReplicaAutoScaling :: Text -> UpdateTableReplicaAutoScaling
newUpdateTableReplicaAutoScaling Text
pTableName_ =
  UpdateTableReplicaAutoScaling'
    { $sel:globalSecondaryIndexUpdates:UpdateTableReplicaAutoScaling' :: Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
globalSecondaryIndexUpdates =
        forall a. Maybe a
Prelude.Nothing,
      $sel:provisionedWriteCapacityAutoScalingUpdate:UpdateTableReplicaAutoScaling' :: Maybe AutoScalingSettingsUpdate
provisionedWriteCapacityAutoScalingUpdate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:replicaUpdates:UpdateTableReplicaAutoScaling' :: Maybe (NonEmpty ReplicaAutoScalingUpdate)
replicaUpdates = forall a. Maybe a
Prelude.Nothing,
      $sel:tableName:UpdateTableReplicaAutoScaling' :: Text
tableName = Text
pTableName_
    }

-- | Represents the auto scaling settings of the global secondary indexes of
-- the replica to be updated.
updateTableReplicaAutoScaling_globalSecondaryIndexUpdates :: Lens.Lens' UpdateTableReplicaAutoScaling (Prelude.Maybe (Prelude.NonEmpty GlobalSecondaryIndexAutoScalingUpdate))
updateTableReplicaAutoScaling_globalSecondaryIndexUpdates :: Lens'
  UpdateTableReplicaAutoScaling
  (Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate))
updateTableReplicaAutoScaling_globalSecondaryIndexUpdates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTableReplicaAutoScaling' {Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
globalSecondaryIndexUpdates :: Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
$sel:globalSecondaryIndexUpdates:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling
-> Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
globalSecondaryIndexUpdates} -> Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
globalSecondaryIndexUpdates) (\s :: UpdateTableReplicaAutoScaling
s@UpdateTableReplicaAutoScaling' {} Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
a -> UpdateTableReplicaAutoScaling
s {$sel:globalSecondaryIndexUpdates:UpdateTableReplicaAutoScaling' :: Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
globalSecondaryIndexUpdates = Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
a} :: UpdateTableReplicaAutoScaling) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Undocumented member.
updateTableReplicaAutoScaling_provisionedWriteCapacityAutoScalingUpdate :: Lens.Lens' UpdateTableReplicaAutoScaling (Prelude.Maybe AutoScalingSettingsUpdate)
updateTableReplicaAutoScaling_provisionedWriteCapacityAutoScalingUpdate :: Lens'
  UpdateTableReplicaAutoScaling (Maybe AutoScalingSettingsUpdate)
updateTableReplicaAutoScaling_provisionedWriteCapacityAutoScalingUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTableReplicaAutoScaling' {Maybe AutoScalingSettingsUpdate
provisionedWriteCapacityAutoScalingUpdate :: Maybe AutoScalingSettingsUpdate
$sel:provisionedWriteCapacityAutoScalingUpdate:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling -> Maybe AutoScalingSettingsUpdate
provisionedWriteCapacityAutoScalingUpdate} -> Maybe AutoScalingSettingsUpdate
provisionedWriteCapacityAutoScalingUpdate) (\s :: UpdateTableReplicaAutoScaling
s@UpdateTableReplicaAutoScaling' {} Maybe AutoScalingSettingsUpdate
a -> UpdateTableReplicaAutoScaling
s {$sel:provisionedWriteCapacityAutoScalingUpdate:UpdateTableReplicaAutoScaling' :: Maybe AutoScalingSettingsUpdate
provisionedWriteCapacityAutoScalingUpdate = Maybe AutoScalingSettingsUpdate
a} :: UpdateTableReplicaAutoScaling)

-- | Represents the auto scaling settings of replicas of the table that will
-- be modified.
updateTableReplicaAutoScaling_replicaUpdates :: Lens.Lens' UpdateTableReplicaAutoScaling (Prelude.Maybe (Prelude.NonEmpty ReplicaAutoScalingUpdate))
updateTableReplicaAutoScaling_replicaUpdates :: Lens'
  UpdateTableReplicaAutoScaling
  (Maybe (NonEmpty ReplicaAutoScalingUpdate))
updateTableReplicaAutoScaling_replicaUpdates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTableReplicaAutoScaling' {Maybe (NonEmpty ReplicaAutoScalingUpdate)
replicaUpdates :: Maybe (NonEmpty ReplicaAutoScalingUpdate)
$sel:replicaUpdates:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling
-> Maybe (NonEmpty ReplicaAutoScalingUpdate)
replicaUpdates} -> Maybe (NonEmpty ReplicaAutoScalingUpdate)
replicaUpdates) (\s :: UpdateTableReplicaAutoScaling
s@UpdateTableReplicaAutoScaling' {} Maybe (NonEmpty ReplicaAutoScalingUpdate)
a -> UpdateTableReplicaAutoScaling
s {$sel:replicaUpdates:UpdateTableReplicaAutoScaling' :: Maybe (NonEmpty ReplicaAutoScalingUpdate)
replicaUpdates = Maybe (NonEmpty ReplicaAutoScalingUpdate)
a} :: UpdateTableReplicaAutoScaling) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name of the global table to be updated.
updateTableReplicaAutoScaling_tableName :: Lens.Lens' UpdateTableReplicaAutoScaling Prelude.Text
updateTableReplicaAutoScaling_tableName :: Lens' UpdateTableReplicaAutoScaling Text
updateTableReplicaAutoScaling_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTableReplicaAutoScaling' {Text
tableName :: Text
$sel:tableName:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling -> Text
tableName} -> Text
tableName) (\s :: UpdateTableReplicaAutoScaling
s@UpdateTableReplicaAutoScaling' {} Text
a -> UpdateTableReplicaAutoScaling
s {$sel:tableName:UpdateTableReplicaAutoScaling' :: Text
tableName = Text
a} :: UpdateTableReplicaAutoScaling)

instance
  Core.AWSRequest
    UpdateTableReplicaAutoScaling
  where
  type
    AWSResponse UpdateTableReplicaAutoScaling =
      UpdateTableReplicaAutoScalingResponse
  request :: (Service -> Service)
-> UpdateTableReplicaAutoScaling
-> Request UpdateTableReplicaAutoScaling
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 UpdateTableReplicaAutoScaling
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateTableReplicaAutoScaling)))
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 TableAutoScalingDescription
-> Int -> UpdateTableReplicaAutoScalingResponse
UpdateTableReplicaAutoScalingResponse'
            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
"TableAutoScalingDescription")
            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
    UpdateTableReplicaAutoScaling
  where
  hashWithSalt :: Int -> UpdateTableReplicaAutoScaling -> Int
hashWithSalt Int
_salt UpdateTableReplicaAutoScaling' {Maybe (NonEmpty ReplicaAutoScalingUpdate)
Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
Maybe AutoScalingSettingsUpdate
Text
tableName :: Text
replicaUpdates :: Maybe (NonEmpty ReplicaAutoScalingUpdate)
provisionedWriteCapacityAutoScalingUpdate :: Maybe AutoScalingSettingsUpdate
globalSecondaryIndexUpdates :: Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
$sel:tableName:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling -> Text
$sel:replicaUpdates:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling
-> Maybe (NonEmpty ReplicaAutoScalingUpdate)
$sel:provisionedWriteCapacityAutoScalingUpdate:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling -> Maybe AutoScalingSettingsUpdate
$sel:globalSecondaryIndexUpdates:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling
-> Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
globalSecondaryIndexUpdates
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoScalingSettingsUpdate
provisionedWriteCapacityAutoScalingUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty ReplicaAutoScalingUpdate)
replicaUpdates
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableName

instance Prelude.NFData UpdateTableReplicaAutoScaling where
  rnf :: UpdateTableReplicaAutoScaling -> ()
rnf UpdateTableReplicaAutoScaling' {Maybe (NonEmpty ReplicaAutoScalingUpdate)
Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
Maybe AutoScalingSettingsUpdate
Text
tableName :: Text
replicaUpdates :: Maybe (NonEmpty ReplicaAutoScalingUpdate)
provisionedWriteCapacityAutoScalingUpdate :: Maybe AutoScalingSettingsUpdate
globalSecondaryIndexUpdates :: Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
$sel:tableName:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling -> Text
$sel:replicaUpdates:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling
-> Maybe (NonEmpty ReplicaAutoScalingUpdate)
$sel:provisionedWriteCapacityAutoScalingUpdate:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling -> Maybe AutoScalingSettingsUpdate
$sel:globalSecondaryIndexUpdates:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling
-> Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
globalSecondaryIndexUpdates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoScalingSettingsUpdate
provisionedWriteCapacityAutoScalingUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty ReplicaAutoScalingUpdate)
replicaUpdates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
tableName

instance Data.ToHeaders UpdateTableReplicaAutoScaling where
  toHeaders :: UpdateTableReplicaAutoScaling -> 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.UpdateTableReplicaAutoScaling" ::
                          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 UpdateTableReplicaAutoScaling where
  toJSON :: UpdateTableReplicaAutoScaling -> Value
toJSON UpdateTableReplicaAutoScaling' {Maybe (NonEmpty ReplicaAutoScalingUpdate)
Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
Maybe AutoScalingSettingsUpdate
Text
tableName :: Text
replicaUpdates :: Maybe (NonEmpty ReplicaAutoScalingUpdate)
provisionedWriteCapacityAutoScalingUpdate :: Maybe AutoScalingSettingsUpdate
globalSecondaryIndexUpdates :: Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
$sel:tableName:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling -> Text
$sel:replicaUpdates:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling
-> Maybe (NonEmpty ReplicaAutoScalingUpdate)
$sel:provisionedWriteCapacityAutoScalingUpdate:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling -> Maybe AutoScalingSettingsUpdate
$sel:globalSecondaryIndexUpdates:UpdateTableReplicaAutoScaling' :: UpdateTableReplicaAutoScaling
-> Maybe (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"GlobalSecondaryIndexUpdates" 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 (NonEmpty GlobalSecondaryIndexAutoScalingUpdate)
globalSecondaryIndexUpdates,
            (Key
"ProvisionedWriteCapacityAutoScalingUpdate" 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 AutoScalingSettingsUpdate
provisionedWriteCapacityAutoScalingUpdate,
            (Key
"ReplicaUpdates" 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 (NonEmpty ReplicaAutoScalingUpdate)
replicaUpdates,
            forall a. a -> Maybe a
Prelude.Just (Key
"TableName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
tableName)
          ]
      )

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

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

-- | /See:/ 'newUpdateTableReplicaAutoScalingResponse' smart constructor.
data UpdateTableReplicaAutoScalingResponse = UpdateTableReplicaAutoScalingResponse'
  { -- | Returns information about the auto scaling settings of a table with
    -- replicas.
    UpdateTableReplicaAutoScalingResponse
-> Maybe TableAutoScalingDescription
tableAutoScalingDescription :: Prelude.Maybe TableAutoScalingDescription,
    -- | The response's http status code.
    UpdateTableReplicaAutoScalingResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateTableReplicaAutoScalingResponse
-> UpdateTableReplicaAutoScalingResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTableReplicaAutoScalingResponse
-> UpdateTableReplicaAutoScalingResponse -> Bool
$c/= :: UpdateTableReplicaAutoScalingResponse
-> UpdateTableReplicaAutoScalingResponse -> Bool
== :: UpdateTableReplicaAutoScalingResponse
-> UpdateTableReplicaAutoScalingResponse -> Bool
$c== :: UpdateTableReplicaAutoScalingResponse
-> UpdateTableReplicaAutoScalingResponse -> Bool
Prelude.Eq, ReadPrec [UpdateTableReplicaAutoScalingResponse]
ReadPrec UpdateTableReplicaAutoScalingResponse
Int -> ReadS UpdateTableReplicaAutoScalingResponse
ReadS [UpdateTableReplicaAutoScalingResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTableReplicaAutoScalingResponse]
$creadListPrec :: ReadPrec [UpdateTableReplicaAutoScalingResponse]
readPrec :: ReadPrec UpdateTableReplicaAutoScalingResponse
$creadPrec :: ReadPrec UpdateTableReplicaAutoScalingResponse
readList :: ReadS [UpdateTableReplicaAutoScalingResponse]
$creadList :: ReadS [UpdateTableReplicaAutoScalingResponse]
readsPrec :: Int -> ReadS UpdateTableReplicaAutoScalingResponse
$creadsPrec :: Int -> ReadS UpdateTableReplicaAutoScalingResponse
Prelude.Read, Int -> UpdateTableReplicaAutoScalingResponse -> ShowS
[UpdateTableReplicaAutoScalingResponse] -> ShowS
UpdateTableReplicaAutoScalingResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTableReplicaAutoScalingResponse] -> ShowS
$cshowList :: [UpdateTableReplicaAutoScalingResponse] -> ShowS
show :: UpdateTableReplicaAutoScalingResponse -> String
$cshow :: UpdateTableReplicaAutoScalingResponse -> String
showsPrec :: Int -> UpdateTableReplicaAutoScalingResponse -> ShowS
$cshowsPrec :: Int -> UpdateTableReplicaAutoScalingResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateTableReplicaAutoScalingResponse x
-> UpdateTableReplicaAutoScalingResponse
forall x.
UpdateTableReplicaAutoScalingResponse
-> Rep UpdateTableReplicaAutoScalingResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateTableReplicaAutoScalingResponse x
-> UpdateTableReplicaAutoScalingResponse
$cfrom :: forall x.
UpdateTableReplicaAutoScalingResponse
-> Rep UpdateTableReplicaAutoScalingResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTableReplicaAutoScalingResponse' 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:
--
-- 'tableAutoScalingDescription', 'updateTableReplicaAutoScalingResponse_tableAutoScalingDescription' - Returns information about the auto scaling settings of a table with
-- replicas.
--
-- 'httpStatus', 'updateTableReplicaAutoScalingResponse_httpStatus' - The response's http status code.
newUpdateTableReplicaAutoScalingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateTableReplicaAutoScalingResponse
newUpdateTableReplicaAutoScalingResponse :: Int -> UpdateTableReplicaAutoScalingResponse
newUpdateTableReplicaAutoScalingResponse Int
pHttpStatus_ =
  UpdateTableReplicaAutoScalingResponse'
    { $sel:tableAutoScalingDescription:UpdateTableReplicaAutoScalingResponse' :: Maybe TableAutoScalingDescription
tableAutoScalingDescription =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateTableReplicaAutoScalingResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns information about the auto scaling settings of a table with
-- replicas.
updateTableReplicaAutoScalingResponse_tableAutoScalingDescription :: Lens.Lens' UpdateTableReplicaAutoScalingResponse (Prelude.Maybe TableAutoScalingDescription)
updateTableReplicaAutoScalingResponse_tableAutoScalingDescription :: Lens'
  UpdateTableReplicaAutoScalingResponse
  (Maybe TableAutoScalingDescription)
updateTableReplicaAutoScalingResponse_tableAutoScalingDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTableReplicaAutoScalingResponse' {Maybe TableAutoScalingDescription
tableAutoScalingDescription :: Maybe TableAutoScalingDescription
$sel:tableAutoScalingDescription:UpdateTableReplicaAutoScalingResponse' :: UpdateTableReplicaAutoScalingResponse
-> Maybe TableAutoScalingDescription
tableAutoScalingDescription} -> Maybe TableAutoScalingDescription
tableAutoScalingDescription) (\s :: UpdateTableReplicaAutoScalingResponse
s@UpdateTableReplicaAutoScalingResponse' {} Maybe TableAutoScalingDescription
a -> UpdateTableReplicaAutoScalingResponse
s {$sel:tableAutoScalingDescription:UpdateTableReplicaAutoScalingResponse' :: Maybe TableAutoScalingDescription
tableAutoScalingDescription = Maybe TableAutoScalingDescription
a} :: UpdateTableReplicaAutoScalingResponse)

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

instance
  Prelude.NFData
    UpdateTableReplicaAutoScalingResponse
  where
  rnf :: UpdateTableReplicaAutoScalingResponse -> ()
rnf UpdateTableReplicaAutoScalingResponse' {Int
Maybe TableAutoScalingDescription
httpStatus :: Int
tableAutoScalingDescription :: Maybe TableAutoScalingDescription
$sel:httpStatus:UpdateTableReplicaAutoScalingResponse' :: UpdateTableReplicaAutoScalingResponse -> Int
$sel:tableAutoScalingDescription:UpdateTableReplicaAutoScalingResponse' :: UpdateTableReplicaAutoScalingResponse
-> Maybe TableAutoScalingDescription
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe TableAutoScalingDescription
tableAutoScalingDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus