shomei-postgres-0.2.0.0: src/Shomei/Audit/Reader/Postgres.hs
-- | PostgreSQL interpreter for the 'AuthEventReader' port: the read counterpart to
-- 'Shomei.Audit.Publisher.Postgres'. It issues only @SELECT@/@COUNT@ against the
-- append-only @shomei_auth_events@ table — there is no path here that mutates the audit
-- trail.
--
-- The query is a single parameterized statement that handles every optional filter with the
-- @($n IS NULL OR col = $n)@ idiom, applies a keyset (seek) predicate on
-- @(created_at, event_id)@, orders newest-first, and limits. The count uses the same filters
-- without ordering/limit/cursor.
module Shomei.Audit.Reader.Postgres
( runAuthEventReaderPostgres,
)
where
import Data.Functor.Contravariant ((>$<))
import Data.Int (Int64)
import Data.UUID (UUID)
import Effectful (Eff, (:>))
import Effectful.Dispatch.Dynamic (interpret_)
import Effectful.Error.Static (Error, throwError)
import Hasql.Decoders qualified as D
import Hasql.Encoders qualified as E
import Hasql.Session qualified as Session
import Hasql.Statement (Statement, preparable)
import Shomei.Audit.Reader.Store
( AuditCursor (..),
AuditEventQuery (..),
AuthEventReader (..),
StoredAuthEvent (..),
clampLimit,
)
import Shomei.Error (AuthError (..))
import Shomei.Persistence.Database.Postgres (Database, postgresUnavailable, runSession)
import Shomei.Prelude
-- Note: unlike 'runAuthEventPublisherPostgres' this interpreter needs no @IOE :> es@
-- constraint — reads go entirely through the @Database@ effect (no @liftIO@). It still
-- slots into any stack that also provides @IOE@.
runAuthEventReaderPostgres ::
(Database :> es, Error AuthError :> es) =>
Eff (AuthEventReader : es) a ->
Eff es a
runAuthEventReaderPostgres = interpret_ \case
QueryAuthEvents q -> do
res <- runSession (Session.statement (toQueryParams q) selectStmt)
either dbErr pure res
CountAuthEvents q -> do
res <- runSession (Session.statement (toCountParams q) countStmt)
either dbErr pure res
where
dbErr = throwError . postgresUnavailable
-- | Parameter bundle for the SELECT (filters, then cursor, then limit).
type QueryParams =
( Maybe UUID, -- user_id
Maybe UUID, -- session_id
[Text], -- event_type list ([] = all)
Maybe UTCTime, -- since (>=)
Maybe UTCTime, -- until (<)
Maybe UTCTime, -- before cursor created_at
Maybe UUID, -- before cursor event_id
Int64 -- limit
)
-- | Parameter bundle for the COUNT: the same filters, no cursor/limit.
type CountParams =
(Maybe UUID, Maybe UUID, [Text], Maybe UTCTime, Maybe UTCTime)
toQueryParams :: AuditEventQuery -> QueryParams
toQueryParams q =
( queryUserId q,
querySessionId q,
queryEventTypes q,
querySince q,
queryUntil q,
beforeTs,
beforeId,
fromIntegral (clampLimit (queryLimit q))
)
where
(beforeTs, beforeId) = case queryBefore q of
Nothing -> (Nothing, Nothing)
Just (AuditCursor t e) -> (Just t, Just e)
toCountParams :: AuditEventQuery -> CountParams
toCountParams q =
(queryUserId q, querySessionId q, queryEventTypes q, querySince q, queryUntil q)
-- | Encode a @text[]@ parameter (for the @event_type = ANY($3)@ filter).
textArray :: E.Value [Text]
textArray = E.foldableArray (E.nonNullable E.text)
queryEncoder :: E.Params QueryParams
queryEncoder =
((\(a, _, _, _, _, _, _, _) -> a) >$< E.param (E.nullable E.uuid))
<> ((\(_, b, _, _, _, _, _, _) -> b) >$< E.param (E.nullable E.uuid))
<> ((\(_, _, c, _, _, _, _, _) -> c) >$< E.param (E.nonNullable textArray))
<> ((\(_, _, _, d, _, _, _, _) -> d) >$< E.param (E.nullable E.timestamptz))
<> ((\(_, _, _, _, e, _, _, _) -> e) >$< E.param (E.nullable E.timestamptz))
<> ((\(_, _, _, _, _, f, _, _) -> f) >$< E.param (E.nullable E.timestamptz))
<> ((\(_, _, _, _, _, _, g, _) -> g) >$< E.param (E.nullable E.uuid))
<> ((\(_, _, _, _, _, _, _, h) -> h) >$< E.param (E.nonNullable E.int8))
countEncoder :: E.Params CountParams
countEncoder =
((\(a, _, _, _, _) -> a) >$< E.param (E.nullable E.uuid))
<> ((\(_, b, _, _, _) -> b) >$< E.param (E.nullable E.uuid))
<> ((\(_, _, c, _, _) -> c) >$< E.param (E.nonNullable textArray))
<> ((\(_, _, _, d, _) -> d) >$< E.param (E.nullable E.timestamptz))
<> ((\(_, _, _, _, e) -> e) >$< E.param (E.nullable E.timestamptz))
-- | Decode a row into a 'StoredAuthEvent'. The SELECT column order is
-- @event_id, user_id, session_id, event_type, payload, created_at@ but the record field
-- order differs, so decode positionally (@D.Row@ is 'Applicative', not 'Monad', in this
-- @hasql@ version) and reassemble the record with 'mk'.
storedRowDecoder :: D.Row StoredAuthEvent
storedRowDecoder =
mk
<$> D.column (D.nonNullable D.uuid) -- event_id
<*> D.column (D.nullable D.uuid) -- user_id
<*> D.column (D.nullable D.uuid) -- session_id
<*> D.column (D.nonNullable D.text) -- event_type
<*> D.column (D.nonNullable D.jsonb) -- payload
<*> D.column (D.nonNullable D.timestamptz) -- created_at
where
mk eid uid sid etype pl cat =
StoredAuthEvent
{ storedEventId = eid,
storedEventType = etype,
storedUserId = uid,
storedSessionId = sid,
storedCreatedAt = cat,
storedPayload = pl
}
selectStmt :: Statement QueryParams [StoredAuthEvent]
selectStmt =
preparable
"""
SELECT event_id, user_id, session_id, event_type, payload, created_at
FROM shomei.shomei_auth_events
WHERE ($1::uuid IS NULL OR user_id = $1)
AND ($2::uuid IS NULL OR session_id = $2)
AND (cardinality($3::text[]) = 0 OR event_type = ANY($3))
AND ($4::timestamptz IS NULL OR created_at >= $4)
AND ($5::timestamptz IS NULL OR created_at < $5)
AND ($6::timestamptz IS NULL OR (created_at, event_id) < ($6, $7))
ORDER BY created_at DESC, event_id DESC
LIMIT $8
"""
queryEncoder
(D.rowList storedRowDecoder)
countStmt :: Statement CountParams Int
countStmt =
preparable
"""
SELECT count(*)
FROM shomei.shomei_auth_events
WHERE ($1::uuid IS NULL OR user_id = $1)
AND ($2::uuid IS NULL OR session_id = $2)
AND (cardinality($3::text[]) = 0 OR event_type = ANY($3))
AND ($4::timestamptz IS NULL OR created_at >= $4)
AND ($5::timestamptz IS NULL OR created_at < $5)
"""
countEncoder
(D.singleRow (fromIntegral <$> D.column (D.nonNullable D.int8)))