1 {-# LANGUAGE TemplateHaskell, OverloadedStrings #-} 2 module Databrary.Model.Audit.SQL 3 ( selectAudit 4 , auditInsert 5 , auditDelete 6 , auditUpdate 7 , selectAuditActivity 8 , whereEq 9 ) where 10 11 import Data.List (intercalate) 12 import Data.Monoid ((<>)) 13 import Database.PostgreSQL.Typed.Dynamic (pgSafeLiteralString) 14 import Database.PostgreSQL.Typed.Inet (PGInet) 15 import Database.PostgreSQL.Typed.Query (makePGQuery, parseQueryFlags) 16 import qualified Language.Haskell.TH as TH 17 18 import Databrary.Model.SQL.Select 19 import Databrary.Model.Time 20 import Databrary.Model.Id.Types 21 import Databrary.Model.Party.Types 22 import Databrary.Model.Audit.Types 23 24 makeAudit :: Timestamp -> Id Party -> PGInet -> AuditAction -> Audit 25 makeAudit t u = Audit t . AuditIdentity u 26 27 selectAudit :: String -> Selector 28 selectAudit table = selectColumns 'makeAudit table ["audit_time", "audit_user", "audit_ip", "audit_action"] 29 30 actionCmd :: AuditAction -> String 31 actionCmd AuditActionAdd = "INSERT INTO" 32 actionCmd AuditActionChange = "UPDATE" 33 actionCmd AuditActionRemove = "DELETE FROM" 34 actionCmd a = error $ "actionCmd: " ++ show a 35 36 auditQuery 37 :: AuditAction 38 -> TH.Name -- ^ @'AuditIdentity'@ 39 -> String 40 -> String -- ^ statement 41 -> Maybe SelectOutput 42 -> TH.ExpQ 43 auditQuery action ident tablef stmt = 44 maybe (makePGQuery flags sql) (makeQuery flags ((sql ++) . (" RETURNING " ++))) 45 where 46 sql = "WITH audit_row AS (" <> actionCmd action <> " " <> table <> " " <> stmt 47 <> " RETURNING *) INSERT INTO audit." <> table 48 <> " SELECT CURRENT_TIMESTAMP, ${auditWho " <> idents <> "}, ${auditIp " <> idents <> "}, " <> pgSafeLiteralString action <> ", * FROM audit_row" 49 idents = nameRef ident 50 (flags, table) = parseQueryFlags tablef 51 52 auditInsert :: TH.Name -> String -> [(String, String)] -> Maybe SelectOutput -> TH.ExpQ 53 auditInsert ident table args = 54 auditQuery AuditActionAdd ident table 55 ('(' : intercalate "," (map fst args) ++ ") VALUES (" ++ intercalate "," (map snd args) ++ ")") 56 57 auditDelete :: TH.Name -> String -> String -> Maybe SelectOutput -> TH.ExpQ 58 auditDelete ident table wher = 59 auditQuery AuditActionRemove ident table ("WHERE " ++ wher) 60 61 auditUpdate :: TH.Name -> String -> [(String, String)] -> String -> Maybe SelectOutput -> TH.ExpQ 62 auditUpdate ident table sets wher = 63 auditQuery AuditActionChange ident table 64 ("SET " ++ intercalate "," (map pairEq sets) ++ " WHERE " ++ wher) 65 66 selectAuditActivity :: String -> Selector -- ^ @'Timestamp'@ 67 selectAuditActivity table = 68 selector ("audit." ++ table ++ " AS audit") (SelectColumn "audit" "audit_time") 69 70 pairEq :: (String, String) -> String 71 pairEq (c, v) = c ++ "=" ++ v 72 73 whereEq :: [(String, String)] -> String 74 whereEq = intercalate " AND " . map pairEq