{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.TableCreationParameters
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.DynamoDB.Types.TableCreationParameters 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.AttributeDefinition
import Amazonka.DynamoDB.Types.AttributeValue
import Amazonka.DynamoDB.Types.BillingMode
import Amazonka.DynamoDB.Types.GlobalSecondaryIndex
import Amazonka.DynamoDB.Types.KeySchemaElement
import Amazonka.DynamoDB.Types.ProvisionedThroughput
import Amazonka.DynamoDB.Types.SSESpecification
import Amazonka.DynamoDB.Types.WriteRequest
import qualified Amazonka.Prelude as Prelude

-- | The parameters for the table created as part of the import operation.
--
-- /See:/ 'newTableCreationParameters' smart constructor.
data TableCreationParameters = TableCreationParameters'
  { -- | The billing mode for provisioning the table created as part of the
    -- import operation.
    TableCreationParameters -> Maybe BillingMode
billingMode :: Prelude.Maybe BillingMode,
    -- | The Global Secondary Indexes (GSI) of the table to be created as part of
    -- the import operation.
    TableCreationParameters -> Maybe [GlobalSecondaryIndex]
globalSecondaryIndexes :: Prelude.Maybe [GlobalSecondaryIndex],
    TableCreationParameters -> Maybe ProvisionedThroughput
provisionedThroughput :: Prelude.Maybe ProvisionedThroughput,
    TableCreationParameters -> Maybe SSESpecification
sSESpecification :: Prelude.Maybe SSESpecification,
    -- | The name of the table created as part of the import operation.
    TableCreationParameters -> Text
tableName :: Prelude.Text,
    -- | The attributes of the table created as part of the import operation.
    TableCreationParameters -> [AttributeDefinition]
attributeDefinitions :: [AttributeDefinition],
    -- | The primary key and option sort key of the table created as part of the
    -- import operation.
    TableCreationParameters -> NonEmpty KeySchemaElement
keySchema :: Prelude.NonEmpty KeySchemaElement
  }
  deriving (TableCreationParameters -> TableCreationParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableCreationParameters -> TableCreationParameters -> Bool
$c/= :: TableCreationParameters -> TableCreationParameters -> Bool
== :: TableCreationParameters -> TableCreationParameters -> Bool
$c== :: TableCreationParameters -> TableCreationParameters -> Bool
Prelude.Eq, ReadPrec [TableCreationParameters]
ReadPrec TableCreationParameters
Int -> ReadS TableCreationParameters
ReadS [TableCreationParameters]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TableCreationParameters]
$creadListPrec :: ReadPrec [TableCreationParameters]
readPrec :: ReadPrec TableCreationParameters
$creadPrec :: ReadPrec TableCreationParameters
readList :: ReadS [TableCreationParameters]
$creadList :: ReadS [TableCreationParameters]
readsPrec :: Int -> ReadS TableCreationParameters
$creadsPrec :: Int -> ReadS TableCreationParameters
Prelude.Read, Int -> TableCreationParameters -> ShowS
[TableCreationParameters] -> ShowS
TableCreationParameters -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableCreationParameters] -> ShowS
$cshowList :: [TableCreationParameters] -> ShowS
show :: TableCreationParameters -> String
$cshow :: TableCreationParameters -> String
showsPrec :: Int -> TableCreationParameters -> ShowS
$cshowsPrec :: Int -> TableCreationParameters -> ShowS
Prelude.Show, forall x. Rep TableCreationParameters x -> TableCreationParameters
forall x. TableCreationParameters -> Rep TableCreationParameters x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TableCreationParameters x -> TableCreationParameters
$cfrom :: forall x. TableCreationParameters -> Rep TableCreationParameters x
Prelude.Generic)

-- |
-- Create a value of 'TableCreationParameters' 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', 'tableCreationParameters_billingMode' - The billing mode for provisioning the table created as part of the
-- import operation.
--
-- 'globalSecondaryIndexes', 'tableCreationParameters_globalSecondaryIndexes' - The Global Secondary Indexes (GSI) of the table to be created as part of
-- the import operation.
--
-- 'provisionedThroughput', 'tableCreationParameters_provisionedThroughput' - Undocumented member.
--
-- 'sSESpecification', 'tableCreationParameters_sSESpecification' - Undocumented member.
--
-- 'tableName', 'tableCreationParameters_tableName' - The name of the table created as part of the import operation.
--
-- 'attributeDefinitions', 'tableCreationParameters_attributeDefinitions' - The attributes of the table created as part of the import operation.
--
-- 'keySchema', 'tableCreationParameters_keySchema' - The primary key and option sort key of the table created as part of the
-- import operation.
newTableCreationParameters ::
  -- | 'tableName'
  Prelude.Text ->
  -- | 'keySchema'
  Prelude.NonEmpty KeySchemaElement ->
  TableCreationParameters
