{-# LANGUAGE DeriveDataTypeable        #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TypeFamilies              #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Aws.DynamoDb.Commands.UpdateItem
-- Copyright   :  Soostone Inc
-- License     :  BSD3
--
-- Maintainer  :  Ozgun Ataman <ozgun.ataman@soostone.com>
-- Stability   :  experimental
--
--
----------------------------------------------------------------------------

module Aws.DynamoDb.Commands.UpdateItem
    ( UpdateItem(..)
    , updateItem
    , AttributeUpdate(..)
    , au
    , UpdateAction(..)
    , UpdateItemResponse(..)
    ) where

-------------------------------------------------------------------------------
import           Control.Applicative
import           Data.Aeson
import qualified Data.Aeson.Key      as AK
import           Data.Default
import qualified Data.Text           as T
import           Prelude
-------------------------------------------------------------------------------
import           Aws.Core
import           Aws.DynamoDb.Core
-------------------------------------------------------------------------------


-- | An @UpdateItem@ request.
data UpdateItem = UpdateItem {
      UpdateItem -> Text
uiTable   :: T.Text
    , UpdateItem -> PrimaryKey
uiKey     :: PrimaryKey
    , UpdateItem -> [AttributeUpdate]
uiUpdates :: [AttributeUpdate]
    , UpdateItem -> Conditions
uiExpect  :: Conditions
    -- ^ Conditional update - see DynamoDb documentation
    , UpdateItem -> UpdateReturn
uiReturn  :: UpdateReturn
    , UpdateItem -> ReturnConsumption
uiRetCons :: ReturnConsumption
    , UpdateItem -> ReturnItemCollectionMetrics
uiRetMet  :: ReturnItemCollectionMetrics
    } deriving (UpdateItem -> UpdateItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateItem -> UpdateItem -> Bool
$c/= :: UpdateItem -> UpdateItem -> Bool
== :: UpdateItem -> UpdateItem -> Bool
$c== :: UpdateItem -> UpdateItem -> Bool
Eq,Int -> UpdateItem -> ShowS
[UpdateItem] -> ShowS
UpdateItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateItem] -> ShowS
$cshowList :: [UpdateItem] -> ShowS
show :: UpdateItem -> String
$cshow :: UpdateItem -> String
showsPrec :: Int -> UpdateItem -> ShowS
$cshowsPrec :: Int -> UpdateItem -> ShowS
Show,ReadPrec [UpdateItem]
ReadPrec UpdateItem
Int -> ReadS UpdateItem
ReadS [UpdateItem]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateItem]
$creadListPrec :: ReadPrec [UpdateItem]
readPrec :: ReadPrec UpdateItem
$creadPrec :: ReadPrec UpdateItem
readList :: ReadS [UpdateItem]
$creadList :: ReadS [UpdateItem]
readsPrec :: Int -> ReadS UpdateItem
$creadsPrec :: Int -> ReadS UpdateItem
Read,Eq UpdateItem
UpdateItem -> UpdateItem -> Bool
UpdateItem -> UpdateItem -> Ordering
UpdateItem -> UpdateItem -> UpdateItem
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UpdateItem -> UpdateItem -> UpdateItem
$cmin :: UpdateItem -> UpdateItem -> UpdateItem
max :: UpdateItem -> UpdateItem -> UpdateItem
$cmax :: UpdateItem -> UpdateItem -> UpdateItem
>= :: UpdateItem -> UpdateItem -> Bool
$c>= :: UpdateItem -> UpdateItem -> Bool
> :: UpdateItem -> UpdateItem -> Bool
$c> :: UpdateItem -> UpdateItem -> Bool
<= :: UpdateItem -> UpdateItem -> Bool
$c<= :: UpdateItem -> UpdateItem -> Bool
< :: UpdateItem -> UpdateItem -> Bool
$c< :: UpdateItem -> UpdateItem -> Bool
compare :: UpdateItem -> UpdateItem -> Ordering
$ccompare :: UpdateItem -> UpdateItem -> Ordering
Ord)


