{-# 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.CreateGlobalTable
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a global table from an existing table. A global table creates a
-- replication relationship between two or more DynamoDB tables with the
-- same table name in the provided Regions.
--
-- This operation only applies to
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/globaltables.V1.html Version 2017.11.29>
-- of global tables.
--
-- If you want to add a new replica table to a global table, each of the
-- following conditions must be true:
--
-- -   The table must have the same primary key as all of the other
--     replicas.
--
-- -   The table must have the same name as all of the other replicas.
--
-- -   The table must have DynamoDB Streams enabled, with the stream
--     containing both the new and the old images of the item.
--
-- -   None of the replica tables in the global table can contain any data.
--
-- If global secondary indexes are specified, then the following conditions
-- must also be met:
--
-- -   The global secondary indexes must have the same name.
--
-- -   The global secondary indexes must have the same hash key and sort
--     key (if present).
--
-- If local secondary indexes are specified, then the following conditions
-- must also be met:
--
-- -   The local secondary indexes must have the same name.
--
-- -   The local secondary indexes must have the same hash key and sort key
--     (if present).
--
-- Write capacity settings should be set consistently across your replica
-- tables and secondary indexes. DynamoDB strongly recommends enabling auto
-- scaling to manage the write capacity settings for all of your global
-- tables replicas and indexes.
--
-- If you prefer to manage write capacity settings manually, you should
-- provision equal replicated write capacity units to your replica tables.
-- You should also provision equal replicated write capacity units to
-- matching secondary indexes across your global table.
module Amazonka.DynamoDB.CreateGlobalTable
  ( -- * Creating a Request
    CreateGlobalTable (..),
    newCreateGlobalTable,

    -- * Request Lenses
    createGlobalTable_globalTableName,
    createGlobalTable_replicationGroup,

    -- * Destructuring the Response
    CreateGlobalTableResponse (..),
    newCreateGlobalTableResponse,

    -- * Response Lenses
    createGlobalTableResponse_globalTableDescription,
    createGlobalTableResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateGlobalTable' smart constructor.
data CreateGlobalTable = CreateGlobalTable'
  { -- | The global table name.
    CreateGlobalTable -> Text
globalTableName :: Prelude.Text,
    -- | The Regions where the global table needs to be created.
    CreateGlobalTable -> [Replica]
replicationGroup :: [Replica]
  }
  deriving (CreateGlobalTable -> CreateGlobalTable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGlobalTable -> CreateGlobalTable -> Bool
$c/= :: CreateGlobalTable -> CreateGlobalTable -> Bool
== :: CreateGlobalTable -> CreateGlobalTable -> Bool
$c== :: CreateGlobalTable -> CreateGlobalTable -> Bool
Prelude.Eq, ReadPrec [CreateGlobalTable]
ReadPrec CreateGlobalTable
Int -> ReadS CreateGlobalTable
ReadS [CreateGlobalTable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGlobalTable]
$creadListPrec :: ReadPrec [CreateGlobalTable]
readPrec :: ReadPrec CreateGlobalTable
$creadPrec :: ReadPrec CreateGlobalTable
readList :: ReadS [CreateGlobalTable]
$creadList :: ReadS [CreateGlobalTable]
readsPrec :: Int -> ReadS CreateGlobalTable
$creadsPrec :: Int -> ReadS CreateGlobalTable
Prelude.Read, Int -> CreateGlobalTable -> ShowS
[CreateGlobalTable] -> ShowS
CreateGlobalTable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGlobalTable] -> ShowS
$cshowList :: [CreateGlobalTable] -> ShowS
show :: CreateGlobalTable -> String
$cshow :: CreateGlobalTable -> String
showsPrec :: Int -> CreateGlobalTable -> ShowS
$cshowsPrec :: Int -> CreateGlobalTable -> ShowS
Prelude.Show, forall x. Rep CreateGlobalTable x -> CreateGlobalTable
forall x. CreateGlobalTable -> Rep CreateGlobalTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateGlobalTable x -> CreateGlobalTable
$cfrom :: forall x. CreateGlobalTable -> Rep CreateGlobalTable x
Prelude.Generic)

-- |
-- Create a value of 'CreateGlobalTable' 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:
--
-- 'globalTableName', 'createGlobalTable_globalTableName' - The global table name.
--
-- 'replicationGroup', 'createGlobalTable_replicationGroup' - The Regions where the global table needs to be created.
newCreateGlobalTable ::
  -- | 'globalTableName'
  Prelude.Text ->
  CreateGlobalTable
newCreateGlobalTable :: Text -> CreateGlobalTable
newCreateGlobalTable Text
pGlobalTableName_ =
  CreateGlobalTable'
    { $sel:globalTableName:CreateGlobalTable' :: Text
globalTableName =
        Text
pGlobalTableName_,
      $sel:replicationGroup:CreateGlobalTable' :: [Replica]
replicationGroup = forall a. Monoid a => a
Prelude.mempty
    }

-- | The global table name.
createGlobalTable_globalTableName :: Lens.Lens' CreateGlobalTable Prelude.Text
createGlobalTable_globalTableName :: Lens' CreateGlobalTable Text
createGlobalTable_globalTableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGlobalTable' {Text
globalTableName :: Text
$sel:globalTableName:CreateGlobalTable' :: CreateGlobalTable -> Text
globalTableName} -> Text
globalTableName) (\s :: CreateGlobalTable
s@CreateGlobalTable' {} Text
a -> CreateGlobalTable
s {$sel:globalTableName:CreateGlobalTable' :: Text
globalTableName = Text
a} :: CreateGlobalTable)

