@reventlessdev/reventless-postgres 3.0.0-alpha.4 → 3.0.0-alpha.41

package/lib/ocaml/EventLogStorage_Postgres_Ops.res

@@ -0,0 +1,180 @@
+// Runtime-pure classic (OCC) event-log operations for the Postgres backend.
+//
+// This module holds everything the DEPLOYED Lambda runtime needs and imports NO
+// `@pulumi/pulumi` — deploy-time-only. The deployed aggregate entry point pulls
+// these ops in unconditionally at cold start, so any deploy-time dependency here
+// leaks into the Lambda import graph and fails resolution (`@pulumi/pulumi` exists
+// in no Lambda — not the layer, not `/var/runtime`). The thin
+// `EventLogStorage_Postgres` wrapper adds the deploy-time `Pulumi.Output`-shaped
+// adapter on top for local/deploy consumers; the runtime imports `makeOps` here.
+// See docs/plans/deployed-lambda-esm-self-containment.md (Rung-3 finding).
+
+open ReventlessCore
+
+// Injected by reventless-local to feed the projection-checkpoint low-watermark
+// (ProjectionPending, aggregate axis). Standalone/deploy use passes nothing.
+type onAppended = array<(string, int)> => unit
+let noTracking: onAppended = _ => ()
+
+let decodePayload = (row: dict<JSON.t>): JSON.t =>
+  row->Dict.get("payload")->Option.getOr(JSON.Encode.null)
+
+let coerceInt = (v: JSON.t): int =>
+  switch v {
+  | JSON.Number(n) => Float.toInt(n)
+  | JSON.String(s) => s->Int.fromString->Option.getOr(0)
+  | _ => 0
+  }
+
+// Total events across all aggregates. Seeds the event-tap counter at startup so
+// timeline numbering continues across restarts.
+let countAll = async (pool: PgDriver.pool): int =>
+  switch await pool->PgDriver.queryOne("SELECT COUNT(*)::bigint AS c FROM event_log", []) {
+  | Some(row) => row->Dict.get("c")->Option.map(coerceInt)->Option.getOr(0)
+  | None => 0
+  }
+
+let isUniqueViolation = (exn: exn): bool => {
+  let msg = exn->JsExn.fromException->Option.flatMap(JsExn.message)->Option.getOr("")
+  // pg surfaces the SQLSTATE on `.code`; the message also carries the constraint.
+  msg->String.includes("duplicate key") ||
+  msg->String.includes("unique") ||
+  msg->String.includes("23505")
+}
+
+// Builds the classic runtime op set bound to `pool`. Returns `(name, ops)`; the
+// deploy-time `EventLog_Adapter` wrapper lives in `EventLogStorage_Postgres`.
+let makeOps = (
+  ~pool: PgDriver.pool,
+  ~name: string,
+  ~opts as _,
+  ~onAppended=noTracking,
+): (string, EventLog_Adapter.operations) => {
+  let appendTracked = async (~track, seqNr: int, id: string, jsons: array<JSON.t>) => {
+    // Empty append is a legitimate no-op (at-least-once retries, idempotent
+    // commands), NOT a conflict — return before the guarded insert whose 0-row
+    // result would otherwise be read as a conflict.
+    if jsons->Array.length == 0 {
+      Ok()
+    } else {
+      try {
+        let rows = await pool->PgDriver.query(
+          "INSERT INTO event_log(log_name, aggregate_id, seq_nr, payload, msg_id)
+           SELECT $1, $2, $3::bigint + (ord - 1), value, value->>'msgId'
+             FROM jsonb_array_elements($4::jsonb) WITH ORDINALITY AS t(value, ord)
+            WHERE $3::bigint = (SELECT COALESCE(MAX(seq_nr), -1) + 1
+                                  FROM event_log
+                                 WHERE log_name = $1 AND aggregate_id = $2)
+           RETURNING global_seq, msg_id",
+          [
+            JSON.Encode.string(name),
+            JSON.Encode.string(id),
+            JSON.Encode.int(seqNr),
+            JSON.Encode.string(JSON.stringify(JSON.Array(jsons))),
+          ],
+        )
+        if rows->Array.length == 0 {
+          // WHERE guard rejected the seq — a genuine OCC conflict (gap or stale).
+          Error(EventLog.Conflict)
+        } else {
+          if track {
+            onAppended(
+              rows->Array.filterMap(row =>
+                switch (row->Dict.get("msg_id"), row->Dict.get("global_seq")) {
+                | (Some(JSON.String(msgId)), Some(gseq)) => Some((msgId, coerceInt(gseq)))
+                | _ => None
+                }
+              ),
+            )
+          }
+          Ok()
+        }
+      } catch {
+      | exn =>
+        isUniqueViolation(exn)
+          ? Error(EventLog.Conflict)
+          : Error(
+              EventLog.StorageFailure(
+                exn->JsExn.fromException->Option.flatMap(JsExn.message)->Option.getOr("storage error"),
+              ),
+            )
+      }
+    }
+  }
+
+  let append: EventLog.append<string, JSON.t> = (seqNr, id, jsons) =>
+    appendTracked(~track=true, seqNr, id, jsons)
+
+  let replayArray = async (id: string, ~fromSeq=0): array<JSON.t> =>
+    (await pool->PgDriver.query(
+      "SELECT payload FROM event_log
+        WHERE log_name = $1 AND aggregate_id = $2 AND seq_nr >= $3::bigint
+        ORDER BY seq_nr ASC",
+      [JSON.Encode.string(name), JSON.Encode.string(id), JSON.Encode.int(fromSeq)],
+    ))->Array.map(decodePayload)
+
+  let replay: EventLog.replay<string, JSON.t> = id => replayArray(id)
+
+  let replayStream = (id, ~fromSeq=?) =>
+    Effect.promise(() => replayArray(id, ~fromSeq?))
+    ->Stream.fromEffect
+    ->Stream.flatMap(arr => Stream.fromIterable(arr))
+
+  let latestSnapshot: EventLog.latestSnapshot<string> = async id =>
+    switch await pool->PgDriver.queryOne(
+      "SELECT seq_nr, state, schema_hash FROM snapshot WHERE log_name = $1 AND aggregate_id = $2",
+      [JSON.Encode.string(name), JSON.Encode.string(id)],
+    ) {
+    | Some(row) =>
+      switch (row->Dict.get("seq_nr"), row->Dict.get("state"), row->Dict.get("schema_hash")) {
+      | (Some(seq), Some(state), Some(JSON.String(schemaHash))) =>
+        Ok(Some({EventLog.seqNr: coerceInt(seq), state, schemaHash}))
+      | _ => Error("snapshot row has unexpected shape")
+      }
+    | None => Ok(None)
+    }
+
+  let writeSnapshot: EventLog.writeSnapshot<string> = async (id, snap) =>
+    try {
+      let _ = await pool->PgDriver.query(
+        "INSERT INTO snapshot(log_name, aggregate_id, seq_nr, state, schema_hash)
+         VALUES ($1, $2, $3::bigint, $4::jsonb, $5)
+         ON CONFLICT (log_name, aggregate_id)
+         DO UPDATE SET seq_nr = EXCLUDED.seq_nr, state = EXCLUDED.state, schema_hash = EXCLUDED.schema_hash",
+        [
+          JSON.Encode.string(name),
+          JSON.Encode.string(id),
+          JSON.Encode.int(snap.EventLog.seqNr),
+          JSON.Encode.string(JSON.stringify(snap.state)),
+          JSON.Encode.string(snap.schemaHash),
+        ],
+      )
+      Ok()
+    } catch {
+    | exn =>
+      Error(exn->JsExn.fromException->Option.flatMap(JsExn.message)->Option.getOr("snapshot write error"))
+    }
+
+  let appendStream: EventLog.appendStream<string, JSON.t> = (startingSeqNr, id, stream) =>
+    stream
+    ->Stream.runCollect
+    ->Effect.flatMap(jsons =>
+      Effect.promise(() => appendTracked(~track=false, startingSeqNr, id, jsons))->Effect.flatMap(result =>
+        switch result {
+        | Ok() => Effect.succeed()
+        | Error(EventLog.Conflict) => Effect.fail("conflict")
+        | Error(StorageFailure(msg)) => Effect.fail(msg)
+        }
+      )
+    )
+
+  let ops: EventLog_Adapter.operations = {
+    append,
+    replay,
+    replayStream,
+    appendStream,
+    latestSnapshot,
+    writeSnapshot,
+  }
+  (name, ops)
+}

