{-# 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.UpdateTable
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the provisioned throughput settings, global secondary indexes,
-- or DynamoDB Streams settings for a given table.
--
-- You can only perform one of the following operations at once:
--
-- -   Modify the provisioned throughput settings of the table.
--
-- -   Remove a global secondary index from the table.
--
-- -   Create a new global secondary index on the table. After the index
--     begins backfilling, you can use @UpdateTable@ to perform other
--     operations.
--
-- @UpdateTable@ is an asynchronous operation; while it is executing, the
-- table status changes from @ACTIVE@ to @UPDATING@. While it is
-- @UPDATING@, you cannot issue another @UpdateTable@ request. When the
-- table returns to the @ACTIVE@ state, the @UpdateTable@ operation is
-- complete.
module Amazonka.DynamoDB.UpdateTable
  ( -- * Creating a Request
    UpdateTable (..),
    newUpdateTable,

    -- * Request Lenses
    updateTable_attributeDefinitions,
    updateTable_billingMode,
    updateTable_globalSecondaryIndexUpdates,
    updateTable_provisionedThroughput,
    updateTable_replicaUpdates,
    updateTable_sSESpecification,
    updateTable_streamSpecification,
    updateTable_tableClass,
    updateTable_tableName,

    -- * Destructuring the Response
    UpdateTableResponse (..),
    newUpdateTableResponse,

    -- * Response Lenses
    updateTableResponse_tableDescription,
    updateTableResponse_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 an @UpdateTable@ operation.
--
-- /See:/ 'newUpdateTable' smart constructor.
data UpdateTable = UpdateTable'
  { -- | An array of attributes that describe the key schema for the table and
    -- indexes. If you are adding a new global secondary index to the table,
    -- @AttributeDefinitions@ must include the key element(s) of the new index.
    UpdateTable -> Maybe [AttributeDefinition]
attributeDefinitions :: Prelude.Maybe [AttributeDefinition],
    -- | Controls how you are charged for read and write throughput and how you
    -- manage capacity. When switching from pay-per-request to provisioned
    -- capacity, initial provisioned capacity values must be set. The initial
    -- provisioned capacity values are estimated based on the consumed read and
    -- write capacity of your table and global secondary indexes over the past
    -- 30 minutes.
    --
    -- -   @PROVISIONED@ - We recommend using @PROVISIONED@ for predictable
    --     workloads. @PROVISIONED@ sets the billing mode to
    --     <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/HowItWorks.ReadWriteCapacityMode.html#HowItWorks.ProvisionedThroughput.Manual Provisioned Mode>.
    --
    -- -   @PAY_PER_REQUEST@ - We recommend using @PAY_PER_REQUEST@ for
    --     unpredictable workloads. @PAY_PER_REQUEST@ sets the billing mode to
    --     <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/HowItWorks.ReadWriteCapacityMode.html#HowItWorks.OnDemand On-Demand Mode>.
    UpdateTable -> Maybe BillingMode
billingMode :: Prelude.Maybe BillingMode,
    -- | An array of one or more global secondary indexes for the table. For each
    -- index in the array, you can request one action:
    --
    -- -   @Create@ - add a new global secondary index to the table.
    --
    -- -   @Update@ - modify the provisioned throughput settings of an existing
    --     global secondary index.
    --
    -- -   @Delete@ - remove a global secondary index from the table.
    --
    -- You can create or delete only one global secondary index per
    -- @UpdateTable@ operation.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/GSI.OnlineOps.html Managing Global Secondary Indexes>
    -- in the /Amazon DynamoDB Developer Guide/.
    UpdateTable -> Maybe [GlobalSecondaryIndexUpdate]
globalSecondaryIndexUpdates :: Prelude.Maybe [GlobalSecondaryIndexUpdate],
    -- | The new provisioned throughput settings for the specified table or
    -- index.
    UpdateTable -> Maybe ProvisionedThroughput
provisionedThroughput :: Prelude.Maybe ProvisionedThroughput,
    -- | A list of replica update actions (create, delete, or update) for the
    -- table.
    --
    -- This property only applies to
    -- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/globaltables.V2.html Version 2019.11.21>
    -- of global tables.
    UpdateTable -> Maybe (NonEmpty ReplicationGroupUpdate)
replicaUpdates :: Prelude.Maybe (Prelude.NonEmpty ReplicationGroupUpdate),
    -- | The new server-side encryption settings for the specified table.
    UpdateTable -> Maybe SSESpecification
sSESpecification :: Prelude.Maybe SSESpecification,
    -- | Represents the DynamoDB Streams configuration for the table.
    --
    -- You receive a @ResourceInUseException@ if you try to enable a stream on
    -- a table that already has a stream, or if you try to disable a stream on
    -- a table that doesn\'t have a stream.
    UpdateTable -> Maybe StreamSpecification
streamSpecification :: Prelude.Maybe StreamSpecification,
    -- | The table class of the table to be updated. Valid values are @STANDARD@
    -- and @STANDARD_INFREQUENT_ACCESS@.
    UpdateTable -> Maybe TableClass
tableClass :: Prelude.Maybe TableClass,
    -- | The name of the table to be updated.
    UpdateTable -> Text
tableName :: Prelude.Text
  }
  deriving (UpdateTable -> UpdateTable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTable -> UpdateTable -> Bool
$c/= :: UpdateTable -> UpdateTable -> Bool
== :: UpdateTable -> UpdateTable -> Bool
$c== :: UpdateTable -> UpdateTable -> Bool
Prelude.Eq, ReadPrec [UpdateTable]
ReadPrec UpdateTable
Int -> ReadS UpdateTable
ReadS [UpdateTable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTable]
$creadListPrec :: ReadPrec [UpdateTable]
readPrec :: ReadPrec UpdateTable
$creadPrec :: ReadPrec UpdateTable
readList :: ReadS [UpdateTable]
$creadList :: ReadS [UpdateTable]
readsPrec :: Int -> ReadS UpdateTable
$creadsPrec :: Int -> ReadS UpdateTable
Prelude.Read, Int -> UpdateTable -> ShowS
[UpdateTable] -> ShowS
UpdateTable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTable] -> ShowS
$cshowList :: [UpdateTable] -> ShowS
show :: UpdateTable -> String
$cshow :: UpdateTable -> String
showsPrec :: Int -> UpdateTable -> ShowS
$cshowsPrec :: Int -> UpdateTable -> ShowS
Prelude.Show, forall x. Rep UpdateTable x -> UpdateTable
forall x. UpdateTable -> Rep UpdateTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTable x -> UpdateTable
$cfrom :: forall x. UpdateTable -> Rep UpdateTable x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTable' 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:
--
-- 'attributeDefinitions', 'updateTable_attributeDefinitions' - An array of attributes that describe the key schema for the table and
-- indexes. If you are adding a new global secondary index to the table,
-- @AttributeDefinitions@ must include the key element(s) of the new index.
--
-- 'billingMode', 'updateTable_billingMode' - Controls how you are charged for read and write throughput and how you
-- manage capacity. When switching from pay-per-request to provisioned
-- capacity, initial provisioned capacity values must be set. The initial
-- provisioned capacity values are estimated based on the consumed read and
-- write capacity of your table and global secondary indexes over the past
-- 30 minutes.
--
-- -   @PROVISIONED@ - We recommend using @PROVISIONED@ for predictable
--     workloads. @PROVISIONED@ sets the billing mode to
--     <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/HowItWorks.ReadWriteCapacityMode.html#HowItWorks.ProvisionedThroughput.Manual Provisioned Mode>.
--
-- -   @PAY_PER_REQUEST@ - We recommend using @PAY_PER_REQUEST@ for
--     unpredictable workloads. @PAY_PER_REQUEST@ sets the billing mode to
--     <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/HowItWorks.ReadWriteCapacityMode.html#HowItWorks.OnDemand On-Demand Mode>.
--
-- 'globalSecondaryIndexUpdates', 'updateTable_globalSecondaryIndexUpdates' - An array of one or more global secondary indexes for the table. For each
-- index in the array, you can request one action:
--
-- -   @Create@ - add a new global secondary index to the table.
--
-- -   @Update@ - modify the provisioned throughput settings of an existing
--     global secondary index.
--
-- -   @Delete@ - remove a global secondary index from the table.
--
-- You can create or delete only one global secondary index per
-- @UpdateTable@ operation.
--
-- For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/GSI.OnlineOps.html Managing Global Secondary Indexes>
-- in the /Amazon DynamoDB Developer Guide/.
--
-- 'provisionedThroughput', 'updateTable_provisionedThroughput' - The new provisioned throughput settings for the specified table or
-- index.
--
-- 'replicaUpdates', 'updateTable_replicaUpdates' - A list of replica update actions (create, delete, or update) for the
-- table.
--
-- This property only applies to
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/globaltables.V2.html Version 2019.11.21>
-- of global tables.
--
-- 'sSESpecification', 'updateTable_sSESpecification' - The new server-side encryption settings for the specified table.
--
-- 'streamSpecification', 'updateTable_streamSpecification' - Represents the DynamoDB Streams configuration for the table.
--
-- You receive a @ResourceInUseException@ if you try to enable a stream on
-- a table that already has a stream, or if you try to disable a stream on
-- a table that doesn\'t have a stream.
--
-- 'tableClass', 'updateTable_tableClass' - The table class of the table to be updated. Valid values are @STANDARD@
-- and @STANDARD_INFREQUENT_ACCESS@.
--
-- 'tableName', 'updateTable_tableName' - The name of the table to be updated.
newUpdateTable ::
  -- | 'tableName'
  Prelude.Text ->
  UpdateTable
newUpdateTable :: Text -> UpdateTable
newUpdateTable Text
pTableName_ =
  UpdateTable'
    { $sel:attributeDefinitions:UpdateTable' :: Maybe [AttributeDefinition]
attributeDefinitions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:billingMode:UpdateTable' :: Maybe BillingMode
billingMode = forall a. Maybe a
Prelude.Nothing,
      $sel:globalSecondaryIndexUpdates:UpdateTable' :: Maybe [GlobalSecondaryIndexUpdate]
globalSecondaryIndexUpdates = forall a. Maybe a
Prelude.Nothing,
      $sel:provisionedThroughput:UpdateTable' :: Maybe ProvisionedThroughput
provisionedThroughput = forall a. Maybe a
Prelude.Nothing,
      $sel:replicaUpdates:UpdateTable' :: Maybe (NonEmpty ReplicationGroupUpdate)
replicaUpdates = forall a. Maybe a
Prelude.Nothing,
      $sel:sSESpecification:UpdateTable' :: Maybe SSESpecification
sSESpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:streamSpecification:UpdateTable' :: Maybe StreamSpecification
streamSpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:tableClass:UpdateTable' :: Maybe TableClass
tableClass = forall a. Maybe a
Prelude.Nothing,
      $sel:tableName:UpdateTable' :: Text
tableName = Text
pTableName_
    }

-- | An array of attributes that describe the key schema for the table and
-- indexes. If you are adding a new global secondary index to the table,
-- @AttributeDefinitions@ must include the key element(s) of the new index.
updateTable_attributeDefinitions :: Lens.Lens' UpdateTable (Prelude.Maybe [AttributeDefinition])
updateTable_attributeDefinitions :: Lens' UpdateTable (Maybe [AttributeDefinition])
updateTable_attributeDefinitions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe [AttributeDefinition]
attributeDefinitions :: Maybe [AttributeDefinition]
$sel:attributeDefinitions:UpdateTable' :: UpdateTable -> Maybe [AttributeDefinition]
attributeDefinitions} -> Maybe [AttributeDefinition]
attributeDefinitions) (\s :: UpdateTable
s@UpdateTable' {} Maybe [AttributeDefinition]
a -> UpdateTable
s {$sel:attributeDefinitions:UpdateTable' :: Maybe [AttributeDefinition]
attributeDefinitions = Maybe [AttributeDefinition]
a} :: UpdateTable) 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