-- | The Regions where the global table needs to be created.
createGlobalTable_replicationGroup :: Lens.Lens' CreateGlobalTable [Replica]
createGlobalTable_replicationGroup :: Lens' CreateGlobalTable [Replica]
createGlobalTable_replicationGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGlobalTable' {[Replica]
replicationGroup :: [Replica]
$sel:replicationGroup:CreateGlobalTable' :: CreateGlobalTable -> [Replica]
replicationGroup} -> [Replica]
replicationGroup) (\s :: CreateGlobalTable
s@CreateGlobalTable' {} [Replica]
a -> CreateGlobalTable
s {$sel:replicationGroup:CreateGlobalTable' :: [Replica]
replicationGroup = [Replica]
a} :: CreateGlobalTable) 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 CreateGlobalTable where
  type
    AWSResponse CreateGlobalTable =
      CreateGlobalTableResponse
  request :: (Service -> Service)
-> CreateGlobalTable -> Request CreateGlobalTable
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 CreateGlobalTable
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateGlobalTable)))
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 GlobalTableDescription -> Int -> CreateGlobalTableResponse
CreateGlobalTableResponse'
            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
"GlobalTableDescription")
            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 CreateGlobalTable where
  hashWithSalt :: Int -> CreateGlobalTable -> Int
hashWithSalt Int
_salt CreateGlobalTable' {[Replica]
Text
replicationGroup :: [Replica]
globalTableName :: Text
$sel:replicationGroup:CreateGlobalTable' :: CreateGlobalTable -> [Replica]
$sel:globalTableName:CreateGlobalTable' :: CreateGlobalTable -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
globalTableName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Replica]
replicationGroup

instance Prelude.NFData CreateGlobalTable where
  rnf :: CreateGlobalTable -> ()
rnf CreateGlobalTable' {[Replica]
Text
replicationGroup :: [Replica]
globalTableName :: Text
$sel:replicationGroup:CreateGlobalTable' :: CreateGlobalTable -> [Replica]
$sel:globalTableName:CreateGlobalTable' :: CreateGlobalTable -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
globalTableName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Replica]
replicationGroup

instance Data.ToHeaders CreateGlobalTable where
  toHeaders :: CreateGlobalTable -> 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.CreateGlobalTable" ::
                          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 CreateGlobalTable where
  toJSON :: CreateGlobalTable -> Value
toJSON CreateGlobalTable' {[Replica]
Text
replicationGroup :: [Replica]
globalTableName :: Text
$sel:replicationGroup:CreateGlobalTable' :: CreateGlobalTable -> [Replica]
$sel:globalTableName:CreateGlobalTable' :: CreateGlobalTable -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"GlobalTableName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
globalTableName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ReplicationGroup" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Replica]
replicationGroup)
          ]
      )

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

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

