{-# 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.CreateTable
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- The @CreateTable@ operation adds a new table to your account. In an
-- Amazon Web Services account, table names must be unique within each
-- Region. That is, you can have two tables with same name if you create
-- the tables in different Regions.
--
-- @CreateTable@ is an asynchronous operation. Upon receiving a
-- @CreateTable@ request, DynamoDB immediately returns a response with a
-- @TableStatus@ of @CREATING@. After the table is created, DynamoDB sets
-- the @TableStatus@ to @ACTIVE@. You can perform read and write operations
-- only on an @ACTIVE@ table.
--
-- You can optionally define secondary indexes on the new table, as part of
-- the @CreateTable@ operation. If you want to create multiple tables with
-- secondary indexes on them, you must create the tables sequentially. Only
-- one table with secondary indexes can be in the @CREATING@ state at any
-- given time.
--
-- You can use the @DescribeTable@ action to check the table status.
module Amazonka.DynamoDB.CreateTable
  ( -- * Creating a Request
    CreateTable (..),
    newCreateTable,

    -- * Request Lenses
    createTable_billingMode,
    createTable_globalSecondaryIndexes,
    createTable_localSecondaryIndexes,
    createTable_provisionedThroughput,
    createTable_sSESpecification,
    createTable_streamSpecification,
    createTable_tableClass,
    createTable_tags,
    createTable_attributeDefinitions,
    createTable_tableName,
    createTable_keySchema,

    -- * Destructuring the Response
    CreateTableResponse (..),
    newCreateTableResponse,

    -- * Response Lenses
    createTableResponse_tableDescription,
    createTableResponse_httpStatus,
  )
where

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

-- | Represents the input of a @CreateTable@ operation.
--
-- /See:/ 'newCreateTable' smart constructor.
data CreateTable = CreateTable'
  { -- | Controls how you are charged for read and write throughput and how you
    -- manage capacity. This setting can be changed later.
    --
    -- -   @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>.
    CreateTable -> Maybe BillingMode
billingMode :: Prelude.Maybe BillingMode,
    -- | One or more global secondary indexes (the maximum is 20) to be created
    -- on the table. Each global secondary index in the array includes the
    -- following:
    --
    -- -   @IndexName@ - The name of the global secondary index. Must be unique
    --     only for this table.
    --
    -- -   @KeySchema@ - Specifies the key schema for the global secondary
    --     index.
    --
    -- -   @Projection@ - Specifies attributes that are copied (projected) from
    --     the table into the index. These are in addition to the primary key
    --     attributes and index key attributes, which are automatically
    --     projected. Each attribute specification is composed of:
    --
    --     -   @ProjectionType@ - One of the following:
    --
    --         -   @KEYS_ONLY@ - Only the index and primary keys are projected
    --             into the index.
    --
    --         -   @INCLUDE@ - Only the specified table attributes are
    --             projected into the index. The list of projected attributes
    --             is in @NonKeyAttributes@.
    --
    --         -   @ALL@ - All of the table attributes are projected into the
    --             index.
    --
    --     -   @NonKeyAttributes@ - A list of one or more non-key attribute
    --         names that are projected into the secondary index. The total
    --         count of attributes provided in @NonKeyAttributes@, summed
    --         across all of the secondary indexes, must not exceed 100. If you
    --         project the same attribute into two different indexes, this
    --         counts as two distinct attributes when determining the total.
    --
    -- -   @ProvisionedThroughput@ - The provisioned throughput settings for
    --     the global secondary index, consisting of read and write capacity
    --     units.
    CreateTable -> Maybe [GlobalSecondaryIndex]
globalSecondaryIndexes :: Prelude.Maybe [GlobalSecondaryIndex],
    -- | One or more local secondary indexes (the maximum is 5) to be created on
    -- the table. Each index is scoped to a given partition key value. There is
    -- a 10 GB size limit per partition key value; otherwise, the size of a
    -- local secondary index is unconstrained.
    --
    -- Each local secondary index in the array includes the following:
    --
    -- -   @IndexName@ - The name of the local secondary index. Must be unique
    --     only for this table.
    --
    -- -   @KeySchema@ - Specifies the key schema for the local secondary
    --     index. The key schema must begin with the same partition key as the
    --     table.
    --
    -- -   @Projection@ - Specifies attributes that are copied (projected) from
    --     the table into the index. These are in addition to the primary key
    --     attributes and index key attributes, which are automatically
    --     projected. Each attribute specification is composed of:
    --
    --     -   @ProjectionType@ - One of the following:
    --
    --         -   @KEYS_ONLY@ - Only the index and primary keys are projected
    --             into the index.
    --
    --         -   @INCLUDE@ - Only the specified table attributes are
    --             projected into the index. The list of projected attributes
    --             is in @NonKeyAttributes@.
    --
    --         -   @ALL@ - All of the table attributes are projected into the
    --             index.
    --
    --     -   @NonKeyAttributes@ - A list of one or more non-key attribute
    --         names that are projected into the secondary index. The total
    --         count of attributes provided in @NonKeyAttributes@, summed
    --         across all of the secondary indexes, must not exceed 100. If you
    --         project the same attribute into two different indexes, this
    --         counts as two distinct attributes when determining the total.
    CreateTable -> Maybe [LocalSecondaryIndex]
localSecondaryIndexes :: Prelude.Maybe [LocalSecondaryIndex],
    -- | Represents the provisioned throughput settings for a specified table or
    -- index. The settings can be modified using the @UpdateTable@ operation.
    --
    -- If you set BillingMode as @PROVISIONED@, you must specify this property.
    -- If you set BillingMode as @PAY_PER_REQUEST@, you cannot specify this
    -- property.
    --
    -- For current minimum and maximum provisioned throughput values, see
    -- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/Limits.html Service, Account, and Table Quotas>
    -- in the /Amazon DynamoDB Developer Guide/.
    CreateTable -> Maybe ProvisionedThroughput
provisionedThroughput :: Prelude.Maybe ProvisionedThroughput,
    -- | Represents the settings used to enable server-side encryption.
    CreateTable -> Maybe SSESpecification
sSESpecification :: Prelude.Maybe SSESpecification,
    -- | The settings for DynamoDB Streams on the table. These settings consist
    -- of:
    --
    -- -   @StreamEnabled@ - Indicates whether DynamoDB Streams is to be
    --     enabled (true) or disabled (false).
    --
    -- -   @StreamViewType@ - When an item in the table is modified,
    --     @StreamViewType@ determines what information is written to the
    --     table\'s stream. Valid values for @StreamViewType@ are:
    --
    --     -   @KEYS_ONLY@ - Only the key attributes of the modified item are
    --         written to the stream.
    --
    --     -   @NEW_IMAGE@ - The entire item, as it appears after it was
    --         modified, is written to the stream.
    --
    --     -   @OLD_IMAGE@ - The entire item, as it appeared before it was
    --         modified, is written to the stream.
    --
    --     -   @NEW_AND_OLD_IMAGES@ - Both the new and the old item images of
    --         the item are written to the stream.
    CreateTable -> Maybe StreamSpecification
streamSpecification :: Prelude.Maybe StreamSpecification,
    -- | The table class of the new table. Valid values are @STANDARD@ and
    -- @STANDARD_INFREQUENT_ACCESS@.
    CreateTable -> Maybe TableClass
tableClass :: Prelude.Maybe TableClass,
    -- | A list of key-value pairs to label the table. For more information, see
    -- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/Tagging.html Tagging for DynamoDB>.
    CreateTable -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | An array of attributes that describe the key schema for the table and
    -- indexes.
    CreateTable -> [AttributeDefinition]
attributeDefinitions :: [AttributeDefinition],
    -- | The name of the table to create.
    CreateTable -> Text
tableName :: Prelude.Text,
    -- | Specifies the attributes that make up the primary key for a table or an
    -- index. The attributes in @KeySchema@ must also be defined in the
    -- @AttributeDefinitions@ array. For more information, see
    -- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/DataModel.html Data Model>
    -- in the /Amazon DynamoDB Developer Guide/.
    --
    -- Each @KeySchemaElement@ in the array is composed of:
    --
    -- -   @AttributeName@ - The name of this key attribute.
    --
    -- -   @KeyType@ - The role that the key attribute will assume:
    --
    --     -   @HASH@ - partition key
    --
    --     -   @RANGE@ - sort key
    --
    -- The partition key of an item is also known as its /hash attribute/. The
    -- term \"hash attribute\" derives from the DynamoDB usage of an internal
    -- hash function to evenly distribute data items across partitions, based
    -- on their partition key values.
    --
    -- The sort key of an item is also known as its /range attribute/. The term
    -- \"range attribute\" derives from the way DynamoDB stores items with the
    -- same partition key physically close together, in sorted order by the
    -- sort key value.
    --
    -- For a simple primary key (partition key), you must provide exactly one
    -- element with a @KeyType@ of @HASH@.
    --
    -- For a composite primary key (partition key and sort key), you must
    -- provide exactly two elements, in this order: The first element must have
    -- a @KeyType@ of @HASH@, and the second element must have a @KeyType@ of
    -- @RANGE@.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/WorkingWithTables.html#WorkingWithTables.primary.key Working with Tables>
    -- in the /Amazon DynamoDB Developer Guide/.
    CreateTable -> NonEmpty KeySchemaElement
keySchema :: Prelude.NonEmpty KeySchemaElement
  }
  deriving (CreateTable -> CreateTable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTable -> CreateTable -> Bool
$c/= :: CreateTable -> CreateTable -> Bool
== :: CreateTable -> CreateTable -> Bool
$c== :: CreateTable -> CreateTable -> Bool
Prelude.Eq, ReadPrec [CreateTable]
ReadPrec CreateTable
Int -> ReadS CreateTable
ReadS [CreateTable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTable]
$creadListPrec :: ReadPrec [CreateTable]
readPrec :: ReadPrec CreateTable
$creadPrec :: ReadPrec CreateTable
readList :: ReadS [CreateTable]
$creadList :: ReadS [CreateTable]
readsPrec :: Int -> ReadS CreateTable
$creadsPrec :: Int -> ReadS CreateTable
Prelude.Read, Int -> CreateTable -> ShowS
[CreateTable] -> ShowS
CreateTable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTable] -> ShowS
$cshowList :: [CreateTable] -> ShowS
show :: CreateTable -> String
$cshow :: CreateTable -> String
showsPrec :: Int -> CreateTable -> ShowS
$cshowsPrec :: Int -> CreateTable -> ShowS
Prelude.Show, forall x. Rep CreateTable x -> CreateTable
forall x. CreateTable -> Rep CreateTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateTable x -> CreateTable
$cfrom :: forall x. CreateTable -> Rep CreateTable x
Prelude.Generic)