package/lib/ocaml/QueryDbStorage_Postgres.res

@@ -1,101 +1,16 @@
-// Postgres-backed QueryDb storage — JSONB document tables, one per read model.
+// Deploy/local wrapper over the runtime-pure QueryDbStorage_Postgres_Ops.
 //
-// Implements the clean QueryDb_Adapter.storageMaker (the shape
-// QueryDbStorage_DynamoDb implements): no in-process bus. The reventless-local
-// bridge that publishes state-changes to live GraphQL subscriptions wraps this
-// at integration time (Phase E), the way QueryDbStorage_Sqlite wraps its data
-// access today.
-//
-// Table `qdb_<name>`: partition_key text, sub_key text, item jsonb, expires_at
-// double precision (unix epoch seconds; null = never), PRIMARY KEY
-// (partition_key, sub_key). `item jsonb` returns already parsed. TTL is lazy —
-// every read carries `(expires_at IS NULL OR expires_at > epoch_now)`.
-//
-// GSI: each declared indexConfig becomes an expression index on `item->>'field'`
-// (composite keys concatenated with the configured separator). projectionType is
-// irrelevant in a relational store (every column is on the same row).
+// `makeOperations` + all SQL helpers live in QueryDbStorage_Postgres_Ops, which
+// imports NO `@pulumi/pulumi` so the deployed-Lambda runtime binds ops without
+// dragging a deploy-time dep into its ESM import graph. This module `include`s
+// that pure module (so every existing `QueryDbStorage_Postgres.*` reference keeps
+// working) and adds only the deploy-time `Pulumi.Output`-shaped `storage` record
+// and the `Make` provider functor.
+// See docs/plans/deployed-lambda-esm-self-containment.md (Rung-3 finding).
 
 open ReventlessCore
 open Reventless.ReadModel