-- | /See:/ 'newCreateGlobalTableResponse' smart constructor.
data CreateGlobalTableResponse = CreateGlobalTableResponse'
  { -- | Contains the details of the global table.
    CreateGlobalTableResponse -> Maybe GlobalTableDescription
globalTableDescription :: Prelude.Maybe GlobalTableDescription,
    -- | The response's http status code.
    CreateGlobalTableResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateGlobalTableResponse -> CreateGlobalTableResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGlobalTableResponse -> CreateGlobalTableResponse -> Bool
$c/= :: CreateGlobalTableResponse -> CreateGlobalTableResponse -> Bool
== :: CreateGlobalTableResponse -> CreateGlobalTableResponse -> Bool
$c== :: CreateGlobalTableResponse -> CreateGlobalTableResponse -> Bool
Prelude.Eq, ReadPrec [CreateGlobalTableResponse]
ReadPrec CreateGlobalTableResponse
Int -> ReadS CreateGlobalTableResponse
ReadS [CreateGlobalTableResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGlobalTableResponse]
$creadListPrec :: ReadPrec [CreateGlobalTableResponse]
readPrec :: ReadPrec CreateGlobalTableResponse
$creadPrec :: ReadPrec CreateGlobalTableResponse
readList :: ReadS [CreateGlobalTableResponse]
$creadList :: ReadS [CreateGlobalTableResponse]
readsPrec :: Int -> ReadS CreateGlobalTableResponse
$creadsPrec :: Int -> ReadS CreateGlobalTableResponse
Prelude.Read, Int -> CreateGlobalTableResponse -> ShowS
[CreateGlobalTableResponse] -> ShowS
CreateGlobalTableResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGlobalTableResponse] -> ShowS
$cshowList :: [CreateGlobalTableResponse] -> ShowS
show :: CreateGlobalTableResponse -> String
$cshow :: CreateGlobalTableResponse -> String
showsPrec :: Int -> CreateGlobalTableResponse -> ShowS
$cshowsPrec :: Int -> CreateGlobalTableResponse -> ShowS
Prelude.Show, forall x.
Rep CreateGlobalTableResponse x -> CreateGlobalTableResponse
forall x.
CreateGlobalTableResponse -> Rep CreateGlobalTableResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateGlobalTableResponse x -> CreateGlobalTableResponse
$cfrom :: forall x.
CreateGlobalTableResponse -> Rep CreateGlobalTableResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateGlobalTableResponse' 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:
--
-- 'globalTableDescription', 'createGlobalTableResponse_globalTableDescription' - Contains the details of the global table.
--
-- 'httpStatus', 'createGlobalTableResponse_httpStatus' - The response's http status code.
newCreateGlobalTableResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateGlobalTableResponse
newCreateGlobalTableResponse :: Int -> CreateGlobalTableResponse
newCreateGlobalTableResponse Int
pHttpStatus_ =
  CreateGlobalTableResponse'
    { $sel:globalTableDescription:CreateGlobalTableResponse' :: Maybe GlobalTableDescription
globalTableDescription =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateGlobalTableResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Contains the details of the global table.
createGlobalTableResponse_globalTableDescription :: Lens.Lens' CreateGlobalTableResponse (Prelude.Maybe GlobalTableDescription)
createGlobalTableResponse_globalTableDescription :: Lens' CreateGlobalTableResponse (Maybe GlobalTableDescription)
createGlobalTableResponse_globalTableDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGlobalTableResponse' {Maybe GlobalTableDescription
globalTableDescription :: Maybe GlobalTableDescription
$sel:globalTableDescription:CreateGlobalTableResponse' :: CreateGlobalTableResponse -> Maybe GlobalTableDescription
globalTableDescription} -> Maybe GlobalTableDescription
globalTableDescription) (\s :: CreateGlobalTableResponse
s@CreateGlobalTableResponse' {} Maybe GlobalTableDescription
a -> CreateGlobalTableResponse
s {$sel:globalTableDescription:CreateGlobalTableResponse' :: Maybe GlobalTableDescription
globalTableDescription = Maybe GlobalTableDescription
a} :: CreateGlobalTableResponse)

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

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