newTableCreationParameters :: Text -> NonEmpty KeySchemaElement -> TableCreationParameters
newTableCreationParameters Text
pTableName_ NonEmpty KeySchemaElement
pKeySchema_ =
  TableCreationParameters'
    { $sel:billingMode:TableCreationParameters' :: Maybe BillingMode
billingMode =
        forall a. Maybe a
Prelude.Nothing,
      $sel:globalSecondaryIndexes:TableCreationParameters' :: Maybe [GlobalSecondaryIndex]
globalSecondaryIndexes = forall a. Maybe a
Prelude.Nothing,
      $sel:provisionedThroughput:TableCreationParameters' :: Maybe ProvisionedThroughput
provisionedThroughput = forall a. Maybe a
Prelude.Nothing,
      $sel:sSESpecification:TableCreationParameters' :: Maybe SSESpecification
sSESpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:tableName:TableCreationParameters' :: Text
tableName = Text
pTableName_,
      $sel:attributeDefinitions:TableCreationParameters' :: [AttributeDefinition]
attributeDefinitions = forall a. Monoid a => a
Prelude.mempty,
      $sel:keySchema:TableCreationParameters' :: 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_
    }

-- | The billing mode for provisioning the table created as part of the
-- import operation.
tableCreationParameters_billingMode :: Lens.Lens' TableCreationParameters (Prelude.Maybe BillingMode)
tableCreationParameters_billingMode :: Lens' TableCreationParameters (Maybe BillingMode)
tableCreationParameters_billingMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCreationParameters' {Maybe BillingMode
billingMode :: Maybe BillingMode
$sel:billingMode:TableCreationParameters' :: TableCreationParameters -> Maybe BillingMode
billingMode} -> Maybe BillingMode
billingMode) (\s :: TableCreationParameters
s@TableCreationParameters' {} Maybe BillingMode
a -> TableCreationParameters
s {$sel:billingMode:TableCreationParameters' :: Maybe BillingMode
billingMode = Maybe BillingMode
a} :: TableCreationParameters)

-- | The Global Secondary Indexes (GSI) of the table to be created as part of
-- the import operation.
tableCreationParameters_globalSecondaryIndexes :: Lens.Lens' TableCreationParameters (Prelude.Maybe [GlobalSecondaryIndex])
tableCreationParameters_globalSecondaryIndexes :: Lens' TableCreationParameters (Maybe [GlobalSecondaryIndex])
tableCreationParameters_globalSecondaryIndexes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCreationParameters' {Maybe [GlobalSecondaryIndex]
globalSecondaryIndexes :: Maybe [GlobalSecondaryIndex]
$sel:globalSecondaryIndexes:TableCreationParameters' :: TableCreationParameters -> Maybe [GlobalSecondaryIndex]
globalSecondaryIndexes} -> Maybe [GlobalSecondaryIndex]
globalSecondaryIndexes) (\s :: TableCreationParameters
s@TableCreationParameters' {} Maybe [GlobalSecondaryIndex]
a -> TableCreationParameters
s {$sel:globalSecondaryIndexes:TableCreationParameters' :: Maybe [GlobalSecondaryIndex]
globalSecondaryIndexes = Maybe [GlobalSecondaryIndex]
a} :: TableCreationParameters) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Undocumented member.
tableCreationParameters_provisionedThroughput :: Lens.Lens' TableCreationParameters (Prelude.Maybe ProvisionedThroughput)
tableCreationParameters_provisionedThroughput :: Lens' TableCreationParameters (Maybe ProvisionedThroughput)
tableCreationParameters_provisionedThroughput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCreationParameters' {Maybe ProvisionedThroughput
provisionedThroughput :: Maybe ProvisionedThroughput
$sel:provisionedThroughput:TableCreationParameters' :: TableCreationParameters -> Maybe ProvisionedThroughput
provisionedThroughput} -> Maybe ProvisionedThroughput
provisionedThroughput) (\s :: TableCreationParameters
s@TableCreationParameters' {} Maybe ProvisionedThroughput
a -> TableCreationParameters
s {$sel:provisionedThroughput:TableCreationParameters' :: Maybe ProvisionedThroughput
provisionedThroughput = Maybe ProvisionedThroughput
a} :: TableCreationParameters)