-- | Controls how you are charged for read and write throughput and how you
-- manage capacity. When switching from pay-per-request to provisioned
-- capacity, initial provisioned capacity values must be set. The initial
-- provisioned capacity values are estimated based on the consumed read and
-- write capacity of your table and global secondary indexes over the past
-- 30 minutes.
--
-- -   @PROVISIONED@ - We recommend using @PROVISIONED@ for predictable
--     workloads. @PROVISIONED@ sets the billing mode to
--     <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/HowItWorks.ReadWriteCapacityMode.html#HowItWorks.ProvisionedThroughput.Manual Provisioned Mode>.
--
-- -   @PAY_PER_REQUEST@ - We recommend using @PAY_PER_REQUEST@ for
--     unpredictable workloads. @PAY_PER_REQUEST@ sets the billing mode to
--     <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/HowItWorks.ReadWriteCapacityMode.html#HowItWorks.OnDemand On-Demand Mode>.
updateTable_billingMode :: Lens.Lens' UpdateTable (Prelude.Maybe BillingMode)
updateTable_billingMode :: Lens' UpdateTable (Maybe BillingMode)
updateTable_billingMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe BillingMode
billingMode :: Maybe BillingMode
$sel:billingMode:UpdateTable' :: UpdateTable -> Maybe BillingMode
billingMode} -> Maybe BillingMode
billingMode) (\s :: UpdateTable
s@UpdateTable' {} Maybe BillingMode
a -> UpdateTable
s {$sel:billingMode:UpdateTable' :: Maybe BillingMode
billingMode = Maybe BillingMode
a} :: UpdateTable)