-- |
-- Create a value of 'CreateTable' 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:
--
-- 'billingMode', 'createTable_billingMode' - Controls how you are charged for read and write throughput and how you
-- manage capacity. This setting can be changed later.
--
-- -   @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>.
--
-- 'globalSecondaryIndexes', 'createTable_globalSecondaryIndexes' - One or more global secondary indexes (the maximum is 20) to be created
-- on the table. Each global secondary index in the array includes the
-- following:
--
-- -   @IndexName@ - The name of the global secondary index. Must be unique
--     only for this table.
--
-- -   @KeySchema@ - Specifies the key schema for the global secondary
--     index.
--
-- -   @Projection@ - Specifies attributes that are copied (projected) from
--     the table into the index. These are in addition to the primary key
--     attributes and index key attributes, which are automatically
--     projected. Each attribute specification is composed of:
--
--     -   @ProjectionType@ - One of the following:
--
--         -   @KEYS_ONLY@ - Only the index and primary keys are projected
--             into the index.
--
--         -   @INCLUDE@ - Only the specified table attributes are
--             projected into the index. The list of projected attributes
--             is in @NonKeyAttributes@.
--
--         -   @ALL@ - All of the table attributes are projected into the
--             index.
--
--     -   @NonKeyAttributes@ - A list of one or more non-key attribute
--         names that are projected into the secondary index. The total
--         count of attributes provided in @NonKeyAttributes@, summed
--         across all of the secondary indexes, must not exceed 100. If you
--         project the same attribute into two different indexes, this
--         counts as two distinct attributes when determining the total.
--
-- -   @ProvisionedThroughput@ - The provisioned throughput settings for
--     the global secondary index, consisting of read and write capacity
--     units.
--
-- 'localSecondaryIndexes', 'createTable_localSecondaryIndexes' - One or more local secondary indexes (the maximum is 5) to be created on
-- the table. Each index is scoped to a given partition key value. There is
-- a 10 GB size limit per partition key value; otherwise, the size of a
-- local secondary index is unconstrained.
--
-- Each local secondary index in the array includes the following:
--
-- -   @IndexName@ - The name of the local secondary index. Must be unique
--     only for this table.
--
-- -   @KeySchema@ - Specifies the key schema for the local secondary
--     index. The key schema must begin with the same partition key as the
--     table.
--
-- -   @Projection@ - Specifies attributes that are copied (projected) from
--     the table into the index. These are in addition to the primary key
--     attributes and index key attributes, which are automatically
--     projected. Each attribute specification is composed of:
--
--     -   @ProjectionType@ - One of the following:
--
--         -   @KEYS_ONLY@ - Only the index and primary keys are projected
--             into the index.
--
--         -   @INCLUDE@ - Only the specified table attributes are
--             projected into the index. The list of projected attributes
--             is in @NonKeyAttributes@.
--
--         -   @ALL@ - All of the table attributes are projected into the
--             index.
--
--     -   @NonKeyAttributes@ - A list of one or more non-key attribute
--         names that are projected into the secondary index. The total
--         count of attributes provided in @NonKeyAttributes@, summed
--         across all of the secondary indexes, must not exceed 100. If you
--         project the same attribute into two different indexes, this
--         counts as two distinct attributes when determining the total.
--
-- 'provisionedThroughput', 'createTable_provisionedThroughput' - Represents the provisioned throughput settings for a specified table or
-- index. The settings can be modified using the @UpdateTable@ operation.
--
-- If you set BillingMode as @PROVISIONED@, you must specify this property.
-- If you set BillingMode as @PAY_PER_REQUEST@, you cannot specify this
-- property.
--
-- For current minimum and maximum provisioned throughput values, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/Limits.html Service, Account, and Table Quotas>
-- in the /Amazon DynamoDB Developer Guide/.
--
-- 'sSESpecification', 'createTable_sSESpecification' - Represents the settings used to enable server-side encryption.
--
-- 'streamSpecification', 'createTable_streamSpecification' - The settings for DynamoDB Streams on the table. These settings consist
-- of:
--
-- -   @StreamEnabled@ - Indicates whether DynamoDB Streams is to be
--     enabled (true) or disabled (false).
--
-- -   @StreamViewType@ - When an item in the table is modified,
--     @StreamViewType@ determines what information is written to the
--     table\'s stream. Valid values for @StreamViewType@ are:
--
--     -   @KEYS_ONLY@ - Only the key attributes of the modified item are
--         written to the stream.
--
--     -   @NEW_IMAGE@ - The entire item, as it appears after it was
--         modified, is written to the stream.
--
--     -   @OLD_IMAGE@ - The entire item, as it appeared before it was
--         modified, is written to the stream.
--
--     -   @NEW_AND_OLD_IMAGES@ - Both the new and the old item images of
--         the item are written to the stream.
--
-- 'tableClass', 'createTable_tableClass' - The table class of the new table. Valid values are @STANDARD@ and
-- @STANDARD_INFREQUENT_ACCESS@.
--
-- 'tags', 'createTable_tags' - A list of key-value pairs to label the table. For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/Tagging.html Tagging for DynamoDB>.
--
-- 'attributeDefinitions', 'createTable_attributeDefinitions' - An array of attributes that describe the key schema for the table and
-- indexes.
--
-- 'tableName', 'createTable_tableName' - The name of the table to create.
--
-- 'keySchema', 'createTable_keySchema' - Specifies the attributes that make up the primary key for a table or an
-- index. The attributes in @KeySchema@ must also be defined in the
-- @AttributeDefinitions@ array. For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/DataModel.html Data Model>
-- in the /Amazon DynamoDB Developer Guide/.
--
-- Each @KeySchemaElement@ in the array is composed of:
--
-- -   @AttributeName@ - The name of this key attribute.
--
-- -   @KeyType@ - The role that the key attribute will assume:
--
--     -   @HASH@ - partition key
--
--     -   @RANGE@ - sort key
--
-- The partition key of an item is also known as its /hash attribute/. The
-- term \"hash attribute\" derives from the DynamoDB usage of an internal
-- hash function to evenly distribute data items across partitions, based
-- on their partition key values.
--
-- The sort key of an item is also known as its /range attribute/. The term
-- \"range attribute\" derives from the way DynamoDB stores items with the
-- same partition key physically close together, in sorted order by the
-- sort key value.
--
-- For a simple primary key (partition key), you must provide exactly one
-- element with a @KeyType@ of @HASH@.
--
-- For a composite primary key (partition key and sort key), you must
-- provide exactly two elements, in this order: The first element must have
-- a @KeyType@ of @HASH@, and the second element must have a @KeyType@ of
-- @RANGE@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/WorkingWithTables.html#WorkingWithTables.primary.key Working with Tables>
-- in the /Amazon DynamoDB Developer Guide/.
newCreateTable ::
  -- | 'tableName'
  Prelude.Text ->
  -- | 'keySchema'
  Prelude.NonEmpty KeySchemaElement ->
  CreateTable
