{-# 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.GlobalTableDescription
-- 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.GlobalTableDescription 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.AttributeValue
import Amazonka.DynamoDB.Types.GlobalTableStatus
import Amazonka.DynamoDB.Types.ReplicaDescription
import Amazonka.DynamoDB.Types.WriteRequest
import qualified Amazonka.Prelude as Prelude

-- | Contains details about the global table.
--
-- /See:/ 'newGlobalTableDescription' smart constructor.
data GlobalTableDescription = GlobalTableDescription'
  { -- | The creation time of the global table.
    GlobalTableDescription -> Maybe POSIX
creationDateTime :: Prelude.Maybe Data.POSIX,
    -- | The unique identifier of the global table.
    GlobalTableDescription -> Maybe Text
globalTableArn :: Prelude.Maybe Prelude.Text,
    -- | The global table name.
    GlobalTableDescription -> Maybe Text
globalTableName :: Prelude.Maybe Prelude.Text,
    -- | The current state of the global table:
    --
    -- -   @CREATING@ - The global table is being created.
    --
    -- -   @UPDATING@ - The global table is being updated.
    --
    -- -   @DELETING@ - The global table is being deleted.
    --
    -- -   @ACTIVE@ - The global table is ready for use.
    GlobalTableDescription -> Maybe GlobalTableStatus
globalTableStatus :: Prelude.Maybe GlobalTableStatus,
    -- | The Regions where the global table has replicas.
    GlobalTableDescription -> Maybe [ReplicaDescription]
replicationGroup :: Prelude.Maybe [ReplicaDescription]
  }
  deriving (GlobalTableDescription -> GlobalTableDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalTableDescription -> GlobalTableDescription -> Bool
$c/= :: GlobalTableDescription -> GlobalTableDescription -> Bool
== :: GlobalTableDescription -> GlobalTableDescription -> Bool
$c== :: GlobalTableDescription -> GlobalTableDescription -> Bool
Prelude.Eq, ReadPrec [GlobalTableDescription]
ReadPrec GlobalTableDescription
Int -> ReadS GlobalTableDescription
ReadS [GlobalTableDescription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GlobalTableDescription]
$creadListPrec :: ReadPrec [GlobalTableDescription]
readPrec :: ReadPrec GlobalTableDescription
$creadPrec :: ReadPrec GlobalTableDescription
readList :: ReadS [GlobalTableDescription]
$creadList :: ReadS [GlobalTableDescription]
readsPrec :: Int -> ReadS GlobalTableDescription
$creadsPrec :: Int -> ReadS GlobalTableDescription
Prelude.Read, Int -> GlobalTableDescription -> ShowS
[GlobalTableDescription] -> ShowS
GlobalTableDescription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobalTableDescription] -> ShowS
$cshowList :: [GlobalTableDescription] -> ShowS
show :: GlobalTableDescription -> String
$cshow :: GlobalTableDescription -> String
showsPrec :: Int -> GlobalTableDescription -> ShowS
$cshowsPrec :: Int -> GlobalTableDescription -> ShowS
Prelude.Show, forall x. Rep GlobalTableDescription x -> GlobalTableDescription
forall x. GlobalTableDescription -> Rep GlobalTableDescription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlobalTableDescription x -> GlobalTableDescription
$cfrom :: forall x. GlobalTableDescription -> Rep GlobalTableDescription x
Prelude.Generic)

-- |
-- Create a value of 'GlobalTableDescription' 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:
--
-- 'creationDateTime', 'globalTableDescription_creationDateTime' - The creation time of the global table.
--
-- 'globalTableArn', 'globalTableDescription_globalTableArn' - The unique identifier of the global table.
--
-- 'globalTableName', 'globalTableDescription_globalTableName' - The global table name.
--
-- 'globalTableStatus', 'globalTableDescription_globalTableStatus' - The current state of the global table:
--
-- -   @CREATING@ - The global table is being created.
--
-- -   @UPDATING@ - The global table is being updated.
--
-- -   @DELETING@ - The global table is being deleted.
--
-- -   @ACTIVE@ - The global table is ready for use.
--
-- 'replicationGroup', 'globalTableDescription_replicationGroup' - The Regions where the global table has replicas.
newGlobalTableDescription ::
  GlobalTableDescription