-- | An array of one or more global secondary indexes for the table. For each
-- index in the array, you can request one action:
--
-- -   @Create@ - add a new global secondary index to the table.
--
-- -   @Update@ - modify the provisioned throughput settings of an existing
--     global secondary index.
--
-- -   @Delete@ - remove a global secondary index from the table.
--
-- You can create or delete only one global secondary index per
-- @UpdateTable@ operation.
--
-- For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/GSI.OnlineOps.html Managing Global Secondary Indexes>
-- in the /Amazon DynamoDB Developer Guide/.
updateTable_globalSecondaryIndexUpdates :: Lens.Lens' UpdateTable (Prelude.Maybe [GlobalSecondaryIndexUpdate])
updateTable_globalSecondaryIndexUpdates :: Lens' UpdateTable (Maybe [GlobalSecondaryIndexUpdate])
updateTable_globalSecondaryIndexUpdates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe [GlobalSecondaryIndexUpdate]
globalSecondaryIndexUpdates :: Maybe [GlobalSecondaryIndexUpdate]
$sel:globalSecondaryIndexUpdates:UpdateTable' :: UpdateTable -> Maybe [GlobalSecondaryIndexUpdate]
globalSecondaryIndexUpdates} -> Maybe [GlobalSecondaryIndexUpdate]
globalSecondaryIndexUpdates) (\s :: UpdateTable
s@UpdateTable' {} Maybe [GlobalSecondaryIndexUpdate]
a -> UpdateTable
s {$sel:globalSecondaryIndexUpdates:UpdateTable' :: Maybe [GlobalSecondaryIndexUpdate]
globalSecondaryIndexUpdates = Maybe [GlobalSecondaryIndexUpdate]
a} :: UpdateTable) 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 new provisioned throughput settings for the specified table or
-- index.
updateTable_provisionedThroughput :: Lens.Lens' UpdateTable (Prelude.Maybe ProvisionedThroughput)
updateTable_provisionedThroughput :: Lens' UpdateTable (Maybe ProvisionedThroughput)
updateTable_provisionedThroughput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe ProvisionedThroughput
provisionedThroughput :: Maybe ProvisionedThroughput
$sel:provisionedThroughput:UpdateTable' :: UpdateTable -> Maybe ProvisionedThroughput
provisionedThroughput} -> Maybe ProvisionedThroughput
provisionedThroughput) (\s :: UpdateTable
s@UpdateTable' {} Maybe ProvisionedThroughput
a -> UpdateTable
s {$sel:provisionedThroughput:UpdateTable' :: Maybe ProvisionedThroughput
provisionedThroughput = Maybe ProvisionedThroughput
a} :: UpdateTable)