-- | Undocumented member.
tableCreationParameters_sSESpecification :: Lens.Lens' TableCreationParameters (Prelude.Maybe SSESpecification)
tableCreationParameters_sSESpecification :: Lens' TableCreationParameters (Maybe SSESpecification)
tableCreationParameters_sSESpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCreationParameters' {Maybe SSESpecification
sSESpecification :: Maybe SSESpecification
$sel:sSESpecification:TableCreationParameters' :: TableCreationParameters -> Maybe SSESpecification
sSESpecification} -> Maybe SSESpecification
sSESpecification) (\s :: TableCreationParameters
s@TableCreationParameters' {} Maybe SSESpecification
a -> TableCreationParameters
s {$sel:sSESpecification:TableCreationParameters' :: Maybe SSESpecification
sSESpecification = Maybe SSESpecification
a} :: TableCreationParameters)

-- | The name of the table created as part of the import operation.
tableCreationParameters_tableName :: Lens.Lens' TableCreationParameters Prelude.Text
tableCreationParameters_tableName :: Lens' TableCreationParameters Text
tableCreationParameters_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCreationParameters' {Text
tableName :: Text
$sel:tableName:TableCreationParameters' :: TableCreationParameters -> Text
tableName} -> Text
tableName) (\s :: TableCreationParameters
s@TableCreationParameters' {} Text
a -> TableCreationParameters
s {$sel:tableName:TableCreationParameters' :: Text
tableName = Text
a} :: TableCreationParameters)

-- | The attributes of the table created as part of the import operation.
tableCreationParameters_attributeDefinitions :: Lens.Lens' TableCreationParameters [AttributeDefinition]
tableCreationParameters_attributeDefinitions :: Lens' TableCreationParameters [AttributeDefinition]
tableCreationParameters_attributeDefinitions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCreationParameters' {[AttributeDefinition]
attributeDefinitions :: [AttributeDefinition]
$sel:attributeDefinitions:TableCreationParameters' :: TableCreationParameters -> [AttributeDefinition]
attributeDefinitions} -> [AttributeDefinition]
attributeDefinitions) (\s :: TableCreationParameters
s@TableCreationParameters' {} [AttributeDefinition]
a -> TableCreationParameters
s {$sel:attributeDefinitions:TableCreationParameters' :: [AttributeDefinition]
attributeDefinitions = [AttributeDefinition]
a} :: TableCreationParameters) 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 primary key and option sort key of the table created as part of the
-- import operation.
tableCreationParameters_keySchema :: Lens.Lens' TableCreationParameters (Prelude.NonEmpty KeySchemaElement)
tableCreationParameters_keySchema :: Lens' TableCreationParameters (NonEmpty KeySchemaElement)
tableCreationParameters_keySchema = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TableCreationParameters' {NonEmpty KeySchemaElement
keySchema :: NonEmpty KeySchemaElement
$sel:keySchema:TableCreationParameters' :: TableCreationParameters -> NonEmpty KeySchemaElement
keySchema} -> NonEmpty KeySchemaElement
keySchema) (\s :: TableCreationParameters
s@TableCreationParameters' {} NonEmpty KeySchemaElement
a -> TableCreationParameters
s {$sel:keySchema:TableCreationParameters' :: NonEmpty KeySchemaElement
keySchema = NonEmpty KeySchemaElement
a} :: TableCreationParameters) 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 Data.FromJSON TableCreationParameters where
  parseJSON :: Value -> Parser TableCreationParameters
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"TableCreationParameters"
      ( \Object
x ->
          Maybe BillingMode
-> Maybe [GlobalSecondaryIndex]
-> Maybe ProvisionedThroughput
-> Maybe SSESpecification
-> Text
-> [AttributeDefinition]
-> NonEmpty KeySchemaElement
-> TableCreationParameters
TableCreationParameters'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"BillingMode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"GlobalSecondaryIndexes"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ProvisionedThroughput")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SSESpecification")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"TableName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AttributeDefinitions"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"KeySchema")
      )

instance Prelude.Hashable TableCreationParameters where
  hashWithSalt :: Int -> TableCreationParameters -> Int
