module Snap.Snaplet.ActionLog.API where
import Control.Monad
import Data.Functor.Identity
import Data.Text (Text)
import Data.Text.Encoding
import Database.Persist
import Database.Persist.Sql
import Snap.Snaplet.Persistent
import Snap.Snaplet.ActionLog.Types
storeDeltas :: (HasPersistPool m, CanDelta a)
=> LoggedActionId -> a -> a -> m ()
storeDeltas aid old new = do
runPersist $ mapM_ ins $ getDeltas old new
where
ins (f,o,n) = insert $
LoggedActionDetails aid f (decodeUtf8 o) (decodeUtf8 n)
logAction :: HasActionLog m
=> Text
-> Int
-> ActionType
-> m (Key LoggedAction)
logAction entityName entityId action = do
tid <- alGetTenantId
uid <- alGetAuthUserId
now <- alGetTime
runPersist $ insert $
LoggedAction tid uid entityName entityId action now
loggedInsert :: (PersistEntity a, HasActionLog m,
PersistEntityBackend a ~ SqlBackend)
=> a -> m (Key a)
loggedInsert val = do
let entityName = getName val
recKey <- runPersist $ insert val
let entityId = mkInt recKey
logAction entityName entityId CreateAction
return recKey
loggedReplace :: (PersistEntity a, CanDelta a, HasActionLog m,
PersistEntityBackend a ~ SqlBackend)
=> Key a -> a -> m ()
loggedReplace key new = do
old <- runPersist $ get key
maybe (return ()) (\o -> loggedReplace' key o new) old
loggedReplace'
:: (PersistEntity a, CanDelta a, HasActionLog m,
PersistEntityBackend a ~ SqlBackend) =>
Key a -> a -> a -> m ()
loggedReplace' key old new = do
let entityName = getName new
runPersist $ replace key new
let entityId = mkInt key
aid <- logAction entityName entityId UpdateAction
storeDeltas aid old new
return ()
loggedUpdate :: (PersistEntity a, CanDelta a, HasActionLog m,
PersistEntityBackend a ~ SqlBackend)
=> Key a -> [Update a] -> m ()
loggedUpdate key updates = do
old <- runPersist $ get key
maybe (return ()) (\o -> loggedUpdate' key o updates) old
loggedUpdate'
:: (PersistEntity a, CanDelta a, HasActionLog m,
PersistEntityBackend a ~ SqlBackend)
=> Key a
-> a
-> [Update a]
-> m ()
loggedUpdate' key old updates = do
val <- runPersist $ updateGet key updates
new <- runPersist $ get key
let entityName = getName val
let entityId = mkInt key
aid <- logAction entityName entityId UpdateAction
maybe (return ()) (\n -> storeDeltas aid old n) new
return ()
loggedDelete
:: forall m a.
(HasActionLog m, PersistEntity a,
PersistEntityBackend a ~ SqlBackend)
=> Entity a
-> m ()
loggedDelete (Entity key val) = do
runPersist $ delete key
logAction (getName val) (mkInt key) DeleteAction
return ()
loggedDeleteKey
:: (PersistEntity a, HasActionLog m,
PersistEntityBackend a ~ SqlBackend)
=> Key a
-> m ()
loggedDeleteKey key = do
mval <- runPersist $ Database.Persist.get key
case mval of
Nothing -> return ()
Just val -> loggedDelete (Entity key val)
getName :: forall a. PersistEntity a => a -> Text
getName val = unHaskellName $ entityHaskell ed
where
ed = entityDef val'
val' = return val :: Identity a
getLoggedAction :: HasPersistPool m
=> LoggedActionId -> m (Maybe LoggedAction)
getLoggedAction actionId = runPersist $ get actionId
getEntityActions :: HasPersistPool m
=> Text -> Int -> m [Entity LoggedAction]
getEntityActions entityName entityId = runPersist $
selectList [ LoggedActionEntityName ==. entityName
, LoggedActionEntityId ==. entityId
] []
getAllActions :: HasPersistPool m => m [Entity LoggedAction]
getAllActions = runPersist $ selectList [] []
getTenantActions :: HasActionLog m
=> [Filter LoggedAction]
-> [SelectOpt LoggedAction]
-> m [Entity LoggedAction]
getTenantActions filters opts = do
tid <- alGetTenantId
runPersist $ selectList ((LoggedActionTenantId ==. tid):filters) opts
getTenantEntities :: (HasActionLog m) => m [Text]
getTenantEntities = do
tid <- alGetTenantId
liftM (map unSingle) $ runPersist $ rawSql
"SELECT DISTINCT entity_name from logged_action WHERE tenant_id = ?;"
[PersistInt64 $ fromIntegral tid]
getTenantUids :: (HasActionLog m) => m [Int]
getTenantUids = do
tid <- alGetTenantId
liftM (map unSingle) $ runPersist $ rawSql
"SELECT DISTINCT user_id from logged_action WHERE tenant_id = ?;"
[PersistInt64 $ fromIntegral tid]
getActionDetails :: (HasActionLog m)
=> LoggedActionId
-> m [Entity LoggedActionDetails]
getActionDetails aid =
runPersist $ selectList [ LoggedActionDetailsActionId ==. aid ] []