{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Database.DynamoDB (
DynamoException(..)
, Consistency(..)
, Direction(..)
, Column
, (<.>), (<!>), (<!:>)
, getItem
, getItemBatch
, QueryOpts
, queryOpts
, qConsistentRead, qStartKey, qDirection, qFilterCondition, qHashKey, qRangeCondition, qLimit
, query
, querySimple
, queryCond
, querySource
, querySourceChunks
, querySourceByKey
, queryOverIndex
, ScanOpts
, scanOpts
, sFilterCondition, sConsistentRead, sLimit, sParallel, sStartKey
, scan
, scanSource
, scanSourceChunks
, scanCond
, leftJoin
, innerJoin
, putItem
, putItemBatch
, insertItem
, updateItemByKey
, updateItemByKey_
, updateItemCond_
, deleteItemByKey
, deleteItemCondByKey
, deleteItemBatchByKey
, deleteTable
, tableKey
, DynamoTable
, DynamoIndex
, PrimaryKey
, ContainsTableKey
, CanQuery
, TableScan
) where
import Control.Lens ((%~), (.~), (^.))
import Control.Monad (void)
import Control.Monad.Catch (throwM)
import Data.Bool (bool)
import Data.Function ((&))
import Data.Proxy
import Data.Semigroup ((<>))
import Network.AWS
import qualified Network.AWS.DynamoDB.DeleteItem as D
import qualified Network.AWS.DynamoDB.GetItem as D
import qualified Network.AWS.DynamoDB.PutItem as D
import qualified Network.AWS.DynamoDB.UpdateItem as D
import qualified Network.AWS.DynamoDB.DeleteTable as D
import qualified Network.AWS.DynamoDB.Types as D
import Database.DynamoDB.Class
import Database.DynamoDB.Filter
import Database.DynamoDB.Internal
import Database.DynamoDB.Types
import Database.DynamoDB.Update
import Database.DynamoDB.BatchRequest
import Database.DynamoDB.QueryRequest
dDeleteItem :: DynamoTable a r => Proxy a -> PrimaryKey a r -> D.DeleteItem
dDeleteItem p pkey = D.deleteItem (tableName p) & D.diKey .~ dKeyToAttr p pkey
dGetItem :: DynamoTable a r => Proxy a -> PrimaryKey a r -> D.GetItem
dGetItem p pkey = D.getItem (tableName p) & D.giKey .~ dKeyToAttr p pkey
putItem :: (MonadAWS m, DynamoTable a r) => a -> m ()
putItem item = void $ send (dPutItem item)
insertItem :: forall a r m. (MonadAWS m, DynamoTable a r) => a -> m ()
insertItem item = do
let keyfields = primaryFields (Proxy :: Proxy a)
pkeyMissing = (AttrMissing . nameGenPath . pure . IntraName) $ head keyfields
(expr, attnames, attvals) = dumpCondition pkeyMissing
cmd = dPutItem item & D.piExpressionAttributeNames .~ attnames
& D.piConditionExpression .~ Just expr
& bool (D.piExpressionAttributeValues .~ attvals) id (null attvals)
void $ send cmd
getItem :: forall m a r. (MonadAWS m, DynamoTable a r) => Consistency -> Proxy a -> PrimaryKey a r -> m (Maybe a)
getItem consistency p key = do
let cmd = dGetItem p key & D.giConsistentRead . consistencyL .~ consistency
rs <- send cmd
let result = rs ^. D.girsItem
if | null result -> return Nothing
| otherwise ->
case dGsDecode result of
Right res -> return (Just res)
Left err -> throwM (DynamoException $ "Cannot decode item: " <> err)
deleteItemByKey :: forall m a r. (MonadAWS m, DynamoTable a r) => Proxy a -> PrimaryKey a r -> m ()
deleteItemByKey p pkey = void $ send (dDeleteItem p pkey)
deleteItemCondByKey :: forall m a r.
(MonadAWS m, DynamoTable a r) => Proxy a -> PrimaryKey a r -> FilterCondition a -> m ()
deleteItemCondByKey p pkey cond =
let (expr, attnames, attvals) = dumpCondition cond
cmd = dDeleteItem p pkey & D.diExpressionAttributeNames .~ attnames
& bool (D.diExpressionAttributeValues .~ attvals) id (null attvals)
& D.diConditionExpression .~ Just expr
in void (send cmd)
dUpdateItem :: forall a r. DynamoTable a r
=> Proxy a -> PrimaryKey a r -> Action a -> Maybe (FilterCondition a) -> Maybe D.UpdateItem
dUpdateItem p pkey actions mcond =
genAction <$> dumpActions actions
where
keyfields = primaryFields p
pkeyExists = (AttrExists . nameGenPath . pure . IntraName) (head keyfields)
genAction actparams =
D.updateItem (tableName p) & D.uiKey .~ dKeyToAttr p pkey
& addActions actparams
& addCondition (Just pkeyExists <> mcond)
addActions (expr, attnames, attvals) =
(D.uiUpdateExpression .~ Just expr)
. (D.uiExpressionAttributeNames %~ (<> attnames))
. bool (D.uiExpressionAttributeValues %~ (<> attvals)) id (null attvals)
addCondition (Just cond) =
let (expr, attnames, attvals) = dumpCondition cond
in (D.uiConditionExpression .~ Just expr)
. (D.uiExpressionAttributeNames %~ (<> attnames))
. bool (D.uiExpressionAttributeValues %~ (<> attvals)) id (null attvals)
addCondition Nothing = id
updateItemByKey_ :: forall a m r.
(MonadAWS m, DynamoTable a r) => Proxy a -> PrimaryKey a r -> Action a -> m ()
updateItemByKey_ p pkey actions
| Just cmd <- dUpdateItem p pkey actions Nothing = void $ send cmd
| otherwise = return ()
updateItemByKey :: forall a m r.
(MonadAWS m, DynamoTable a r) => Proxy a -> PrimaryKey a r -> Action a -> m a
updateItemByKey p pkey actions
| Just cmd <- dUpdateItem p pkey actions Nothing = do
rs <- send (cmd & D.uiReturnValues .~ Just D.AllNew)
case dGsDecode (rs ^. D.uirsAttributes) of
Right res -> return res
Left err -> throwM (DynamoException $ "Cannot decode item: " <> err)
| otherwise = do
rs <- getItem Strongly p pkey
case rs of
Just res -> return res
Nothing -> throwM (DynamoException "Cannot decode item.")
updateItemCond_ :: forall a m r. (MonadAWS m, DynamoTable a r)
=> Proxy a -> PrimaryKey a r -> FilterCondition a -> Action a -> m ()
updateItemCond_ p pkey cond actions
| Just cmd <- dUpdateItem p pkey actions (Just cond) = void $ send cmd
| otherwise = return ()
deleteTable :: (MonadAWS m, DynamoTable a r) => Proxy a -> m ()
deleteTable p = void $ send (D.deleteTable (tableName p))
tableKey :: forall a parent key. ContainsTableKey a parent key => a -> key
tableKey = dTableKey