<commit_before>{-# LANGUAGE OverloadedStrings, RecordWildCards, ViewPatterns, TemplateHaskell, QuasiQuotes, DataKinds #-}
module Databrary.Model.Slot
  ( module Databrary.Model.Slot.Types
  , lookupSlot
  , auditSlotDownload
  , slotJSON
  ) where

import Database.PostgreSQL.Typed (pgSQL)

import qualified Databrary.JSON as JSON
import Databrary.Service.DB
import Databrary.Model.Id
import Databrary.Model.Identity
import Databrary.Model.Audit
import Databrary.Model.Segment
import Databrary.Model.Container
import Databrary.Model.Slot.Types

useTDB

lookupSlot :: (MonadDB c m, MonadHasIdentity c m) => Id Slot -> m (Maybe Slot)
lookupSlot (Id (SlotId c s)) =
  fmap (`Slot` s) <$> lookupContainer c

auditSlotDownload :: MonadAudit c m => Bool -> Slot -> m ()
auditSlotDownload success Slot{ slotContainer = c, slotSegment = seg } = do
  ai <- getAuditIdentity
  dbExecute1' [pgSQL|$INSERT INTO audit.slot (audit_action, audit_user, audit_ip, container, segment) VALUES
    (${if success then AuditActionOpen else AuditActionAttempt}, ${auditWho ai}, ${auditIp ai}, ${containerId $ containerRow c}, ${seg})|]

slotJSON :: JSON.ToObject o => Slot -> JSON.Record (Id Container) o
slotJSON Slot{..} = containerJSON False slotContainer -- probably add bool to slotJSON
  `JSON.foldObjectIntoRec` (segmentJSON slotSegment)<commit_msg>Expand auditSlotDownload<commit_after>{-# LANGUAGE OverloadedStrings, RecordWildCards, ViewPatterns, TemplateHaskell, QuasiQuotes, DataKinds #-}
module Databrary.Model.Slot
  ( module Databrary.Model.Slot.Types
  , lookupSlot
  , auditSlotDownload
  , slotJSON
  ) where

-- import Database.PostgreSQL.Typed (pgSQL)
import Database.PostgreSQL.Typed.Types
import qualified Data.String

import qualified Databrary.JSON as JSON
import Databrary.Service.DB
import Databrary.Model.Id
import Databrary.Model.Identity
import Databrary.Model.Audit
import Databrary.Model.Segment
import Databrary.Model.Container
import Databrary.Model.Slot.Types

-- useTDB

lookupSlot :: (MonadDB c m, MonadHasIdentity c m) => Id Slot -> m (Maybe Slot)
lookupSlot (Id (SlotId c s)) =
  fmap (`Slot` s) <$> lookupContainer c

auditSlotDownload :: MonadAudit c m => Bool -> Slot -> m ()
auditSlotDownload success Slot{ slotContainer = c, slotSegment = seg } = do
  let _tenv_abUAX = unknownPGTypeEnv
  ai <- getAuditIdentity
  dbExecute1' -- [pgSQL|$INSERT INTO audit.slot (audit_action, audit_user, audit_ip, container, segment) VALUES
    -- (${if success then AuditActionOpen else AuditActionAttempt}, ${auditWho ai}, ${auditIp ai}, ${containerId $ containerRow c}, ${seg})|]
   (mapPrepQuery
    ((\ _p_abUAY _p_abUAZ _p_abUB0 _p_abUB1 _p_abUB2 ->
                    (Data.String.fromString
                       "INSERT INTO audit.slot (audit_action, audit_user, audit_ip, container, segment) VALUES\n\
                       \    ($1, $2, $3, $4, $5)",
                    [Database.PostgreSQL.Typed.Types.pgEncodeParameter
                       _tenv_abUAX
                       (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                          Database.PostgreSQL.Typed.Types.PGTypeName "audit.action")
                       _p_abUAY,
                     Database.PostgreSQL.Typed.Types.pgEncodeParameter
                       _tenv_abUAX
                       (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                          Database.PostgreSQL.Typed.Types.PGTypeName "integer")
                       _p_abUAZ,
                     Database.PostgreSQL.Typed.Types.pgEncodeParameter
                       _tenv_abUAX
                       (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                          Database.PostgreSQL.Typed.Types.PGTypeName "inet")
                       _p_abUB0,
                     Database.PostgreSQL.Typed.Types.pgEncodeParameter
                       _tenv_abUAX
                       (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                          Database.PostgreSQL.Typed.Types.PGTypeName "integer")
                       _p_abUB1,
                     Database.PostgreSQL.Typed.Types.pgEncodeParameter
                       _tenv_abUAX
                       (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
                          Database.PostgreSQL.Typed.Types.PGTypeName "segment")
                       _p_abUB2]))
      (if success then AuditActionOpen else AuditActionAttempt)
      (auditWho ai)
      (auditIp ai)
      (containerId $ containerRow c)
      seg)
    (\ [] -> ()))

slotJSON :: JSON.ToObject o => Slot -> JSON.Record (Id Container) o
slotJSON Slot{..} = containerJSON False slotContainer -- probably add bool to slotJSON
  `JSON.foldObjectIntoRec` (segmentJSON slotSegment)
{'fraction_non_alphanumeric': 0.09555224515854437, 'fraction_numerical': 0.002766546073632688, 'mean_word_length': 2.623747108712413, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 21, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 7, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6786322', 'n_tokens_mistral': 1451, 'n_tokens_neox': 1401, 'n_words': 319}