newGlobalTableDescription :: GlobalTableDescription
newGlobalTableDescription =
  GlobalTableDescription'
    { $sel:creationDateTime:GlobalTableDescription' :: Maybe POSIX
creationDateTime =
        forall a. Maybe a
Prelude.Nothing,
      $sel:globalTableArn:GlobalTableDescription' :: Maybe Text
globalTableArn = forall a. Maybe a
Prelude.Nothing,
      $sel:globalTableName:GlobalTableDescription' :: Maybe Text
globalTableName = forall a. Maybe a
Prelude.Nothing,
      $sel:globalTableStatus:GlobalTableDescription' :: Maybe GlobalTableStatus
globalTableStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:replicationGroup:GlobalTableDescription' :: Maybe [ReplicaDescription]
replicationGroup = forall a. Maybe a
Prelude.Nothing
    }

-- | The creation time of the global table.
globalTableDescription_creationDateTime :: Lens.Lens' GlobalTableDescription (Prelude.Maybe Prelude.UTCTime)
globalTableDescription_creationDateTime :: Lens' GlobalTableDescription (Maybe UTCTime)
globalTableDescription_creationDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GlobalTableDescription' {Maybe POSIX
creationDateTime :: Maybe POSIX
$sel:creationDateTime:GlobalTableDescription' :: GlobalTableDescription -> Maybe POSIX
creationDateTime} -> Maybe POSIX
creationDateTime) (\s :: GlobalTableDescription
s@GlobalTableDescription' {} Maybe POSIX
a -> GlobalTableDescription
s {$sel:creationDateTime:GlobalTableDescription' :: Maybe POSIX
creationDateTime = Maybe POSIX
a} :: GlobalTableDescription) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The unique identifier of the global table.
globalTableDescription_globalTableArn :: Lens.Lens' GlobalTableDescription (Prelude.Maybe Prelude.Text)
globalTableDescription_globalTableArn :: Lens' GlobalTableDescription (Maybe Text)
globalTableDescription_globalTableArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GlobalTableDescription' {Maybe Text
globalTableArn :: Maybe Text
$sel:globalTableArn:GlobalTableDescription' :: GlobalTableDescription -> Maybe Text
globalTableArn} -> Maybe Text
globalTableArn) (\s :: GlobalTableDescription
s@GlobalTableDescription' {} Maybe Text
a -> GlobalTableDescription
s {$sel:globalTableArn:GlobalTableDescription' :: Maybe Text
globalTableArn = Maybe Text
a} :: GlobalTableDescription)

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

-- | The current state of the global table:
--
-- -   @CREATING@ - The global table is being created.
--
-- -   @UPDATING@ - The global table is being updated.
--
-- -   @DELETING@ - The global table is being deleted.
--
-- -   @ACTIVE@ - The global table is ready for use.
globalTableDescription_globalTableStatus :: Lens.Lens' GlobalTableDescription (Prelude.Maybe GlobalTableStatus)
globalTableDescription_globalTableStatus :: Lens' GlobalTableDescription (Maybe GlobalTableStatus)
globalTableDescription_globalTableStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GlobalTableDescription' {Maybe GlobalTableStatus
globalTableStatus :: Maybe GlobalTableStatus
$sel:globalTableStatus:GlobalTableDescription' :: GlobalTableDescription -> Maybe GlobalTableStatus
globalTableStatus} -> Maybe GlobalTableStatus
globalTableStatus) (\s :: GlobalTableDescription
s@GlobalTableDescription' {} Maybe GlobalTableStatus
a -> GlobalTableDescription
s {$sel:globalTableStatus:GlobalTableDescription' :: Maybe GlobalTableStatus
globalTableStatus = Maybe GlobalTableStatus
a} :: GlobalTableDescription)