-------------------------------------------------------------------------------
-- | Construct a minimal 'UpdateItem' request.
updateItem
    :: T.Text                   -- ^ Table name
    -> PrimaryKey               -- ^ Primary key for item
    -> [AttributeUpdate]        -- ^ Updates for this item
    -> UpdateItem
updateItem :: Text -> PrimaryKey -> [AttributeUpdate] -> UpdateItem
updateItem Text
tn PrimaryKey
key [AttributeUpdate]
ups = Text
-> PrimaryKey
-> [AttributeUpdate]
-> Conditions
-> UpdateReturn
-> ReturnConsumption
-> ReturnItemCollectionMetrics
-> UpdateItem
UpdateItem Text
tn PrimaryKey
key [AttributeUpdate]
ups forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def


-- | A helper to avoid overlapping instances for 'ToJSON'.
newtype AttributeUpdates = AttributeUpdates {
    AttributeUpdates -> [AttributeUpdate]
getAttributeUpdates :: [AttributeUpdate]
    }


data AttributeUpdate = AttributeUpdate {
      AttributeUpdate -> Attribute
auAttr   :: Attribute
    -- ^ Attribute key-value
    , AttributeUpdate -> UpdateAction
auAction :: UpdateAction
    -- ^ Type of update operation.
    } deriving (AttributeUpdate -> AttributeUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeUpdate -> AttributeUpdate -> Bool
$c/= :: AttributeUpdate -> AttributeUpdate -> Bool
== :: AttributeUpdate -> AttributeUpdate -> Bool
$c== :: AttributeUpdate -> AttributeUpdate -> Bool
Eq,Int -> AttributeUpdate -> ShowS
[AttributeUpdate] -> ShowS
AttributeUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeUpdate] -> ShowS
$cshowList :: [AttributeUpdate] -> ShowS
show :: AttributeUpdate -> String
$cshow :: AttributeUpdate -> String
showsPrec :: Int -> AttributeUpdate -> ShowS
$cshowsPrec :: Int -> AttributeUpdate -> ShowS
Show,ReadPrec [AttributeUpdate]
ReadPrec AttributeUpdate
Int -> ReadS AttributeUpdate
ReadS [AttributeUpdate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttributeUpdate]
$creadListPrec :: ReadPrec [AttributeUpdate]
readPrec :: ReadPrec AttributeUpdate
$creadPrec :: ReadPrec AttributeUpdate
readList :: ReadS [AttributeUpdate]
$creadList :: ReadS [AttributeUpdate]
readsPrec :: Int -> ReadS AttributeUpdate
$creadsPrec :: Int -> ReadS AttributeUpdate
Read,Eq AttributeUpdate
AttributeUpdate -> AttributeUpdate -> Bool
AttributeUpdate -> AttributeUpdate -> Ordering
AttributeUpdate -> AttributeUpdate -> AttributeUpdate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AttributeUpdate -> AttributeUpdate -> AttributeUpdate
$cmin :: AttributeUpdate -> AttributeUpdate -> AttributeUpdate
max :: AttributeUpdate -> AttributeUpdate -> AttributeUpdate
$cmax :: AttributeUpdate -> AttributeUpdate -> AttributeUpdate
>= :: AttributeUpdate -> AttributeUpdate -> Bool
$c>= :: AttributeUpdate -> AttributeUpdate -> Bool
> :: AttributeUpdate -> AttributeUpdate -> Bool
$c> :: AttributeUpdate -> AttributeUpdate -> Bool
<= :: AttributeUpdate -> AttributeUpdate -> Bool
$c<= :: AttributeUpdate -> AttributeUpdate -> Bool
< :: AttributeUpdate -> AttributeUpdate -> Bool
$c< :: AttributeUpdate -> AttributeUpdate -> Bool
compare :: AttributeUpdate -> AttributeUpdate -> Ordering
$ccompare :: AttributeUpdate -> AttributeUpdate -> Ordering
Ord)