newCreateTable :: Text -> NonEmpty KeySchemaElement -> CreateTable
newCreateTable Text
pTableName_ NonEmpty KeySchemaElement
pKeySchema_ =
  CreateTable'
    { $sel:billingMode:CreateTable' :: Maybe BillingMode
billingMode = forall a. Maybe a
Prelude.Nothing,
      $sel:globalSecondaryIndexes:CreateTable' :: Maybe [GlobalSecondaryIndex]
globalSecondaryIndexes = forall a. Maybe a
Prelude.Nothing,
      $sel:localSecondaryIndexes:CreateTable' :: Maybe [LocalSecondaryIndex]
localSecondaryIndexes = forall a. Maybe a
Prelude.Nothing,
      $sel:provisionedThroughput:CreateTable' :: Maybe ProvisionedThroughput
provisionedThroughput = forall a. Maybe a
Prelude.Nothing,
      $sel:sSESpecification:CreateTable' :: Maybe SSESpecification
sSESpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:streamSpecification:CreateTable' :: Maybe StreamSpecification
streamSpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:tableClass:CreateTable' :: Maybe TableClass
tableClass = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateTable' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:attributeDefinitions:CreateTable' :: [AttributeDefinition]
attributeDefinitions = forall a. Monoid a => a
Prelude.mempty,
      $sel:tableName:CreateTable' :: Text
tableName = Text
pTableName_,
      $sel:keySchema:CreateTable' :: NonEmpty KeySchemaElement
keySchema = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty KeySchemaElement
pKeySchema_
    }

