1 {-# LANGUAGE OverloadedStrings, RecordWildCards, ViewPatterns, TemplateHaskell, QuasiQuotes, DataKinds #-} 2 module Databrary.Model.Slot 3 ( module Databrary.Model.Slot.Types 4 , lookupSlot 5 , auditSlotDownload 6 , slotJSON 7 ) where 8 9 -- import Database.PostgreSQL.Typed (pgSQL) 10 import Database.PostgreSQL.Typed.Types 11 import qualified Data.String 12 13 import qualified Databrary.JSON as JSON 14 import Databrary.Service.DB 15 import Databrary.Model.Id 16 import Databrary.Model.Identity 17 import Databrary.Model.Audit 18 import Databrary.Model.Segment 19 import Databrary.Model.Container 20 import Databrary.Model.Slot.Types 21 22 -- useTDB 23 24 lookupSlot :: (MonadDB c m, MonadHasIdentity c m) => Id Slot -> m (Maybe Slot) 25 lookupSlot (Id (SlotId c s)) = 26 fmap (`Slot` s) <$> lookupContainer c 27 28 auditSlotDownload :: MonadAudit c m => Bool -> Slot -> m () 29 auditSlotDownload success Slot{ slotContainer = c, slotSegment = seg } = do 30 let _tenv_abUAX = unknownPGTypeEnv 31 ai <- getAuditIdentity 32 dbExecute1' -- [pgSQL|$INSERT INTO audit.slot (audit_action, audit_user, audit_ip, container, segment) VALUES 33 -- (${if success then AuditActionOpen else AuditActionAttempt}, ${auditWho ai}, ${auditIp ai}, ${containerId $ containerRow c}, ${seg})|] 34 (mapPrepQuery 35 ((\ _p_abUAY _p_abUAZ _p_abUB0 _p_abUB1 _p_abUB2 -> 36 (Data.String.fromString 37 "INSERT INTO audit.slot (audit_action, audit_user, audit_ip, container, segment) VALUES\n\ 38 \ ($1, $2, $3, $4, $5)", 39 [Database.PostgreSQL.Typed.Types.pgEncodeParameter 40 _tenv_abUAX 41 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 42 Database.PostgreSQL.Typed.Types.PGTypeName "audit.action") 43 _p_abUAY, 44 Database.PostgreSQL.Typed.Types.pgEncodeParameter 45 _tenv_abUAX 46 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 47 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 48 _p_abUAZ, 49 Database.PostgreSQL.Typed.Types.pgEncodeParameter 50 _tenv_abUAX 51 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 52 Database.PostgreSQL.Typed.Types.PGTypeName "inet") 53 _p_abUB0, 54 Database.PostgreSQL.Typed.Types.pgEncodeParameter 55 _tenv_abUAX 56 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 57 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 58 _p_abUB1, 59 Database.PostgreSQL.Typed.Types.pgEncodeParameter 60 _tenv_abUAX 61 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 62 Database.PostgreSQL.Typed.Types.PGTypeName "segment") 63 _p_abUB2])) 64 (if success then AuditActionOpen else AuditActionAttempt) 65 (auditWho ai) 66 (auditIp ai) 67 (containerId $ containerRow c) 68 seg) 69 (\ [] -> ())) 70 71 slotJSON :: JSON.ToObject o => Slot -> JSON.Record (Id Container) o 72 slotJSON Slot{..} = containerJSON False slotContainer -- probably add bool to slotJSON 73 `JSON.foldObjectIntoRec` (segmentJSON slotSegment)