-- | A list of replica update actions (create, delete, or update) for the
-- table.
--
-- This property only applies to
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/globaltables.V2.html Version 2019.11.21>
-- of global tables.
updateTable_replicaUpdates :: Lens.Lens' UpdateTable (Prelude.Maybe (Prelude.NonEmpty ReplicationGroupUpdate))
updateTable_replicaUpdates :: Lens' UpdateTable (Maybe (NonEmpty ReplicationGroupUpdate))
updateTable_replicaUpdates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe (NonEmpty ReplicationGroupUpdate)
replicaUpdates :: Maybe (NonEmpty ReplicationGroupUpdate)
$sel:replicaUpdates:UpdateTable' :: UpdateTable -> Maybe (NonEmpty ReplicationGroupUpdate)
replicaUpdates} -> Maybe (NonEmpty ReplicationGroupUpdate)
replicaUpdates) (\s :: UpdateTable
s@UpdateTable' {} Maybe (NonEmpty ReplicationGroupUpdate)
a -> UpdateTable
s {$sel:replicaUpdates:UpdateTable' :: Maybe (NonEmpty ReplicationGroupUpdate)
replicaUpdates = Maybe (NonEmpty ReplicationGroupUpdate)
a} :: UpdateTable) 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 new server-side encryption settings for the specified table.
updateTable_sSESpecification :: Lens.Lens' UpdateTable (Prelude.Maybe SSESpecification)
updateTable_sSESpecification :: Lens' UpdateTable (Maybe SSESpecification)
updateTable_sSESpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe SSESpecification
sSESpecification :: Maybe SSESpecification
$sel:sSESpecification:UpdateTable' :: UpdateTable -> Maybe SSESpecification
sSESpecification} -> Maybe SSESpecification
sSESpecification) (\s :: UpdateTable
s@UpdateTable' {} Maybe SSESpecification
a -> UpdateTable
s {$sel:sSESpecification:UpdateTable' :: Maybe SSESpecification
sSESpecification = Maybe SSESpecification
a} :: UpdateTable)