-- | Controls how you are charged for read and write throughput and how you
-- manage capacity. This setting can be changed later.
--
-- -   @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>.
createTable_billingMode :: Lens.Lens' CreateTable (Prelude.Maybe BillingMode)
createTable_billingMode :: Lens' CreateTable (Maybe BillingMode)
createTable_billingMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTable' {Maybe BillingMode
billingMode :: Maybe BillingMode
$sel:billingMode:CreateTable' :: CreateTable -> Maybe BillingMode
billingMode} -> Maybe BillingMode
billingMode) (\s :: CreateTable
s@CreateTable' {} Maybe BillingMode
a -> CreateTable
s {$sel:billingMode:CreateTable' :: Maybe BillingMode
billingMode = Maybe BillingMode
a} :: CreateTable)

-- | One or more global secondary indexes (the maximum is 20) to be created
-- on the table. Each global secondary index in the array includes the
-- following:
--
-- -   @IndexName@ - The name of the global secondary index. Must be unique
--     only for this table.
--
-- -   @KeySchema@ - Specifies the key schema for the global secondary
--     index.
--
-- -   @Projection@ - Specifies attributes that are copied (projected) from
--     the table into the index. These are in addition to the primary key
--     attributes and index key attributes, which are automatically
--     projected. Each attribute specification is composed of:
--
--     -   @ProjectionType@ - One of the following:
--
--         -   @KEYS_ONLY@ - Only the index and primary keys are projected
--             into the index.
--
--         -   @INCLUDE@ - Only the specified table attributes are
--             projected into the index. The list of projected attributes
--             is in @NonKeyAttributes@.
--
--         -   @ALL@ - All of the table attributes are projected into the
--             index.
--
--     -   @NonKeyAttributes@ - A list of one or more non-key attribute
--         names that are projected into the secondary index. The total
--         count of attributes provided in @NonKeyAttributes@, summed
--         across all of the secondary indexes, must not exceed 100. If you
--         project the same attribute into two different indexes, this
--         counts as two distinct attributes when determining the total.
--
-- -   @ProvisionedThroughput@ - The provisioned throughput settings for
--     the global secondary index, consisting of read and write capacity
--     units.
createTable_globalSecondaryIndexes :: Lens.Lens' CreateTable (Prelude.Maybe [GlobalSecondaryIndex])
createTable_globalSecondaryIndexes :: Lens' CreateTable (Maybe [GlobalSecondaryIndex])
createTable_globalSecondaryIndexes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTable' {Maybe [GlobalSecondaryIndex]
globalSecondaryIndexes :: Maybe [GlobalSecondaryIndex]
$sel:globalSecondaryIndexes:CreateTable' :: CreateTable -> Maybe [GlobalSecondaryIndex]
globalSecondaryIndexes} -> Maybe [GlobalSecondaryIndex]
globalSecondaryIndexes) (\s :: CreateTable
s@CreateTable' {} Maybe [GlobalSecondaryIndex]
a -> CreateTable
s {$sel:globalSecondaryIndexes:CreateTable' :: Maybe [GlobalSecondaryIndex]
globalSecondaryIndexes = Maybe [GlobalSecondaryIndex]
a} :: CreateTable) 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

