{-# 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.TransactWriteItem
-- 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.TransactWriteItem 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.ConditionCheck
import Amazonka.DynamoDB.Types.Delete
import Amazonka.DynamoDB.Types.Put
import Amazonka.DynamoDB.Types.Update
import Amazonka.DynamoDB.Types.WriteRequest
import qualified Amazonka.Prelude as Prelude

-- | A list of requests that can perform update, put, delete, or check
-- operations on multiple items in one or more tables atomically.
--
-- /See:/ 'newTransactWriteItem' smart constructor.
data TransactWriteItem = TransactWriteItem'
  { -- | A request to perform a check item operation.
    TransactWriteItem -> Maybe ConditionCheck
conditionCheck :: Prelude.Maybe ConditionCheck,
    -- | A request to perform a @DeleteItem@ operation.
    TransactWriteItem -> Maybe Delete
delete' :: Prelude.Maybe Delete,
    -- | A request to perform a @PutItem@ operation.
    TransactWriteItem -> Maybe Put
put :: Prelude.Maybe Put,
    -- | A request to perform an @UpdateItem@ operation.
    TransactWriteItem -> Maybe Update
update :: Prelude.Maybe Update
  }
  deriving (TransactWriteItem -> TransactWriteItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactWriteItem -> TransactWriteItem -> Bool
$c/= :: TransactWriteItem -> TransactWriteItem -> Bool
== :: TransactWriteItem -> TransactWriteItem -> Bool
$c== :: TransactWriteItem -> TransactWriteItem -> Bool
Prelude.Eq, ReadPrec [TransactWriteItem]
ReadPrec TransactWriteItem
Int -> ReadS TransactWriteItem
ReadS [TransactWriteItem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TransactWriteItem]
$creadListPrec :: ReadPrec [TransactWriteItem]
readPrec :: ReadPrec TransactWriteItem
$creadPrec :: ReadPrec TransactWriteItem
readList :: ReadS [TransactWriteItem]
$creadList :: ReadS [TransactWriteItem]
readsPrec :: Int -> ReadS TransactWriteItem
$creadsPrec :: Int -> ReadS TransactWriteItem
Prelude.Read, Int -> TransactWriteItem -> ShowS
[TransactWriteItem] -> ShowS
TransactWriteItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransactWriteItem] -> ShowS
$cshowList :: [TransactWriteItem] -> ShowS
show :: TransactWriteItem -> String
$cshow :: TransactWriteItem -> String
showsPrec :: Int -> TransactWriteItem -> ShowS
$cshowsPrec :: Int -> TransactWriteItem -> ShowS
Prelude.Show, forall x. Rep TransactWriteItem x -> TransactWriteItem
forall x. TransactWriteItem -> Rep TransactWriteItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TransactWriteItem x -> TransactWriteItem
$cfrom :: forall x. TransactWriteItem -> Rep TransactWriteItem x
Prelude.Generic)

-- |
-- Create a value of 'TransactWriteItem' 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:
--
-- 'conditionCheck', 'transactWriteItem_conditionCheck' - A request to perform a check item operation.
--
-- 'delete'', 'transactWriteItem_delete' - A request to perform a @DeleteItem@ operation.
--
-- 'put', 'transactWriteItem_put' - A request to perform a @PutItem@ operation.
--
-- 'update', 'transactWriteItem_update' - A request to perform an @UpdateItem@ operation.
newTransactWriteItem ::
  TransactWriteItem
newTransactWriteItem :: TransactWriteItem
newTransactWriteItem =
  TransactWriteItem'
    { $sel:conditionCheck:TransactWriteItem' :: Maybe ConditionCheck
conditionCheck =
        forall a. Maybe a
Prelude.Nothing,
      $sel:delete':TransactWriteItem' :: Maybe Delete
delete' = forall a. Maybe a
Prelude.Nothing,
      $sel:put:TransactWriteItem' :: Maybe Put
put = forall a. Maybe a
Prelude.Nothing,
      $sel:update:TransactWriteItem' :: Maybe Update
update = forall a. Maybe a
Prelude.Nothing
    }

-- | A request to perform a check item operation.
transactWriteItem_conditionCheck :: Lens.Lens' TransactWriteItem (Prelude.Maybe ConditionCheck)
transactWriteItem_conditionCheck :: Lens' TransactWriteItem (Maybe ConditionCheck)
transactWriteItem_conditionCheck = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransactWriteItem' {Maybe ConditionCheck
conditionCheck :: Maybe ConditionCheck
$sel:conditionCheck:TransactWriteItem' :: TransactWriteItem -> Maybe ConditionCheck
conditionCheck} -> Maybe ConditionCheck
conditionCheck) (\s :: TransactWriteItem
s@TransactWriteItem' {} Maybe ConditionCheck
a -> TransactWriteItem
s {$sel:conditionCheck:TransactWriteItem' :: Maybe ConditionCheck
conditionCheck = Maybe ConditionCheck
a} :: TransactWriteItem)