-
-let tableName = (name: string): string => "qdb_" ++ name->String.replaceAll("-", "_")
-
-// Collapse anything outside [A-Za-z0-9_] to _ — predictable, injection-safe idents.
-let sanitizeIdent = (s: string): string =>
-  s->String.replaceRegExp(%re("/[^A-Za-z0-9_]/g"), "_")
-
-let notExpiredClause = "(expires_at IS NULL OR expires_at > extract(epoch from now()))"
-
-// JSONB text extraction for a single top-level field.
-let jsonField = (field: string): string =>
-  `(item->>'${field->String.replaceAll("'", "''")}')`
-
-let compositeExpr = (fields: array<string>, sep: string): string => {
-  let escapedSep = sep->String.replaceAll("'", "''")
-  fields->Array.map(jsonField)->Array.join(` || '${escapedSep}' || `)
-}
-
-let indexExpressions = (idx: indexConfig): (string, option<string>) => {
-  let pkExpr = switch idx.pkFields {
-  | Some(fields) if fields->Array.length > 0 => compositeExpr(fields, idx.pkSep->Option.getOr("/"))
-  | _ =>
-    switch idx.idField {
-    | Some(field) => jsonField(field)
-    | None => jsonField(idx.index)
-    }
-  }
-  let skExpr = switch idx.skFields {
-  | Some(fields) if fields->Array.length > 0 =>
-    Some(compositeExpr(fields, idx.skSep->Option.getOr("/")))
-  | _ =>
-    switch idx.subIdField {
-    | Some(field) => Some(jsonField(field))
-    | None => None
-    }
-  }
-  (pkExpr, skExpr)
-}
-
-let ensureTable = async (~pool, ~table) => {
-  await pool->PgDriver.exec(
-    `CREATE TABLE IF NOT EXISTS ${table} (partition_key text NOT NULL, sub_key text NOT NULL DEFAULT '', item jsonb NOT NULL, expires_at double precision, PRIMARY KEY (partition_key, sub_key))`,
-  )
-}
-
-let ensureIndexes = async (~pool, ~table, ~indexes: array<indexConfig>) => {
-  for i in 0 to indexes->Array.length - 1 {
-    let idx = indexes->Array.getUnsafe(i)
-    let (pkExpr, skExprOpt) = indexExpressions(idx)
-    let indexName = `idx_${table}_${sanitizeIdent(idx.index)}`
-    let cols = switch skExprOpt {
-    | Some(skExpr) => `${pkExpr}, ${skExpr}`
-    | None => pkExpr
-    }
-    await pool->PgDriver.exec(`CREATE INDEX IF NOT EXISTS ${indexName} ON ${table} (${cols})`)
-  }
-}
-
-let decodeItem = (row: dict<JSON.t>): JSON.t =>
-  row->Dict.get("item")->Option.getOr(JSON.Encode.null)
-
-let computeSubKey = (item: JSON.t, subIdField: option<string>): string =>
-  switch subIdField {
-  | None => ""
-  | Some(field) =>
-    switch item->JSON.Decode.object->Option.flatMap(o => o->Dict.get(field)) {
-    | Some(JSON.String(s)) => s
-    | _ => ""
-    }
-  }
-
-let withId = (item: JSON.t, partitionKey: string): JSON.t =>
-  switch item->JSON.Decode.object {
-  | Some(obj) if obj->Dict.get("id")->Option.isNone =>
-    let copy = Dict.copy(obj)
-    copy->Dict.set("id", JSON.Encode.string(partitionKey))
-    JSON.Encode.object(copy)
-  | _ => item
-  }
+include QueryDbStorage_Postgres_Ops
 
 let makeStorage = (
   ~pool: PgDriver.pool,
@@ -103,127 +18,10 @@ let makeStorage = (
   ~indexes: array<indexConfig>,
   ~subIdField: option<string>,
 ): QueryDb_Adapter.storage => {
-  let table = tableName(name)
-  // Schema setup is async but makeStorage is synchronous; gate every operation on
-  // this promise so the first access waits for table + index creation exactly
-  // once (subsequent awaits resolve immediately).
-  let ready = {
-    open Promise
-    ensureTable(~pool, ~table)->then(() => ensureIndexes(~pool, ~table, ~indexes))
-  }
-
-  let rowsFor = async (id: string): array<JSON.t> => {
-    await ready
-    (await pool->PgDriver.query(
-      `SELECT item FROM ${table} WHERE partition_key = $1 AND ${notExpiredClause} ORDER BY sub_key ASC`,
-      [JSON.Encode.string(id)],
-    ))->Array.map(decodeItem)
-  }
-
-  let saveOne = async (id: string, state: JSON.t, ttl: option<int>) => {
-    await ready
-    let subKey = computeSubKey(state, subIdField)
-    let expiresAt = switch ttl {
-    | Some(t) => JSON.Encode.int(t)
-    | None => JSON.Encode.null
-    }
-    let _ = await pool->PgDriver.query(
-      `INSERT INTO ${table}(partition_key, sub_key, item, expires_at)
-       VALUES ($1, $2, $3::jsonb, $4)
-       ON CONFLICT (partition_key, sub_key)
-       DO UPDATE SET item = EXCLUDED.item, expires_at = EXCLUDED.expires_at`,
-      [
-        JSON.Encode.string(id),
-        JSON.Encode.string(subKey),
-        JSON.Encode.string(JSON.stringify(state)),
-        expiresAt,
-      ],
-    )
-  }
-
-  let load: QueryDb.load<string, JSON.t> = async id => Ok(await rowsFor(id))
-
-  let loadStream: QueryDb.loadStream<string, JSON.t> =
-    id =>
-      Effect.promise(() => rowsFor(id))
-      ->Stream.fromEffect
-      ->Stream.flatMap(arr => Stream.fromIterable(arr))
-
-  let save: QueryDb.save<string, JSON.t> = async (id, state, _saveMode, ttl) => {
-    await saveOne(id, state, ttl)
-    Ok()
-  }
-
-  let saveBatch: QueryDb.saveBatch<string, JSON.t> = async batch => {
-    // pg has no synchronous multi-statement transaction helper here; the upserts
-    // are independent (distinct keys) so a sequential apply is equivalent.
-    for i in 0 to batch->Array.length - 1 {
-      let (id, state, ttl) = batch->Array.getUnsafe(i)
-      await saveOne(id, state, ttl)
-    }
-    Ok()
-  }
-
-  // Mirror DynamoDB's `ADD #field :inc`: read the counter on the partition item
-  // (counters are single-state, sub_key=""), add inc, upsert, return NEW total.
-  let count: QueryDb.count<string> = async (id, fieldName, inc) => {
-    await ready
-    let existing = (await rowsFor(id))->Array.get(0)->Option.flatMap(JSON.Decode.object)
-    let current =
-      existing
-      ->Option.flatMap(o => o->Dict.get(fieldName))
-      ->Option.flatMap(JSON.Decode.float)
-      ->Option.mapOr(0, Float.toInt)
-    let next = current + inc
-    let obj = switch existing {
-    | Some(o) => Dict.copy(o)
-    | None => Dict.make()
-    }
-    obj->Dict.set("id", JSON.Encode.string(id))
-    obj->Dict.set(fieldName, JSON.Encode.int(next))
-    await saveOne(id, JSON.Encode.object(obj), None)
-    Ok(next)
-  }
-
-  let delete: QueryDb.delete<string> = async (id, subIdOpt) => {
-    await ready
-    let _ = switch subIdOpt {
-    | None =>
-      await pool->PgDriver.query(
-        `DELETE FROM ${table} WHERE partition_key = $1`,
-        [JSON.Encode.string(id)],
-      )
-    | Some((_, subValue)) =>
-      await pool->PgDriver.query(
-        `DELETE FROM ${table} WHERE partition_key = $1 AND sub_key = $2`,
-        [JSON.Encode.string(id), JSON.Encode.string(subValue)],
-      )
-    }
-    Ok()
-  }
-
-  let deleteBatch: QueryDb.deleteBatch<string> = async ids => {
-    for i in 0 to ids->Array.length - 1 {
-      let (id, subIdOpt) = ids->Array.getUnsafe(i)
-      let _ = await delete(id, subIdOpt)
-    }
-    Ok()
-  }
-
-  let ops: QueryDb_Adapter.operations = {
-    load,
-    loadStream,
-    save,
-    saveBatch,
-    count,
-    delete,
-    deleteBatch,
-  }
-
   {
     QueryDb_Adapter.resources: [],
     dataSourceName: ""->Pulumi.Output.make,
-    operations: Pulumi.Output.make(ops),
+    operations: Pulumi.Output.make(makeOperations(~pool, ~name, ~indexes, ~subIdField)),
   }
 }
 
@@ -239,6 +37,6 @@ module Make = (P: {let pool: PgDriver.pool}) => {
     ~ttl as _=?,
     ~api as _,
     ~apiRole as _,
-    ~opts as _,
+    ~owner as _, ~opts as _,
   ) => makeStorage(~pool=P.pool, ~name, ~indexes, ~subIdField)
 }