{-# LANGUAGE DeriveDataTypeable        #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TypeFamilies              #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Aws.DynamoDb.Commands.GetItem
-- Copyright   :  Soostone Inc
-- License     :  BSD3
--
-- Maintainer  :  Ozgun Ataman <ozgun.ataman@soostone.com>
-- Stability   :  experimental
--
-- @http:\/\/docs.aws.amazon.com\/amazondynamodb\/latest\/APIReference\/API_PutItem.html@
----------------------------------------------------------------------------

module Aws.DynamoDb.Commands.PutItem where

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


data PutItem = PutItem {
      PutItem -> Text
piTable   :: T.Text
    -- ^ Target table
    , PutItem -> Item
piItem    :: Item
    -- ^ An item to Put. Attributes here will replace what maybe under
    -- the key on DDB.
    , PutItem -> Conditions
piExpect  :: Conditions
    -- ^ (Possible) set of expections for a conditional Put
    , PutItem -> UpdateReturn
piReturn  :: UpdateReturn
    -- ^ What to return from this query.
    , PutItem -> ReturnConsumption
piRetCons :: ReturnConsumption
    , PutItem -> ReturnItemCollectionMetrics
piRetMet  :: ReturnItemCollectionMetrics
    } deriving (PutItem -> PutItem -> Bool
(PutItem -> PutItem -> Bool)
-> (PutItem -> PutItem -> Bool) -> Eq PutItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PutItem -> PutItem -> Bool
== :: PutItem -> PutItem -> Bool
$c/= :: PutItem -> PutItem -> Bool
/= :: PutItem -> PutItem -> Bool
Eq,Int -> PutItem -> ShowS
[PutItem] -> ShowS
PutItem -> String
(Int -> PutItem -> ShowS)
-> (PutItem -> String) -> ([PutItem] -> ShowS) -> Show PutItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PutItem -> ShowS
showsPrec :: Int -> PutItem -> ShowS
$cshow :: PutItem -> String
show :: PutItem -> String
$cshowList :: [PutItem] -> ShowS
showList :: [PutItem] -> ShowS
Show,ReadPrec [PutItem]
ReadPrec PutItem
Int -> ReadS PutItem
ReadS [PutItem]
(Int -> ReadS PutItem)
-> ReadS [PutItem]
-> ReadPrec PutItem
-> ReadPrec [PutItem]
-> Read PutItem
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PutItem
readsPrec :: Int -> ReadS PutItem
$creadList :: ReadS [PutItem]
readList :: ReadS [PutItem]
$creadPrec :: ReadPrec PutItem
readPrec :: ReadPrec PutItem
$creadListPrec :: ReadPrec [PutItem]
readListPrec :: ReadPrec [PutItem]
Read,Eq PutItem
Eq PutItem =>
(PutItem -> PutItem -> Ordering)
-> (PutItem -> PutItem -> Bool)
-> (PutItem -> PutItem -> Bool)
-> (PutItem -> PutItem -> Bool)
-> (PutItem -> PutItem -> Bool)
-> (PutItem -> PutItem -> PutItem)
-> (PutItem -> PutItem -> PutItem)
-> Ord PutItem
PutItem -> PutItem -> Bool
PutItem -> PutItem -> Ordering
PutItem -> PutItem -> PutItem
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
$ccompare :: PutItem -> PutItem -> Ordering
compare :: PutItem -> PutItem -> Ordering
$c< :: PutItem -> PutItem -> Bool
< :: PutItem -> PutItem -> Bool
$c<= :: PutItem -> PutItem -> Bool
<= :: PutItem -> PutItem -> Bool
$c> :: PutItem -> PutItem -> Bool
> :: PutItem -> PutItem -> Bool
$c>= :: PutItem -> PutItem -> Bool
>= :: PutItem -> PutItem -> Bool
$cmax :: PutItem -> PutItem -> PutItem
max :: PutItem -> PutItem -> PutItem
$cmin :: PutItem -> PutItem -> PutItem
min :: PutItem -> PutItem -> PutItem
Ord)


-------------------------------------------------------------------------------
-- | Construct a minimal 'PutItem' request.
putItem :: T.Text
        -- ^ A Dynamo table name
        -> Item
        -- ^ Item to be saved
        -> PutItem
putItem :: Text -> Item -> PutItem
putItem Text
tn Item
it = Text
-> Item
-> Conditions
-> UpdateReturn
-> ReturnConsumption
-> ReturnItemCollectionMetrics
-> PutItem
PutItem Text
tn Item
it Conditions
forall a. Default a => a
def UpdateReturn
forall a. Default a => a
def ReturnConsumption
forall a. Default a => a
def ReturnItemCollectionMetrics
forall a. Default a => a
def


instance ToJSON PutItem where
    toJSON :: PutItem -> Value
toJSON PutItem{Item
Text
UpdateReturn
ReturnItemCollectionMetrics
ReturnConsumption
Conditions
piTable :: PutItem -> Text
piItem :: PutItem -> Item
piExpect :: PutItem -> Conditions
piReturn :: PutItem -> UpdateReturn
piRetCons :: PutItem -> ReturnConsumption
piRetMet :: PutItem -> ReturnItemCollectionMetrics
piTable :: Text
piItem :: Item
piExpect :: Conditions
piReturn :: UpdateReturn
piRetCons :: ReturnConsumption
piRetMet :: ReturnItemCollectionMetrics
..} =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ Conditions -> [Pair]
expectsJson Conditions
piExpect [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
          [ Key
"TableName" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
piTable
          , Key
"Item" Key -> Item -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Item
piItem
          , Key
"ReturnValues" Key -> UpdateReturn -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UpdateReturn
piReturn
          , Key
"ReturnConsumedCapacity" Key -> ReturnConsumption -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReturnConsumption
piRetCons
          , Key
"ReturnItemCollectionMetrics" Key -> ReturnItemCollectionMetrics -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ReturnItemCollectionMetrics
piRetMet
          ]



data PutItemResponse = PutItemResponse {
      PutItemResponse -> Maybe Item
pirAttrs    :: Maybe Item
    -- ^ Old attributes, if requested
    , PutItemResponse -> Maybe ConsumedCapacity
pirConsumed :: Maybe ConsumedCapacity
    -- ^ Amount of capacity consumed
    , PutItemResponse -> Maybe ItemCollectionMetrics
pirColMet   :: Maybe ItemCollectionMetrics
    -- ^ Collection metrics if they have been requested.
    } deriving (PutItemResponse -> PutItemResponse -> Bool
(PutItemResponse -> PutItemResponse -> Bool)
-> (PutItemResponse -> PutItemResponse -> Bool)
-> Eq PutItemResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PutItemResponse -> PutItemResponse -> Bool
== :: PutItemResponse -> PutItemResponse -> Bool
$c/= :: PutItemResponse -> PutItemResponse -> Bool
/= :: PutItemResponse -> PutItemResponse -> Bool
Eq,Int -> PutItemResponse -> ShowS
[PutItemResponse] -> ShowS
PutItemResponse -> String
(Int -> PutItemResponse -> ShowS)
-> (PutItemResponse -> String)
-> ([PutItemResponse] -> ShowS)
-> Show PutItemResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PutItemResponse -> ShowS
showsPrec :: Int -> PutItemResponse -> ShowS
$cshow :: PutItemResponse -> String
show :: PutItemResponse -> String
$cshowList :: [PutItemResponse] -> ShowS
showList :: [PutItemResponse] -> ShowS
Show,ReadPrec [PutItemResponse]
ReadPrec PutItemResponse
Int -> ReadS PutItemResponse
ReadS [PutItemResponse]
(Int -> ReadS PutItemResponse)
-> ReadS [PutItemResponse]
-> ReadPrec PutItemResponse
-> ReadPrec [PutItemResponse]
-> Read PutItemResponse
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PutItemResponse
readsPrec :: Int -> ReadS PutItemResponse
$creadList :: ReadS [PutItemResponse]
readList :: ReadS [PutItemResponse]
$creadPrec :: ReadPrec PutItemResponse
readPrec :: ReadPrec PutItemResponse
$creadListPrec :: ReadPrec [PutItemResponse]
readListPrec :: ReadPrec [PutItemResponse]
Read,Eq PutItemResponse
Eq PutItemResponse =>
(PutItemResponse -> PutItemResponse -> Ordering)
-> (PutItemResponse -> PutItemResponse -> Bool)
-> (PutItemResponse -> PutItemResponse -> Bool)
-> (PutItemResponse -> PutItemResponse -> Bool)
-> (PutItemResponse -> PutItemResponse -> Bool)
-> (PutItemResponse -> PutItemResponse -> PutItemResponse)
-> (PutItemResponse -> PutItemResponse -> PutItemResponse)
-> Ord PutItemResponse
PutItemResponse -> PutItemResponse -> Bool
PutItemResponse -> PutItemResponse -> Ordering
PutItemResponse -> PutItemResponse -> PutItemResponse
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
$ccompare :: PutItemResponse -> PutItemResponse -> Ordering
compare :: PutItemResponse -> PutItemResponse -> Ordering
$c< :: PutItemResponse -> PutItemResponse -> Bool
< :: PutItemResponse -> PutItemResponse -> Bool
$c<= :: PutItemResponse -> PutItemResponse -> Bool
<= :: PutItemResponse -> PutItemResponse -> Bool
$c> :: PutItemResponse -> PutItemResponse -> Bool
> :: PutItemResponse -> PutItemResponse -> Bool
$c>= :: PutItemResponse -> PutItemResponse -> Bool
>= :: PutItemResponse -> PutItemResponse -> Bool
$cmax :: PutItemResponse -> PutItemResponse -> PutItemResponse
max :: PutItemResponse -> PutItemResponse -> PutItemResponse
$cmin :: PutItemResponse -> PutItemResponse -> PutItemResponse
min :: PutItemResponse -> PutItemResponse -> PutItemResponse
Ord)



instance Transaction PutItem PutItemResponse


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


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


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


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