{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} 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 ------------------------------------------------------------------------------ -- Adding entries to the action log ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- | Calculates a list of fields that changed along with ByteString -- representations of their old and new values. 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) ------------------------------------------------------------------------------ -- Adding entries to the action log ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- | Low level function for logging an action. Usually you will want to use -- one of the other functions like 'loggedInsert'. But when those aren't -- sufficient, this function provides you maximum control to log actions as -- you see fit. logAction :: HasActionLog m => Text -- ^ Entity name. If you are logging database modifications, -- then this might be the name of the table being operated on. -> Int -- ^ Entity ID. This is the primary key for the affected row. -> ActionType -- ^ Type of action, such as create, update, or delete. -> m (Key LoggedAction) logAction entityName entityId action = do tid <- alGetTenantId uid <- alGetAuthUserId now <- alGetTime runPersist $ insert $ LoggedAction tid uid entityName entityId action now ------------------------------------------------------------------------------ -- | Performs a logged insert into the database. Just about everything should -- be inserted using this function instead of @runPersist' . insert@ 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 ------------------------------------------------------------------------------ -- | Performs a logged replace of a database record. 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 ------------------------------------------------------------------------------ -- | Performs a logged replace of a database record. 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 () ------------------------------------------------------------------------------ -- | Performs a logged update of a database record. 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 ------------------------------------------------------------------------------ -- | Performs a logged update of a database record. 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 () ------------------------------------------------------------------------------ -- | Performs a logged delete of an entity in the database. 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 () ------------------------------------------------------------------------------ -- | Performs a logged delete of a key in the database. 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) -- | Get human name for a database table defined to be an 'Entity'. getName :: forall a. PersistEntity a => a -> Text getName val = unHaskellName $ entityHaskell ed where ed = entityDef val' val' = return val :: Identity a ------------------------------------------------------------------------------ -- Retrieving log entries ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- | Gets the LoggedAction entry for the specified entity and id. getLoggedAction :: HasPersistPool m => LoggedActionId -> m (Maybe LoggedAction) getLoggedAction actionId = runPersist $ get actionId ------------------------------------------------------------------------------ -- | Gets the LoggedAction entry for the specified entity and id. getEntityActions :: HasPersistPool m => Text -> Int -> m [Entity LoggedAction] getEntityActions entityName entityId = runPersist $ selectList [ LoggedActionEntityName ==. entityName , LoggedActionEntityId ==. entityId ] [] ------------------------------------------------------------------------------ -- | Gets all the actions in the action log. In multi-tenant applications -- you probably want this to only be accessible by the administrator of the -- whole site. getAllActions :: HasPersistPool m => m [Entity LoggedAction] getAllActions = runPersist $ selectList [] [] ------------------------------------------------------------------------------ -- | Gets all the logged actions for the current tenant. getTenantActions :: HasActionLog m => [Filter LoggedAction] -> [SelectOpt LoggedAction] -> m [Entity LoggedAction] getTenantActions filters opts = do tid <- alGetTenantId runPersist $ selectList ((LoggedActionTenantId ==. tid):filters) opts ------------------------------------------------------------------------------ -- | Gets a list of all entities for a specific tenant. 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] ------------------------------------------------------------------------------ -- | Gets a list of all uids for a specific tenant. 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] ------------------------------------------------------------------------------ -- | Gets a list of all uids for a specific tenant. getActionDetails :: (HasActionLog m) => LoggedActionId -> m [Entity LoggedActionDetails] getActionDetails aid = runPersist $ selectList [ LoggedActionDetailsActionId ==. aid ] []