-- | Represents the DynamoDB Streams configuration for the table.
--
-- You receive a @ResourceInUseException@ if you try to enable a stream on
-- a table that already has a stream, or if you try to disable a stream on
-- a table that doesn\'t have a stream.
updateTable_streamSpecification :: Lens.Lens' UpdateTable (Prelude.Maybe StreamSpecification)
updateTable_streamSpecification :: Lens' UpdateTable (Maybe StreamSpecification)
updateTable_streamSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe StreamSpecification
streamSpecification :: Maybe StreamSpecification
$sel:streamSpecification:UpdateTable' :: UpdateTable -> Maybe StreamSpecification
streamSpecification} -> Maybe StreamSpecification
streamSpecification) (\s :: UpdateTable
s@UpdateTable' {} Maybe StreamSpecification
a -> UpdateTable
s {$sel:streamSpecification:UpdateTable' :: Maybe StreamSpecification
streamSpecification = Maybe StreamSpecification
a} :: UpdateTable)

-- | The table class of the table to be updated. Valid values are @STANDARD@
-- and @STANDARD_INFREQUENT_ACCESS@.
updateTable_tableClass :: Lens.Lens' UpdateTable (Prelude.Maybe TableClass)
updateTable_tableClass :: Lens' UpdateTable (Maybe TableClass)
updateTable_tableClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe TableClass
tableClass :: Maybe TableClass
$sel:tableClass:UpdateTable' :: UpdateTable -> Maybe TableClass
tableClass} -> Maybe TableClass
tableClass) (\s :: UpdateTable
s@UpdateTable' {} Maybe TableClass
a -> UpdateTable
s {$sel:tableClass:UpdateTable' :: Maybe TableClass
tableClass = Maybe TableClass
a} :: UpdateTable)

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

