{-# 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.ReplicaUpdate
-- 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.ReplicaUpdate 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.CreateReplicaAction
import Amazonka.DynamoDB.Types.DeleteReplicaAction
import Amazonka.DynamoDB.Types.WriteRequest
import qualified Amazonka.Prelude as Prelude

-- | Represents one of the following:
--
-- -   A new replica to be added to an existing global table.
--
-- -   New parameters for an existing replica.
--
-- -   An existing replica to be removed from an existing global table.
--
-- /See:/ 'newReplicaUpdate' smart constructor.
data ReplicaUpdate = ReplicaUpdate'
  { -- | The parameters required for creating a replica on an existing global
    -- table.
    ReplicaUpdate -> Maybe CreateReplicaAction
create :: Prelude.Maybe CreateReplicaAction,
    -- | The name of the existing replica to be removed.
    ReplicaUpdate -> Maybe DeleteReplicaAction
delete' :: Prelude.Maybe DeleteReplicaAction
  }
  deriving (ReplicaUpdate -> ReplicaUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplicaUpdate -> ReplicaUpdate -> Bool
$c/= :: ReplicaUpdate -> ReplicaUpdate -> Bool
== :: ReplicaUpdate -> ReplicaUpdate -> Bool
$c== :: ReplicaUpdate -> ReplicaUpdate -> Bool
Prelude.Eq, ReadPrec [ReplicaUpdate]
ReadPrec ReplicaUpdate
Int -> ReadS ReplicaUpdate
ReadS [ReplicaUpdate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReplicaUpdate]
$creadListPrec :: ReadPrec [ReplicaUpdate]
readPrec :: ReadPrec ReplicaUpdate
$creadPrec :: ReadPrec ReplicaUpdate
readList :: ReadS [ReplicaUpdate]
$creadList :: ReadS [ReplicaUpdate]
readsPrec :: Int -> ReadS ReplicaUpdate
$creadsPrec :: Int -> ReadS ReplicaUpdate
Prelude.Read, Int -> ReplicaUpdate -> ShowS
[ReplicaUpdate] -> ShowS
ReplicaUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplicaUpdate] -> ShowS
$cshowList :: [ReplicaUpdate] -> ShowS
show :: ReplicaUpdate -> String
$cshow :: ReplicaUpdate -> String
showsPrec :: Int -> ReplicaUpdate -> ShowS
$cshowsPrec :: Int -> ReplicaUpdate -> ShowS
Prelude.Show, forall x. Rep ReplicaUpdate x -> ReplicaUpdate
forall x. ReplicaUpdate -> Rep ReplicaUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReplicaUpdate x -> ReplicaUpdate
$cfrom :: forall x. ReplicaUpdate -> Rep ReplicaUpdate x
Prelude.Generic)

-- |
-- Create a value of 'ReplicaUpdate' 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:
--
-- 'create', 'replicaUpdate_create' - The parameters required for creating a replica on an existing global
-- table.
--
-- 'delete'', 'replicaUpdate_delete' - The name of the existing replica to be removed.
newReplicaUpdate ::
  ReplicaUpdate
newReplicaUpdate :: ReplicaUpdate
newReplicaUpdate =
  ReplicaUpdate'
    { $sel:create:ReplicaUpdate' :: Maybe CreateReplicaAction
create = forall a. Maybe a
Prelude.Nothing,
      $sel:delete':ReplicaUpdate' :: Maybe DeleteReplicaAction
delete' = forall a. Maybe a
Prelude.Nothing
    }

-- | The parameters required for creating a replica on an existing global
-- table.
replicaUpdate_create :: Lens.Lens' ReplicaUpdate (Prelude.Maybe CreateReplicaAction)
replicaUpdate_create :: Lens' ReplicaUpdate (Maybe CreateReplicaAction)
replicaUpdate_create = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicaUpdate' {Maybe CreateReplicaAction
create :: Maybe CreateReplicaAction
$sel:create:ReplicaUpdate' :: ReplicaUpdate -> Maybe CreateReplicaAction
create} -> Maybe CreateReplicaAction
create) (\s :: ReplicaUpdate
s@ReplicaUpdate' {} Maybe CreateReplicaAction
a -> ReplicaUpdate
s {$sel:create:ReplicaUpdate' :: Maybe CreateReplicaAction
create = Maybe CreateReplicaAction
a} :: ReplicaUpdate)

-- | The name of the existing replica to be removed.
replicaUpdate_delete :: Lens.Lens' ReplicaUpdate (Prelude.Maybe DeleteReplicaAction)
replicaUpdate_delete :: Lens' ReplicaUpdate (Maybe DeleteReplicaAction)
replicaUpdate_delete = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReplicaUpdate' {Maybe DeleteReplicaAction
delete' :: Maybe DeleteReplicaAction
$sel:delete':ReplicaUpdate' :: ReplicaUpdate -> Maybe DeleteReplicaAction
delete'} -> Maybe DeleteReplicaAction
delete') (\s :: ReplicaUpdate
s@ReplicaUpdate' {} Maybe DeleteReplicaAction
a -> ReplicaUpdate
s {$sel:delete':ReplicaUpdate' :: Maybe DeleteReplicaAction
delete' = Maybe DeleteReplicaAction
a} :: ReplicaUpdate)

instance Prelude.Hashable ReplicaUpdate where
  hashWithSalt :: Int -> ReplicaUpdate -> Int
hashWithSalt Int
_salt ReplicaUpdate' {Maybe DeleteReplicaAction
Maybe CreateReplicaAction
delete' :: Maybe DeleteReplicaAction
create :: Maybe CreateReplicaAction
$sel:delete':ReplicaUpdate' :: ReplicaUpdate -> Maybe DeleteReplicaAction
$sel:create:ReplicaUpdate' :: ReplicaUpdate -> Maybe CreateReplicaAction
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CreateReplicaAction
create
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeleteReplicaAction
delete'

instance Prelude.NFData ReplicaUpdate where
  rnf :: ReplicaUpdate -> ()
rnf ReplicaUpdate' {Maybe DeleteReplicaAction
Maybe CreateReplicaAction
delete' :: Maybe DeleteReplicaAction
create :: Maybe CreateReplicaAction
$sel:delete':ReplicaUpdate' :: ReplicaUpdate -> Maybe DeleteReplicaAction
$sel:create:ReplicaUpdate' :: ReplicaUpdate -> Maybe CreateReplicaAction
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CreateReplicaAction
create
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeleteReplicaAction
delete'

instance Data.ToJSON ReplicaUpdate where
  toJSON :: ReplicaUpdate -> Value
toJSON ReplicaUpdate' {Maybe DeleteReplicaAction
Maybe CreateReplicaAction
delete' :: Maybe DeleteReplicaAction
create :: Maybe CreateReplicaAction
$sel:delete':ReplicaUpdate' :: ReplicaUpdate -> Maybe DeleteReplicaAction
$sel:create:ReplicaUpdate' :: ReplicaUpdate -> Maybe CreateReplicaAction
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Create" 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 CreateReplicaAction
create,
            (Key
"Delete" 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 DeleteReplicaAction
delete'
          ]
      )