instance DynSize AttributeUpdate where
    dynSize :: AttributeUpdate -> Int
dynSize (AttributeUpdate Attribute
a UpdateAction
_) = forall a. DynSize a => a -> Int
dynSize Attribute
a

-------------------------------------------------------------------------------
-- | Shorthand for the 'AttributeUpdate' constructor. Defaults to PUT
-- for the update action.
au :: Attribute -> AttributeUpdate
au :: Attribute -> AttributeUpdate
au Attribute
a = Attribute -> UpdateAction -> AttributeUpdate
AttributeUpdate Attribute
a forall a. Default a => a
def


instance ToJSON AttributeUpdates where
    toJSON :: AttributeUpdates -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {kv}. KeyValue kv => AttributeUpdate -> kv
mk forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeUpdates -> [AttributeUpdate]
getAttributeUpdates
        where
          mk :: AttributeUpdate -> kv
mk AttributeUpdate { auAction :: AttributeUpdate -> UpdateAction
auAction = UpdateAction
UDelete, auAttr :: AttributeUpdate -> Attribute
auAttr = Attribute
auAttr } =
            (Text -> Key
AK.fromText (Attribute -> Text
attrName Attribute
auAttr)) forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
            [Key
"Action" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UpdateAction
UDelete]
          mk AttributeUpdate { Attribute
UpdateAction
auAction :: UpdateAction
auAttr :: Attribute
auAction :: AttributeUpdate -> UpdateAction
auAttr :: AttributeUpdate -> Attribute
.. } = Text -> Key
AK.fromText (Attribute -> Text
attrName Attribute
auAttr) forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object
            [Key
"Value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Attribute -> DValue
attrVal Attribute
auAttr), Key
"Action" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UpdateAction
auAction]


-------------------------------------------------------------------------------
-- | Type of attribute update to perform.
--
-- See AWS docs at:
--
-- @http:\/\/docs.aws.amazon.com\/amazondynamodb\/latest\/APIReference\/API_UpdateItem.html@
data UpdateAction
    = UPut                      -- ^ Simpley write, overwriting any previous value
    | UAdd                      -- ^ Numerical add or add to set.
    | UDelete                   -- ^ Empty value: remove; Set value: Subtract from set.
    deriving (UpdateAction -> UpdateAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAction -> UpdateAction -> Bool
$c/= :: UpdateAction -> UpdateAction -> Bool
== :: UpdateAction -> UpdateAction -> Bool
$c== :: UpdateAction -> UpdateAction -> Bool
Eq,Int -> UpdateAction -> ShowS
[UpdateAction] -> ShowS
UpdateAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAction] -> ShowS
$cshowList :: [UpdateAction] -> ShowS
show :: UpdateAction -> String
$cshow :: UpdateAction -> String
showsPrec :: Int -> UpdateAction -> ShowS
$cshowsPrec :: Int -> UpdateAction -> ShowS
Show,ReadPrec [UpdateAction]
ReadPrec UpdateAction
Int -> ReadS UpdateAction
ReadS [UpdateAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAction]
$creadListPrec :: ReadPrec [UpdateAction]
readPrec :: ReadPrec UpdateAction
$creadPrec :: ReadPrec UpdateAction
readList :: ReadS [UpdateAction]
$creadList :: ReadS [UpdateAction]
readsPrec :: Int -> ReadS UpdateAction
$creadsPrec :: Int -> ReadS UpdateAction
Read,Eq UpdateAction
UpdateAction -> UpdateAction -> Bool
UpdateAction -> UpdateAction -> Ordering
UpdateAction -> UpdateAction -> UpdateAction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UpdateAction -> UpdateAction -> UpdateAction
$cmin :: UpdateAction -> UpdateAction -> UpdateAction
max :: UpdateAction -> UpdateAction -> UpdateAction
$cmax :: UpdateAction -> UpdateAction -> UpdateAction
>= :: UpdateAction -> UpdateAction -> Bool
$c>= :: UpdateAction -> UpdateAction -> Bool
> :: UpdateAction -> UpdateAction -> Bool
$c> :: UpdateAction -> UpdateAction -> Bool
<= :: UpdateAction -> UpdateAction -> Bool
$c<= :: UpdateAction -> UpdateAction -> Bool
< :: UpdateAction -> UpdateAction -> Bool
$c< :: UpdateAction -> UpdateAction -> Bool
compare :: UpdateAction -> UpdateAction -> Ordering
$ccompare :: UpdateAction -> UpdateAction -> Ordering
Ord)