instance Core.AWSRequest UpdateTable where
  type AWSResponse UpdateTable = UpdateTableResponse
  request :: (Service -> Service) -> UpdateTable -> Request UpdateTable
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 UpdateTable
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateTable)))
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 TableDescription -> Int -> UpdateTableResponse
UpdateTableResponse'
            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
"TableDescription")
            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 UpdateTable where
  hashWithSalt :: Int -> UpdateTable -> Int
hashWithSalt Int
_salt UpdateTable' {Maybe [GlobalSecondaryIndexUpdate]
Maybe [AttributeDefinition]
Maybe (NonEmpty ReplicationGroupUpdate)
Maybe TableClass
Maybe StreamSpecification
Maybe SSESpecification
Maybe ProvisionedThroughput
Maybe BillingMode
Text
tableName :: Text
tableClass :: Maybe TableClass
streamSpecification :: Maybe StreamSpecification
sSESpecification :: Maybe SSESpecification
replicaUpdates :: Maybe (NonEmpty ReplicationGroupUpdate)
provisionedThroughput :: Maybe ProvisionedThroughput
globalSecondaryIndexUpdates :: Maybe [GlobalSecondaryIndexUpdate]
billingMode :: Maybe BillingMode
attributeDefinitions :: Maybe [AttributeDefinition]
$sel:tableName:UpdateTable' :: UpdateTable -> Text
$sel:tableClass:UpdateTable' :: UpdateTable -> Maybe TableClass
$sel:streamSpecification:UpdateTable' :: UpdateTable -> Maybe StreamSpecification
$sel:sSESpecification:UpdateTable' :: UpdateTable -> Maybe SSESpecification
$sel:replicaUpdates:UpdateTable' :: UpdateTable -> Maybe (NonEmpty ReplicationGroupUpdate)
$sel:provisionedThroughput:UpdateTable' :: UpdateTable -> Maybe ProvisionedThroughput
$sel:globalSecondaryIndexUpdates:UpdateTable' :: UpdateTable -> Maybe [GlobalSecondaryIndexUpdate]
$sel:billingMode:UpdateTable' :: UpdateTable -> Maybe BillingMode
$sel:attributeDefinitions:UpdateTable' :: UpdateTable -> Maybe [AttributeDefinition]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AttributeDefinition]
attributeDefinitions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BillingMode
billingMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [GlobalSecondaryIndexUpdate]
globalSecondaryIndexUpdates
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProvisionedThroughput
provisionedThroughput
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty ReplicationGroupUpdate)
replicaUpdates
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SSESpecification
sSESpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StreamSpecification
streamSpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TableClass
tableClass
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableName

instance Prelude.NFData UpdateTable where
  rnf :: UpdateTable -> ()
