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