-- | One or more local secondary indexes (the maximum is 5) to be created on
-- the table. Each index is scoped to a given partition key value. There is
-- a 10 GB size limit per partition key value; otherwise, the size of a
-- local secondary index is unconstrained.
--
-- Each local secondary index in the array includes the following:
--
-- -   @IndexName@ - The name of the local secondary index. Must be unique
--     only for this table.
--
-- -   @KeySchema@ - Specifies the key schema for the local secondary
--     index. The key schema must begin with the same partition key as the
--     table.
--
-- -   @Projection@ - Specifies attributes that are copied (projected) from
--     the table into the index. These are in addition to the primary key
--     attributes and index key attributes, which are automatically
--     projected. Each attribute specification is composed of:
--
--     -   @ProjectionType@ - One of the following:
--
--         -   @KEYS_ONLY@ - Only the index and primary keys are projected
--             into the index.
--
--         -   @INCLUDE@ - Only the specified table attributes are
--             projected into the index. The list of projected attributes
--             is in @NonKeyAttributes@.
--
--         -   @ALL@ - All of the table attributes are projected into the
--             index.
--
--     -   @NonKeyAttributes@ - A list of one or more non-key attribute
--         names that are projected into the secondary index. The total
--         count of attributes provided in @NonKeyAttributes@, summed
--         across all of the secondary indexes, must not exceed 100. If you
--         project the same attribute into two different indexes, this
--         counts as two distinct attributes when determining the total.
createTable_localSecondaryIndexes :: Lens.Lens' CreateTable (Prelude.Maybe [LocalSecondaryIndex])
createTable_localSecondaryIndexes :: Lens' CreateTable (Maybe [LocalSecondaryIndex])
createTable_localSecondaryIndexes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTable' {Maybe [LocalSecondaryIndex]
localSecondaryIndexes :: Maybe [LocalSecondaryIndex]
$sel:localSecondaryIndexes:CreateTable' :: CreateTable -> Maybe [LocalSecondaryIndex]
localSecondaryIndexes} -> Maybe [LocalSecondaryIndex]
localSecondaryIndexes) (\s :: CreateTable
s@CreateTable' {} Maybe [LocalSecondaryIndex]
a -> CreateTable
s {$sel:localSecondaryIndexes:CreateTable' :: Maybe [LocalSecondaryIndex]
localSecondaryIndexes = Maybe [LocalSecondaryIndex]
a} :: CreateTable) 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