rnf UpdateTable' {Maybe [GlobalSecondaryIndexUpdate]
Maybe [AttributeDefinition]
Maybe (NonEmpty ReplicationGroupUpdate)
Maybe TableClass
Maybe StreamSpecification
Maybe SSESpecification
Maybe ProvisionedThroughput
Maybe BillingMode
Text
tableName :: Text
tableClass :: Maybe TableClass
streamSpecification :: Maybe StreamSpecification
sSESpecification :: Maybe SSESpecification
replicaUpdates :: Maybe (NonEmpty ReplicationGroupUpdate)
provisionedThroughput :: Maybe ProvisionedThroughput
globalSecondaryIndexUpdates :: Maybe [GlobalSecondaryIndexUpdate]
billingMode :: Maybe BillingMode
attributeDefinitions :: Maybe [AttributeDefinition]
$sel:tableName:UpdateTable' :: UpdateTable -> Text
$sel:tableClass:UpdateTable' :: UpdateTable -> Maybe TableClass
$sel:streamSpecification:UpdateTable' :: UpdateTable -> Maybe StreamSpecification
$sel:sSESpecification:UpdateTable' :: UpdateTable -> Maybe SSESpecification
$sel:replicaUpdates:UpdateTable' :: UpdateTable -> Maybe (NonEmpty ReplicationGroupUpdate)
$sel:provisionedThroughput:UpdateTable' :: UpdateTable -> Maybe ProvisionedThroughput
$sel:globalSecondaryIndexUpdates:UpdateTable' :: UpdateTable -> Maybe [GlobalSecondaryIndexUpdate]
$sel:billingMode:UpdateTable' :: UpdateTable -> Maybe BillingMode
$sel:attributeDefinitions:UpdateTable' :: UpdateTable -> Maybe [AttributeDefinition]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AttributeDefinition]
attributeDefinitions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BillingMode
billingMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [GlobalSecondaryIndexUpdate]
globalSecondaryIndexUpdates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProvisionedThroughput
provisionedThroughput
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty ReplicationGroupUpdate)
replicaUpdates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SSESpecification
sSESpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamSpecification
streamSpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TableClass
tableClass
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
tableName

instance Data.ToHeaders UpdateTable where
  toHeaders :: UpdateTable -> 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.UpdateTable" ::
                          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 UpdateTable where
  toJSON :: UpdateTable -> Value