-- | The Regions where the global table has replicas.
globalTableDescription_replicationGroup :: Lens.Lens' GlobalTableDescription (Prelude.Maybe [ReplicaDescription])
globalTableDescription_replicationGroup :: Lens' GlobalTableDescription (Maybe [ReplicaDescription])
globalTableDescription_replicationGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GlobalTableDescription' {Maybe [ReplicaDescription]
replicationGroup :: Maybe [ReplicaDescription]
$sel:replicationGroup:GlobalTableDescription' :: GlobalTableDescription -> Maybe [ReplicaDescription]
replicationGroup} -> Maybe [ReplicaDescription]
replicationGroup) (\s :: GlobalTableDescription
s@GlobalTableDescription' {} Maybe [ReplicaDescription]
a -> GlobalTableDescription
s {$sel:replicationGroup:GlobalTableDescription' :: Maybe [ReplicaDescription]
replicationGroup = Maybe [ReplicaDescription]
a} :: GlobalTableDescription) 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

instance Data.FromJSON GlobalTableDescription where
  parseJSON :: Value -> Parser GlobalTableDescription
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"GlobalTableDescription"
      ( \Object
x ->
          Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe GlobalTableStatus
-> Maybe [ReplicaDescription]
-> GlobalTableDescription
GlobalTableDescription'
            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
"CreationDateTime")
            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
"GlobalTableArn")
            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
"GlobalTableName")
            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
"GlobalTableStatus")
            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
"ReplicationGroup"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable GlobalTableDescription where
  hashWithSalt :: Int -> GlobalTableDescription -> Int
hashWithSalt Int
_salt GlobalTableDescription' {Maybe [ReplicaDescription]
Maybe Text
Maybe POSIX
Maybe GlobalTableStatus
replicationGroup :: Maybe [ReplicaDescription]
globalTableStatus :: Maybe GlobalTableStatus
globalTableName :: Maybe Text
globalTableArn :: Maybe Text
creationDateTime :: Maybe POSIX
$sel:replicationGroup:GlobalTableDescription' :: GlobalTableDescription -> Maybe [ReplicaDescription]
$sel:globalTableStatus:GlobalTableDescription' :: GlobalTableDescription -> Maybe GlobalTableStatus
$sel:globalTableName:GlobalTableDescription' :: GlobalTableDescription -> Maybe Text
$sel:globalTableArn:GlobalTableDescription' :: GlobalTableDescription -> Maybe Text
$sel:creationDateTime:GlobalTableDescription' :: GlobalTableDescription -> Maybe POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
creationDateTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
globalTableArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
globalTableName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GlobalTableStatus
globalTableStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ReplicaDescription]
replicationGroup

instance Prelude.NFData GlobalTableDescription where
  rnf :: GlobalTableDescription -> ()
rnf GlobalTableDescription' {Maybe [ReplicaDescription]
Maybe Text
Maybe POSIX
Maybe GlobalTableStatus
replicationGroup :: Maybe [ReplicaDescription]
globalTableStatus :: Maybe GlobalTableStatus
globalTableName :: Maybe Text
globalTableArn :: Maybe Text
creationDateTime :: Maybe POSIX
$sel:replicationGroup:GlobalTableDescription' :: GlobalTableDescription -> Maybe [ReplicaDescription]
$sel:globalTableStatus:GlobalTableDescription' :: GlobalTableDescription -> Maybe GlobalTableStatus
$sel:globalTableName:GlobalTableDescription' :: GlobalTableDescription -> Maybe Text
$sel:globalTableArn:GlobalTableDescription' :: GlobalTableDescription -> Maybe Text
$sel:creationDateTime:GlobalTableDescription' :: GlobalTableDescription -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
globalTableArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
globalTableName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GlobalTableStatus
globalTableStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ReplicaDescription]
replicationGroup