-- | Represents the provisioned throughput settings for a specified table or
-- index. The settings can be modified using the @UpdateTable@ operation.
--
-- If you set BillingMode as @PROVISIONED@, you must specify this property.
-- If you set BillingMode as @PAY_PER_REQUEST@, you cannot specify this
-- property.
--
-- For current minimum and maximum provisioned throughput values, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/Limits.html Service, Account, and Table Quotas>
-- in the /Amazon DynamoDB Developer Guide/.
createTable_provisionedThroughput :: Lens.Lens' CreateTable (Prelude.Maybe ProvisionedThroughput)
createTable_provisionedThroughput :: Lens' CreateTable (Maybe ProvisionedThroughput)
createTable_provisionedThroughput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTable' {Maybe ProvisionedThroughput
provisionedThroughput :: Maybe ProvisionedThroughput
$sel:provisionedThroughput:CreateTable' :: CreateTable -> Maybe ProvisionedThroughput
provisionedThroughput} -> Maybe ProvisionedThroughput
provisionedThroughput) (\s :: CreateTable
s@CreateTable' {} Maybe ProvisionedThroughput
a -> CreateTable
s {$sel:provisionedThroughput:CreateTable' :: Maybe ProvisionedThroughput
provisionedThroughput = Maybe ProvisionedThroughput
a} :: CreateTable)

-- | Represents the settings used to enable server-side encryption.
createTable_sSESpecification :: Lens.Lens' CreateTable (Prelude.Maybe SSESpecification)
createTable_sSESpecification :: Lens' CreateTable (Maybe SSESpecification)
createTable_sSESpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTable' {Maybe SSESpecification
sSESpecification :: Maybe SSESpecification
$sel:sSESpecification:CreateTable' :: CreateTable -> Maybe SSESpecification
sSESpecification} -> Maybe SSESpecification
sSESpecification) (\s :: CreateTable
s@CreateTable' {} Maybe SSESpecification
a -> CreateTable
s {$sel:sSESpecification:CreateTable' :: Maybe SSESpecification
sSESpecification = Maybe SSESpecification
a} :: CreateTable)

-- | The settings for DynamoDB Streams on the table. These settings consist
-- of:
--
-- -   @StreamEnabled@ - Indicates whether DynamoDB Streams is to be
--     enabled (true) or disabled (false).
--
-- -   @StreamViewType@ - When an item in the table is modified,
--     @StreamViewType@ determines what information is written to the
--     table\'s stream. Valid values for @StreamViewType@ are:
--
--     -   @KEYS_ONLY@ - Only the key attributes of the modified item are
--         written to the stream.
--
--     -   @NEW_IMAGE@ - The entire item, as it appears after it was
--         modified, is written to the stream.
--
--     -   @OLD_IMAGE@ - The entire item, as it appeared before it was
--         modified, is written to the stream.
--
--     -   @NEW_AND_OLD_IMAGES@ - Both the new and the old item images of
--         the item are written to the stream.
createTable_streamSpecification :: Lens.Lens' CreateTable (Prelude.Maybe StreamSpecification)
createTable_streamSpecification :: Lens' CreateTable (Maybe StreamSpecification)
createTable_streamSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTable' {Maybe StreamSpecification
streamSpecification :: Maybe StreamSpecification
$sel:streamSpecification:CreateTable' :: CreateTable -> Maybe StreamSpecification
streamSpecification} -> Maybe StreamSpecification
streamSpecification) (\s :: CreateTable
s@CreateTable' {} Maybe StreamSpecification
a -> CreateTable
s {$sel:streamSpecification:CreateTable' :: Maybe StreamSpecification
streamSpecification = Maybe StreamSpecification
a} :: CreateTable)

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

-- | A list of key-value pairs to label the table. For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/Tagging.html Tagging for DynamoDB>.
createTable_tags :: Lens.Lens' CreateTable (Prelude.Maybe [Tag])
createTable_tags :: Lens' CreateTable (Maybe [Tag])
createTable_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTable' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateTable' :: CreateTable -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateTable
s@CreateTable' {} Maybe [Tag]
a -> CreateTable
s {$sel:tags:CreateTable' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateTable) 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

-- | An array of attributes that describe the key schema for the table and
-- indexes.
createTable_attributeDefinitions :: Lens.Lens' CreateTable [AttributeDefinition]
createTable_attributeDefinitions :: Lens' CreateTable [AttributeDefinition]
createTable_attributeDefinitions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTable' {[AttributeDefinition]
attributeDefinitions :: [AttributeDefinition]
$sel:attributeDefinitions:CreateTable' :: CreateTable -> [AttributeDefinition]
attributeDefinitions} -> [AttributeDefinition]
attributeDefinitions) (\s :: CreateTable
s@CreateTable' {} [AttributeDefinition]
a -> CreateTable
s {$sel:attributeDefinitions:CreateTable' :: [AttributeDefinition]
attributeDefinitions = [AttributeDefinition]
a} :: CreateTable) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