instance ToJSON UpdateAction where
    toJSON :: UpdateAction -> Value
toJSON UpdateAction
UPut = Text -> Value
String Text
"PUT"
    toJSON UpdateAction
UAdd = Text -> Value
String Text
"ADD"
    toJSON UpdateAction
UDelete = Text -> Value
String Text
"DELETE"


instance Default UpdateAction where
    def :: UpdateAction
def = UpdateAction
UPut


instance ToJSON UpdateItem where
    toJSON :: UpdateItem -> Value
toJSON UpdateItem{[AttributeUpdate]
Text
UpdateReturn
ReturnItemCollectionMetrics
ReturnConsumption
Conditions
PrimaryKey
uiRetMet :: ReturnItemCollectionMetrics
uiRetCons :: ReturnConsumption
uiReturn :: UpdateReturn
uiExpect :: Conditions
uiUpdates :: [AttributeUpdate]
uiKey :: PrimaryKey
uiTable :: Text
uiRetMet :: UpdateItem -> ReturnItemCollectionMetrics
uiRetCons :: UpdateItem -> ReturnConsumption
uiReturn :: UpdateItem -> UpdateReturn
uiExpect :: UpdateItem -> Conditions
uiUpdates :: UpdateItem -> [AttributeUpdate]
uiKey :: UpdateItem -> PrimaryKey
uiTable :: UpdateItem -> Text
..} =
        [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ Conditions -> [Pair]
expectsJson Conditions
uiExpect forall a. [a] -> [a] -> [a]
++
          [ Key
"TableName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
uiTable
          , Key
"Key" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PrimaryKey
uiKey
          , Key
"AttributeUpdates" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [AttributeUpdate] -> AttributeUpdates
AttributeUpdates [AttributeUpdate]
uiUpdates
          , Key
"ReturnValues" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UpdateReturn
uiReturn
          , Key
"ReturnConsumedCapacity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ReturnConsumption
uiRetCons
          , Key
"ReturnItemCollectionMetrics" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ReturnItemCollectionMetrics
uiRetMet
          ]


data UpdateItemResponse = UpdateItemResponse {
      UpdateItemResponse -> Maybe Item
uirAttrs    :: Maybe Item
    -- ^ Old attributes, if requested
    , UpdateItemResponse -> Maybe ConsumedCapacity
uirConsumed :: Maybe ConsumedCapacity
    -- ^ Amount of capacity consumed
    } deriving (UpdateItemResponse -> UpdateItemResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateItemResponse -> UpdateItemResponse -> Bool
$c/= :: UpdateItemResponse -> UpdateItemResponse -> Bool
== :: UpdateItemResponse -> UpdateItemResponse -> Bool
$c== :: UpdateItemResponse -> UpdateItemResponse -> Bool
Eq,Int -> UpdateItemResponse -> ShowS
[UpdateItemResponse] -> ShowS
UpdateItemResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateItemResponse] -> ShowS
$cshowList :: [UpdateItemResponse] -> ShowS
show :: UpdateItemResponse -> String
$cshow :: UpdateItemResponse -> String
showsPrec :: Int -> UpdateItemResponse -> ShowS
$cshowsPrec :: Int -> UpdateItemResponse -> ShowS
Show,ReadPrec [UpdateItemResponse]
ReadPrec UpdateItemResponse
Int -> ReadS UpdateItemResponse
ReadS [UpdateItemResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateItemResponse]
$creadListPrec :: ReadPrec [UpdateItemResponse]
readPrec :: ReadPrec UpdateItemResponse
$creadPrec :: ReadPrec UpdateItemResponse
readList :: ReadS [UpdateItemResponse]
$creadList :: ReadS [UpdateItemResponse]
readsPrec :: Int -> ReadS UpdateItemResponse
$creadsPrec :: Int -> ReadS UpdateItemResponse
Read,Eq UpdateItemResponse
UpdateItemResponse -> UpdateItemResponse -> Bool
UpdateItemResponse -> UpdateItemResponse -> Ordering
UpdateItemResponse -> UpdateItemResponse -> UpdateItemResponse
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UpdateItemResponse -> UpdateItemResponse -> UpdateItemResponse
$cmin :: UpdateItemResponse -> UpdateItemResponse -> UpdateItemResponse
max :: UpdateItemResponse -> UpdateItemResponse -> UpdateItemResponse
$cmax :: UpdateItemResponse -> UpdateItemResponse -> UpdateItemResponse
>= :: UpdateItemResponse -> UpdateItemResponse -> Bool
$c>= :: UpdateItemResponse -> UpdateItemResponse -> Bool
> :: UpdateItemResponse -> UpdateItemResponse -> Bool
$c> :: UpdateItemResponse -> UpdateItemResponse -> Bool
<= :: UpdateItemResponse -> UpdateItemResponse -> Bool
$c<= :: UpdateItemResponse -> UpdateItemResponse -> Bool
< :: UpdateItemResponse -> UpdateItemResponse -> Bool
$c< :: UpdateItemResponse -> UpdateItemResponse -> Bool
compare :: UpdateItemResponse -> UpdateItemResponse -> Ordering
$ccompare :: UpdateItemResponse -> UpdateItemResponse -> Ordering
Ord)