toJSON UpdateTable' {Maybe [GlobalSecondaryIndexUpdate]
Maybe [AttributeDefinition]
Maybe (NonEmpty ReplicationGroupUpdate)
Maybe TableClass
Maybe StreamSpecification
Maybe SSESpecification
Maybe ProvisionedThroughput
Maybe BillingMode
Text
tableName :: Text
tableClass :: Maybe TableClass
streamSpecification :: Maybe StreamSpecification
sSESpecification :: Maybe SSESpecification
replicaUpdates :: Maybe (NonEmpty ReplicationGroupUpdate)
provisionedThroughput :: Maybe ProvisionedThroughput
globalSecondaryIndexUpdates :: Maybe [GlobalSecondaryIndexUpdate]
billingMode :: Maybe BillingMode
attributeDefinitions :: Maybe [AttributeDefinition]
$sel:tableName:UpdateTable' :: UpdateTable -> Text
$sel:tableClass:UpdateTable' :: UpdateTable -> Maybe TableClass
$sel:streamSpecification:UpdateTable' :: UpdateTable -> Maybe StreamSpecification
$sel:sSESpecification:UpdateTable' :: UpdateTable -> Maybe SSESpecification
$sel:replicaUpdates:UpdateTable' :: UpdateTable -> Maybe (NonEmpty ReplicationGroupUpdate)
$sel:provisionedThroughput:UpdateTable' :: UpdateTable -> Maybe ProvisionedThroughput
$sel:globalSecondaryIndexUpdates:UpdateTable' :: UpdateTable -> Maybe [GlobalSecondaryIndexUpdate]
$sel:billingMode:UpdateTable' :: UpdateTable -> Maybe BillingMode
$sel:attributeDefinitions:UpdateTable' :: UpdateTable -> Maybe [AttributeDefinition]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AttributeDefinitions" 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 [AttributeDefinition]
attributeDefinitions,
            (Key
"BillingMode" 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 BillingMode
billingMode,
            (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 [GlobalSecondaryIndexUpdate]
globalSecondaryIndexUpdates,
            (Key
"ProvisionedThroughput" 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 ProvisionedThroughput
provisionedThroughput,
            (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 ReplicationGroupUpdate)
replicaUpdates,
            (Key
"SSESpecification" 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 SSESpecification
sSESpecification,
            (Key
"StreamSpecification" 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 StreamSpecification
streamSpecification,
            (Key
"TableClass" 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 TableClass
tableClass,
            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 UpdateTable where
  toPath :: UpdateTable -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | Represents the output of an @UpdateTable@ operation.
--
-- /See:/ 'newUpdateTableResponse' smart constructor.
data UpdateTableResponse = UpdateTableResponse'
  { -- | Represents the properties of the table.
    UpdateTableResponse -> Maybe TableDescription
tableDescription :: Prelude.Maybe TableDescription,
    -- | The response's http status code.
    UpdateTableResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateTableResponse -> UpdateTableResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTableResponse -> UpdateTableResponse -> Bool
$c/= :: UpdateTableResponse -> UpdateTableResponse -> Bool
== :: UpdateTableResponse -> UpdateTableResponse -> Bool
$c== :: UpdateTableResponse -> UpdateTableResponse -> Bool
Prelude.Eq, ReadPrec [UpdateTableResponse]
ReadPrec UpdateTableResponse
Int -> ReadS UpdateTableResponse
ReadS [UpdateTableResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTableResponse]
$creadListPrec :: ReadPrec [UpdateTableResponse]
readPrec :: ReadPrec UpdateTableResponse
$creadPrec :: ReadPrec UpdateTableResponse
readList :: ReadS [UpdateTableResponse]
$creadList :: ReadS [UpdateTableResponse]
readsPrec :: Int -> ReadS UpdateTableResponse
$creadsPrec :: Int -> ReadS UpdateTableResponse
Prelude.Read, Int -> UpdateTableResponse -> ShowS
[UpdateTableResponse] -> ShowS
UpdateTableResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTableResponse] -> ShowS
$cshowList :: [UpdateTableResponse] -> ShowS
show :: UpdateTableResponse -> String
$cshow :: UpdateTableResponse -> String
showsPrec :: Int -> UpdateTableResponse -> ShowS
$cshowsPrec :: Int -> UpdateTableResponse -> ShowS
Prelude.Show, forall x. Rep UpdateTableResponse x -> UpdateTableResponse
forall x. UpdateTableResponse -> Rep UpdateTableResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTableResponse x -> UpdateTableResponse
$cfrom :: forall x. UpdateTableResponse -> Rep UpdateTableResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTableResponse' 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:
--
-- 'tableDescription', 'updateTableResponse_tableDescription' - Represents the properties of the table.
--
-- 'httpStatus', 'updateTableResponse_httpStatus' - The response's http status code.
newUpdateTableResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateTableResponse
newUpdateTableResponse :: Int -> UpdateTableResponse
newUpdateTableResponse Int
pHttpStatus_ =
  UpdateTableResponse'
    { $sel:tableDescription:UpdateTableResponse' :: Maybe TableDescription
tableDescription =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateTableResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Represents the properties of the table.
updateTableResponse_tableDescription :: Lens.Lens' UpdateTableResponse (Prelude.Maybe TableDescription)
updateTableResponse_tableDescription :: Lens' UpdateTableResponse (Maybe TableDescription)
updateTableResponse_tableDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTableResponse' {Maybe TableDescription
tableDescription :: Maybe TableDescription
$sel:tableDescription:UpdateTableResponse' :: UpdateTableResponse -> Maybe TableDescription
tableDescription} -> Maybe TableDescription
tableDescription) (\s :: UpdateTableResponse
s@UpdateTableResponse' {} Maybe TableDescription
a -> UpdateTableResponse
s {$sel:tableDescription:UpdateTableResponse' :: Maybe TableDescription
tableDescription = Maybe TableDescription
a} :: UpdateTableResponse)

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

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