-- | Specifies the attributes that make up the primary key for a table or an
-- index. The attributes in @KeySchema@ must also be defined in the
-- @AttributeDefinitions@ array. For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/DataModel.html Data Model>
-- in the /Amazon DynamoDB Developer Guide/.
--
-- Each @KeySchemaElement@ in the array is composed of:
--
-- -   @AttributeName@ - The name of this key attribute.
--
-- -   @KeyType@ - The role that the key attribute will assume:
--
--     -   @HASH@ - partition key
--
--     -   @RANGE@ - sort key
--
-- The partition key of an item is also known as its /hash attribute/. The
-- term \"hash attribute\" derives from the DynamoDB usage of an internal
-- hash function to evenly distribute data items across partitions, based
-- on their partition key values.
--
-- The sort key of an item is also known as its /range attribute/. The term
-- \"range attribute\" derives from the way DynamoDB stores items with the
-- same partition key physically close together, in sorted order by the
-- sort key value.
--
-- For a simple primary key (partition key), you must provide exactly one
-- element with a @KeyType@ of @HASH@.
--
-- For a composite primary key (partition key and sort key), you must
-- provide exactly two elements, in this order: The first element must have
-- a @KeyType@ of @HASH@, and the second element must have a @KeyType@ of
-- @RANGE@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/WorkingWithTables.html#WorkingWithTables.primary.key Working with Tables>
-- in the /Amazon DynamoDB Developer Guide/.
createTable_keySchema :: Lens.Lens' CreateTable (Prelude.NonEmpty KeySchemaElement)
createTable_keySchema :: Lens' CreateTable (NonEmpty KeySchemaElement)
createTable_keySchema = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTable' {NonEmpty KeySchemaElement
keySchema :: NonEmpty KeySchemaElement
$sel:keySchema:CreateTable' :: CreateTable -> NonEmpty KeySchemaElement
keySchema} -> NonEmpty KeySchemaElement
keySchema) (\s :: CreateTable
s@CreateTable' {} NonEmpty KeySchemaElement
a -> CreateTable
s {$sel:keySchema:CreateTable' :: NonEmpty KeySchemaElement
keySchema = NonEmpty KeySchemaElement
a} :: CreateTable) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateTable where
  type AWSResponse CreateTable = CreateTableResponse
  request :: (Service -> Service) -> CreateTable -> Request CreateTable
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 CreateTable
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateTable)))
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 -> CreateTableResponse
CreateTableResponse'
            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 CreateTable where
  hashWithSalt :: Int -> CreateTable -> Int