instance Transaction UpdateItem UpdateItemResponse


instance SignQuery UpdateItem where
    type ServiceConfiguration UpdateItem = DdbConfiguration
    signQuery :: forall queryType.
UpdateItem
-> ServiceConfiguration UpdateItem queryType
-> SignatureData
-> SignedQuery
signQuery UpdateItem
gi = forall a qt.
ToJSON a =>
ByteString
-> a -> DdbConfiguration qt -> SignatureData -> SignedQuery
ddbSignQuery ByteString
"UpdateItem" UpdateItem
gi


instance FromJSON UpdateItemResponse where
    parseJSON :: Value -> Parser UpdateItemResponse
parseJSON (Object Object
v) = Maybe Item -> Maybe ConsumedCapacity -> UpdateItemResponse
UpdateItemResponse
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Attributes"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ConsumedCapacity"
    parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"UpdateItemResponse expected a JSON object"


instance ResponseConsumer r UpdateItemResponse where
    type ResponseMetadata UpdateItemResponse = DdbResponse
    responseConsumer :: Request
-> r
-> IORef (ResponseMetadata UpdateItemResponse)
-> HTTPResponseConsumer UpdateItemResponse
responseConsumer Request
_ r
_ IORef (ResponseMetadata UpdateItemResponse)
ref Response (ConduitM () ByteString (ResourceT IO) ())
resp = forall a. FromJSON a => IORef DdbResponse -> HTTPResponseConsumer a
ddbResponseConsumer IORef (ResponseMetadata UpdateItemResponse)
ref Response (ConduitM () ByteString (ResourceT IO) ())
resp


instance AsMemoryResponse UpdateItemResponse where
    type MemoryResponse UpdateItemResponse = UpdateItemResponse
    loadToMemory :: UpdateItemResponse
-> ResourceT IO (MemoryResponse UpdateItemResponse)
loadToMemory = forall (m :: * -> *) a. Monad m => a -> m a
return