-- | A request to perform a @DeleteItem@ operation.
transactWriteItem_delete :: Lens.Lens' TransactWriteItem (Prelude.Maybe Delete)
transactWriteItem_delete :: Lens' TransactWriteItem (Maybe Delete)
transactWriteItem_delete = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransactWriteItem' {Maybe Delete
delete' :: Maybe Delete
$sel:delete':TransactWriteItem' :: TransactWriteItem -> Maybe Delete
delete'} -> Maybe Delete
delete') (\s :: TransactWriteItem
s@TransactWriteItem' {} Maybe Delete
a -> TransactWriteItem
s {$sel:delete':TransactWriteItem' :: Maybe Delete
delete' = Maybe Delete
a} :: TransactWriteItem)

-- | A request to perform a @PutItem@ operation.
transactWriteItem_put :: Lens.Lens' TransactWriteItem (Prelude.Maybe Put)
transactWriteItem_put :: Lens' TransactWriteItem (Maybe Put)
transactWriteItem_put = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransactWriteItem' {Maybe Put
put :: Maybe Put
$sel:put:TransactWriteItem' :: TransactWriteItem -> Maybe Put
put} -> Maybe Put
put) (\s :: TransactWriteItem
s@TransactWriteItem' {} Maybe Put
a -> TransactWriteItem
s {$sel:put:TransactWriteItem' :: Maybe Put
put = Maybe Put
a} :: TransactWriteItem)

-- | A request to perform an @UpdateItem@ operation.
transactWriteItem_update :: Lens.Lens' TransactWriteItem (Prelude.Maybe Update)
transactWriteItem_update :: Lens' TransactWriteItem (Maybe Update)
transactWriteItem_update = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TransactWriteItem' {Maybe Update
update :: Maybe Update
$sel:update:TransactWriteItem' :: TransactWriteItem -> Maybe Update
update} -> Maybe Update
update) (\s :: TransactWriteItem
s@TransactWriteItem' {} Maybe Update
a -> TransactWriteItem
s {$sel:update:TransactWriteItem' :: Maybe Update
update = Maybe Update
a} :: TransactWriteItem)

instance Prelude.Hashable TransactWriteItem where
  hashWithSalt :: Int -> TransactWriteItem -> Int
hashWithSalt Int
_salt TransactWriteItem' {Maybe Update
Maybe Put
Maybe Delete
Maybe ConditionCheck
update :: Maybe Update
put :: Maybe Put
delete' :: Maybe Delete
conditionCheck :: Maybe ConditionCheck
$sel:update:TransactWriteItem' :: TransactWriteItem -> Maybe Update
$sel:put:TransactWriteItem' :: TransactWriteItem -> Maybe Put
$sel:delete':TransactWriteItem' :: TransactWriteItem -> Maybe Delete
$sel:conditionCheck:TransactWriteItem' :: TransactWriteItem -> Maybe ConditionCheck
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConditionCheck
conditionCheck
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Delete
delete'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Put
put
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Update
update

instance Prelude.NFData TransactWriteItem where
  rnf :: TransactWriteItem -> ()
rnf TransactWriteItem' {Maybe Update
Maybe Put
Maybe Delete
Maybe ConditionCheck
update :: Maybe Update
put :: Maybe Put
delete' :: Maybe Delete
conditionCheck :: Maybe ConditionCheck
$sel:update:TransactWriteItem' :: TransactWriteItem -> Maybe Update
$sel:put:TransactWriteItem' :: TransactWriteItem -> Maybe Put
$sel:delete':TransactWriteItem' :: TransactWriteItem -> Maybe Delete
$sel:conditionCheck:TransactWriteItem' :: TransactWriteItem -> Maybe ConditionCheck
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ConditionCheck
conditionCheck
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Delete
delete'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Put
put
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Update
update

instance Data.ToJSON TransactWriteItem where
  toJSON :: TransactWriteItem -> Value
toJSON TransactWriteItem' {Maybe Update
Maybe Put
Maybe Delete
Maybe ConditionCheck
update :: Maybe Update
put :: Maybe Put
delete' :: Maybe Delete
conditionCheck :: Maybe ConditionCheck
$sel:update:TransactWriteItem' :: TransactWriteItem -> Maybe Update
$sel:put:TransactWriteItem' :: TransactWriteItem -> Maybe Put
$sel:delete':TransactWriteItem' :: TransactWriteItem -> Maybe Delete
$sel:conditionCheck:TransactWriteItem' :: TransactWriteItem -> Maybe ConditionCheck
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ConditionCheck" 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 ConditionCheck
conditionCheck,
            (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 Delete
delete',
            (Key
"Put" 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 Put
put,
            (Key
"Update" 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 Update
update
          ]
      )