hashWithSalt Int
_salt TableCreationParameters' {[AttributeDefinition]
Maybe [GlobalSecondaryIndex]
Maybe SSESpecification
Maybe ProvisionedThroughput
Maybe BillingMode
NonEmpty KeySchemaElement
Text
keySchema :: NonEmpty KeySchemaElement
attributeDefinitions :: [AttributeDefinition]
tableName :: Text
sSESpecification :: Maybe SSESpecification
provisionedThroughput :: Maybe ProvisionedThroughput
globalSecondaryIndexes :: Maybe [GlobalSecondaryIndex]
billingMode :: Maybe BillingMode
$sel:keySchema:TableCreationParameters' :: TableCreationParameters -> NonEmpty KeySchemaElement
$sel:attributeDefinitions:TableCreationParameters' :: TableCreationParameters -> [AttributeDefinition]
$sel:tableName:TableCreationParameters' :: TableCreationParameters -> Text
$sel:sSESpecification:TableCreationParameters' :: TableCreationParameters -> Maybe SSESpecification
$sel:provisionedThroughput:TableCreationParameters' :: TableCreationParameters -> Maybe ProvisionedThroughput
$sel:globalSecondaryIndexes:TableCreationParameters' :: TableCreationParameters -> Maybe [GlobalSecondaryIndex]
$sel:billingMode:TableCreationParameters' :: TableCreationParameters -> 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 ProvisionedThroughput
provisionedThroughput
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SSESpecification
sSESpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [AttributeDefinition]
attributeDefinitions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty KeySchemaElement
keySchema

instance Prelude.NFData TableCreationParameters where
  rnf :: TableCreationParameters -> ()
rnf TableCreationParameters' {[AttributeDefinition]
Maybe [GlobalSecondaryIndex]
Maybe SSESpecification
Maybe ProvisionedThroughput
Maybe BillingMode
NonEmpty KeySchemaElement
Text
keySchema :: NonEmpty KeySchemaElement
attributeDefinitions :: [AttributeDefinition]
tableName :: Text
sSESpecification :: Maybe SSESpecification
provisionedThroughput :: Maybe ProvisionedThroughput
globalSecondaryIndexes :: Maybe [GlobalSecondaryIndex]
billingMode :: Maybe BillingMode
$sel:keySchema:TableCreationParameters' :: TableCreationParameters -> NonEmpty KeySchemaElement
$sel:attributeDefinitions:TableCreationParameters' :: TableCreationParameters -> [AttributeDefinition]
$sel:tableName:TableCreationParameters' :: TableCreationParameters -> Text
$sel:sSESpecification:TableCreationParameters' :: TableCreationParameters -> Maybe SSESpecification
$sel:provisionedThroughput:TableCreationParameters' :: TableCreationParameters -> Maybe ProvisionedThroughput
$sel:globalSecondaryIndexes:TableCreationParameters' :: TableCreationParameters -> Maybe [GlobalSecondaryIndex]
$sel:billingMode:TableCreationParameters' :: TableCreationParameters -> 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 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 Text
tableName
      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 NonEmpty KeySchemaElement
keySchema

instance Data.ToJSON TableCreationParameters where
  toJSON :: TableCreationParameters -> Value
toJSON TableCreationParameters' {[AttributeDefinition]
Maybe [GlobalSecondaryIndex]
Maybe SSESpecification
Maybe ProvisionedThroughput
Maybe BillingMode
NonEmpty KeySchemaElement
Text
keySchema :: NonEmpty KeySchemaElement
attributeDefinitions :: [AttributeDefinition]
tableName :: Text
sSESpecification :: Maybe SSESpecification
provisionedThroughput :: Maybe ProvisionedThroughput
globalSecondaryIndexes :: Maybe [GlobalSecondaryIndex]
billingMode :: Maybe BillingMode
$sel:keySchema:TableCreationParameters' :: TableCreationParameters -> NonEmpty KeySchemaElement
$sel:attributeDefinitions:TableCreationParameters' :: TableCreationParameters -> [AttributeDefinition]
$sel:tableName:TableCreationParameters' :: TableCreationParameters -> Text
$sel:sSESpecification:TableCreationParameters' :: TableCreationParameters -> Maybe SSESpecification
$sel:provisionedThroughput:TableCreationParameters' :: TableCreationParameters -> Maybe ProvisionedThroughput
$sel:globalSecondaryIndexes:TableCreationParameters' :: TableCreationParameters -> Maybe [GlobalSecondaryIndex]
$sel:billingMode:TableCreationParameters' :: TableCreationParameters -> 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
"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,
            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
"AttributeDefinitions"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [AttributeDefinition]
attributeDefinitions
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"KeySchema" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty KeySchemaElement
keySchema)
          ]
      )