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)