{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# OPTIONS_GHC -Wall -Werror #-}

-- |
-- Module      : Amazonka.DynamoDB.WriteRequest
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
module Amazonka.DynamoDB.Types.WriteRequest where

import Amazonka.DynamoDB.Types.AttributeValue (AttributeValue)
import Amazonka.Prelude
import Data.Aeson
  ( FromJSON (..),
    ToJSON (..),
    object,
    pairs,
    withObject,
    (.:),
    (.=),
  )
import Data.Map (Map)

#if MIN_VERSION_aeson(2,0,0)
import qualified  Data.Aeson.KeyMap as KeyMap
#else
import qualified  Data.HashMap.Strict as KeyMap
#endif

-- | Represents an operation to perform - either @DeleteItem@ or @PutItem@.
-- You can only request one of these operations, not both, in a single
-- @WriteRequest@. If you do need to perform both of these operations, you
-- need to provide two separate @WriteRequest@ objects.
--
-- For more information, see
-- <https://docs.aws.amazon.com/amazondynamodb/latest/APIReference/API_WriteRequest.html WriteRequest>
-- in the /Amazon DynamoDB Developer Guide/.
data WriteRequest
  = -- | A request to perform a @DeleteItem@ operation.
    --
    -- A map of attribute name to attribute values, representing the primary
    -- key of the item to delete. All of the table\'s primary key attributes
    -- must be specified, and their data types must match those of the table\'s
    -- key schema.
    DeleteRequest (Map Text AttributeValue)
  | -- | A request to perform a @PutItem@ operation.
    --
    -- A map of attribute name to attribute values, representing the primary
    -- key of an item to be processed by @PutItem@. All of the table\'s primary
    -- key attributes must be specified, and their data types must match those
    -- of the table\'s key schema. If any attributes are present in the item
    -- that are part of an index key schema for the table, their types must
    -- match the index key schema.
    PutRequest (Map Text AttributeValue)
  deriving stock (WriteRequest -> WriteRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteRequest -> WriteRequest -> Bool
$c/= :: WriteRequest -> WriteRequest -> Bool
== :: WriteRequest -> WriteRequest -> Bool
$c== :: WriteRequest -> WriteRequest -> Bool
Eq, ReadPrec [WriteRequest]
ReadPrec WriteRequest
Int -> ReadS WriteRequest
ReadS [WriteRequest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WriteRequest]
$creadListPrec :: ReadPrec [WriteRequest]
readPrec :: ReadPrec WriteRequest
$creadPrec :: ReadPrec WriteRequest
readList :: ReadS [WriteRequest]
$creadList :: ReadS [WriteRequest]
readsPrec :: Int -> ReadS WriteRequest
$creadsPrec :: Int -> ReadS WriteRequest
Read, Int -> WriteRequest -> ShowS
[WriteRequest] -> ShowS
WriteRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriteRequest] -> ShowS
$cshowList :: [WriteRequest] -> ShowS
show :: WriteRequest -> String
$cshow :: WriteRequest -> String
showsPrec :: Int -> WriteRequest -> ShowS
$cshowsPrec :: Int -> WriteRequest -> ShowS
Show, forall x. Rep WriteRequest x -> WriteRequest
forall x. WriteRequest -> Rep WriteRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WriteRequest x -> WriteRequest
$cfrom :: forall x. WriteRequest -> Rep WriteRequest x
Generic)
  deriving anyclass (Eq WriteRequest
Int -> WriteRequest -> Int
WriteRequest -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: WriteRequest -> Int
$chash :: WriteRequest -> Int
hashWithSalt :: Int -> WriteRequest -> Int
$chashWithSalt :: Int -> WriteRequest -> Int
Hashable, WriteRequest -> ()
forall a. (a -> ()) -> NFData a
rnf :: WriteRequest -> ()
$crnf :: WriteRequest -> ()
NFData)

instance FromJSON WriteRequest where
  parseJSON :: Value -> Parser WriteRequest
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"WriteRequest" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    case forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Object
o of
      [(Key
"DeleteRequest", Value
v)] -> Map Text AttributeValue -> WriteRequest
DeleteRequest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map Text AttributeValue)
key Value
v
      [(Key
"PutRequest", Value
v)] -> Map Text AttributeValue -> WriteRequest
PutRequest forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map Text AttributeValue)
item Value
v
      [] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No keys"
      [(Key, Value)]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Multiple or unrecognized keys: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall v. KeyMap v -> [Key]
KeyMap.keys Object
o)
    where
      item :: Value -> Parser (Map Text AttributeValue)
item = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Item" (forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Item")
      key :: Value -> Parser (Map Text AttributeValue)
key = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Key" (forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"Key")

instance ToJSON WriteRequest where
  toJSON :: WriteRequest -> Value
toJSON =
    [(Key, Value)] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      DeleteRequest Map Text AttributeValue
key -> Key
"DeleteRequest" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object [Key
"Key" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text AttributeValue
key]
      PutRequest Map Text AttributeValue
item -> Key
"PutRequest" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(Key, Value)] -> Value
object [Key
"Item" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text AttributeValue
item]

  toEncoding :: WriteRequest -> Encoding
toEncoding =
    Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
      DeleteRequest Map Text AttributeValue
key -> Key
"DeleteRequest" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ([(Key, Value)] -> Value
object [Key
"Key" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text AttributeValue
key])
      PutRequest Map Text AttributeValue
item -> Key
"PutRequest" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ([(Key, Value)] -> Value
object [Key
"Item" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Map Text AttributeValue
item])