hashWithSalt Int
_salt CreateTable' {[AttributeDefinition]
Maybe [Tag]
Maybe [LocalSecondaryIndex]
Maybe [GlobalSecondaryIndex]
Maybe TableClass
Maybe StreamSpecification
Maybe SSESpecification
Maybe ProvisionedThroughput
Maybe BillingMode
NonEmpty KeySchemaElement
Text
keySchema :: NonEmpty KeySchemaElement
tableName :: Text
attributeDefinitions :: [AttributeDefinition]
tags :: Maybe [Tag]
tableClass :: Maybe TableClass
streamSpecification :: Maybe StreamSpecification
sSESpecification :: Maybe SSESpecification
provisionedThroughput :: Maybe ProvisionedThroughput
localSecondaryIndexes :: Maybe [LocalSecondaryIndex]
globalSecondaryIndexes :: Maybe [GlobalSecondaryIndex]
billingMode :: Maybe BillingMode
$sel:keySchema:CreateTable' :: CreateTable -> NonEmpty KeySchemaElement
$sel:tableName:CreateTable' :: CreateTable -> Text
$sel:attributeDefinitions:CreateTable' :: CreateTable -> [AttributeDefinition]
$sel:tags:CreateTable' :: CreateTable -> Maybe [Tag]
$sel:tableClass:CreateTable' :: CreateTable -> Maybe TableClass
$sel:streamSpecification:CreateTable' :: CreateTable -> Maybe StreamSpecification
$sel:sSESpecification:CreateTable' :: CreateTable -> Maybe SSESpecification
$sel:provisionedThroughput:CreateTable' :: CreateTable -> Maybe ProvisionedThroughput
$sel:localSecondaryIndexes:CreateTable' :: CreateTable -> Maybe [LocalSecondaryIndex]
$sel:globalSecondaryIndexes:CreateTable' :: CreateTable -> Maybe [GlobalSecondaryIndex]
$sel:billingMode:CreateTable' :: CreateTable -> Maybe BillingMode
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BillingMode
billingMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [GlobalSecondaryIndex]
globalSecondaryIndexes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [LocalSecondaryIndex]
localSecondaryIndexes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProvisionedThroughput
provisionedThroughput
      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` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [AttributeDefinition]
attributeDefinitions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty KeySchemaElement
keySchema

instance Prelude.NFData CreateTable where
  rnf :: CreateTable -> ()
rnf CreateTable' {[AttributeDefinition]
Maybe [Tag]
Maybe [LocalSecondaryIndex]
Maybe [GlobalSecondaryIndex]
Maybe TableClass
Maybe StreamSpecification
Maybe SSESpecification
Maybe ProvisionedThroughput
Maybe BillingMode
NonEmpty KeySchemaElement
Text
keySchema :: NonEmpty KeySchemaElement
tableName :: Text
attributeDefinitions :: [AttributeDefinition]
tags :: Maybe [Tag]
tableClass :: Maybe TableClass
streamSpecification :: Maybe StreamSpecification
sSESpecification :: Maybe SSESpecification
provisionedThroughput :: Maybe ProvisionedThroughput
localSecondaryIndexes :: Maybe [LocalSecondaryIndex]
globalSecondaryIndexes :: Maybe [GlobalSecondaryIndex]
billingMode :: Maybe BillingMode
$sel:keySchema:CreateTable' :: CreateTable -> NonEmpty KeySchemaElement
$sel:tableName:CreateTable' :: CreateTable -> Text
$sel:attributeDefinitions:CreateTable' :: CreateTable -> [AttributeDefinition]
$sel:tags:CreateTable' :: CreateTable -> Maybe [Tag]
$sel:tableClass:CreateTable' :: CreateTable -> Maybe TableClass
$sel:streamSpecification:CreateTable' :: CreateTable -> Maybe StreamSpecification
$sel:sSESpecification:CreateTable' :: CreateTable -> Maybe SSESpecification
$sel:provisionedThroughput:CreateTable' :: CreateTable -> Maybe ProvisionedThroughput
$sel:localSecondaryIndexes:CreateTable' :: CreateTable -> Maybe [LocalSecondaryIndex]
$sel:globalSecondaryIndexes:CreateTable' :: CreateTable -> Maybe [GlobalSecondaryIndex]
$sel:billingMode:CreateTable' :: CreateTable -> Maybe BillingMode
..} =
    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 [GlobalSecondaryIndex]
globalSecondaryIndexes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [LocalSecondaryIndex]
localSecondaryIndexes
      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 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 Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [AttributeDefinition]
attributeDefinitions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
tableName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty KeySchemaElement
keySchema

instance Data.ToHeaders CreateTable where
  toHeaders :: CreateTable -> 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.CreateTable" ::
                          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 CreateTable where
  toJSON :: CreateTable -> Value
toJSON CreateTable' {[AttributeDefinition]
Maybe [Tag]
Maybe [LocalSecondaryIndex]
Maybe [GlobalSecondaryIndex]
Maybe TableClass
Maybe StreamSpecification
Maybe SSESpecification
Maybe ProvisionedThroughput
Maybe BillingMode
NonEmpty KeySchemaElement
Text
keySchema :: NonEmpty KeySchemaElement
tableName :: Text
attributeDefinitions :: [AttributeDefinition]
tags :: Maybe [Tag]
tableClass :: Maybe TableClass
streamSpecification :: Maybe StreamSpecification
sSESpecification :: Maybe SSESpecification
provisionedThroughput :: Maybe ProvisionedThroughput
localSecondaryIndexes :: Maybe [LocalSecondaryIndex]
globalSecondaryIndexes :: Maybe [GlobalSecondaryIndex]
billingMode :: Maybe BillingMode
$sel:keySchema:CreateTable' :: CreateTable -> NonEmpty KeySchemaElement
$sel:tableName:CreateTable' :: CreateTable -> Text
$sel:attributeDefinitions:CreateTable' :: CreateTable -> [AttributeDefinition]
$sel:tags:CreateTable' :: CreateTable -> Maybe [Tag]
$sel:tableClass:CreateTable' :: CreateTable -> Maybe TableClass
$sel:streamSpecification:CreateTable' :: CreateTable -> Maybe StreamSpecification
$sel:sSESpecification:CreateTable' :: CreateTable -> Maybe SSESpecification
$sel:provisionedThroughput:CreateTable' :: CreateTable -> Maybe ProvisionedThroughput
$sel:localSecondaryIndexes:CreateTable' :: CreateTable -> Maybe [LocalSecondaryIndex]
$sel:globalSecondaryIndexes:CreateTable' :: CreateTable -> Maybe [GlobalSecondaryIndex]
$sel:billingMode:CreateTable' :: CreateTable -> Maybe BillingMode
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"GlobalSecondaryIndexes" 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 [GlobalSecondaryIndex]
globalSecondaryIndexes,
            (Key
"LocalSecondaryIndexes" 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 [LocalSecondaryIndex]
localSecondaryIndexes,
            (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
"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,
            (Key
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"AttributeDefinitions"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [AttributeDefinition]
attributeDefinitions
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"TableName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
tableName),
            forall a. a -> Maybe a
Prelude.Just (Key
"KeySchema" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty KeySchemaElement
keySchema)
          ]
      )

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

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

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

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

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

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

instance Prelude.NFData CreateTableResponse where
  rnf :: CreateTableResponse -> ()
rnf CreateTableResponse' {Int
Maybe TableDescription
httpStatus :: Int
tableDescription :: Maybe TableDescription
$sel:httpStatus:CreateTableResponse' :: CreateTableResponse -> Int
$sel:tableDescription:CreateTableResponse' :: CreateTableResponse -> 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