diff --git a/lib/persist/api.sx b/lib/persist/api.sx new file mode 100644 index 00000000..61e806ef --- /dev/null +++ b/lib/persist/api.sx @@ -0,0 +1,10 @@ +; persist/api — the public entry point. persist/open returns a backend (the +; in-memory one by default; pass a custom backend to inject file/pg/ipfs-ref). +; All facet functions take this backend as their first argument. +; Requires: lib/persist/backend.sx, lib/persist/log.sx, lib/persist/kv.sx. + +(define + persist/open + (fn + (&rest args) + (if (= (len args) 0) (persist/mem-backend) (first args)))) diff --git a/lib/persist/backend.sx b/lib/persist/backend.sx new file mode 100644 index 00000000..150f9911 --- /dev/null +++ b/lib/persist/backend.sx @@ -0,0 +1,21 @@ +; persist/backend — the injected storage protocol. Every facet (log, kv, +; snapshot) goes through a backend dict, never touching storage directly, so +; file/pg/ipfs-ref backends swap in unchanged. A backend is a dict of fns: +; {:append :read :kv-get :kv-put :kv-delete :kv-has? :kv-keys} +; The in-memory backend is the test default. State is two dicts held in a +; closure and mutated with set!: logs (stream -> event list) and kv. + +(define + persist/mem-backend + (fn () (let ((logs {}) (kv {})) {:kv-keys (fn () (keys kv)) :read (fn (stream) (let ((cur (get logs stream))) (if cur cur (list)))) :kv-has? (fn (key) (has-key? kv key)) :append (fn (stream event) (let ((cur (get logs stream))) (set! logs (assoc logs stream (append (if cur cur (list)) event))))) :kv-delete (fn (key) (set! kv (dissoc kv key))) :kv-put (fn (key val) (set! kv (assoc kv key val))) :kv-get (fn (key) (get kv key))}))) + +; protocol accessors — call a backend op by keyword +(define + persist/backend-append + (fn (b stream event) ((get b :append) stream event))) +(define persist/backend-read (fn (b stream) ((get b :read) stream))) +(define persist/backend-kv-get (fn (b key) ((get b :kv-get) key))) +(define persist/backend-kv-put (fn (b key val) ((get b :kv-put) key val))) +(define persist/backend-kv-delete (fn (b key) ((get b :kv-delete) key))) +(define persist/backend-kv-has? (fn (b key) ((get b :kv-has?) key))) +(define persist/backend-kv-keys (fn (b) ((get b :kv-keys)))) diff --git a/lib/persist/conformance.sh b/lib/persist/conformance.sh new file mode 100755 index 00000000..5bcdb38f --- /dev/null +++ b/lib/persist/conformance.sh @@ -0,0 +1,113 @@ +#!/usr/bin/env bash +# lib/persist/conformance.sh — run persist test suites, emit scoreboard.json + scoreboard.md. + +set -uo pipefail +cd "$(git rev-parse --show-toplevel)" + +SX_SERVER="${SX_SERVER:-/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe}" +if [ ! -x "$SX_SERVER" ]; then + SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe" +fi +if [ ! -x "$SX_SERVER" ]; then + echo "ERROR: sx_server.exe not found." >&2 + exit 1 +fi + +SUITES=(event log kv) + +OUT_JSON="lib/persist/scoreboard.json" +OUT_MD="lib/persist/scoreboard.md" + +run_suite() { + local suite=$1 + local file="lib/persist/tests/${suite}.sx" + local TMP + TMP=$(mktemp) + cat > "$TMP" << EPOCHS +(epoch 1) +(load "spec/stdlib.sx") +(load "lib/r7rs.sx") +(load "lib/persist/event.sx") +(load "lib/persist/backend.sx") +(load "lib/persist/log.sx") +(load "lib/persist/kv.sx") +(load "lib/persist/api.sx") +(epoch 2) +(eval "(define persist-test-pass 0)") +(eval "(define persist-test-fail 0)") +(eval "(define persist-test (fn (name got expected) (if (equal? got expected) (set! persist-test-pass (+ persist-test-pass 1)) (set! persist-test-fail (+ persist-test-fail 1)))))") +(epoch 3) +(load "${file}") +(epoch 4) +(eval "(list persist-test-pass persist-test-fail)") +EPOCHS + + local OUTPUT + OUTPUT=$(timeout 300 "$SX_SERVER" < "$TMP" 2>/dev/null) + rm -f "$TMP" + + local LINE + LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 4 / {getline; print; exit}') + if [ -z "$LINE" ]; then + LINE=$(echo "$OUTPUT" | grep -E '^\(ok 4 \([0-9]+ [0-9]+\)\)' | tail -1 \ + | sed -E 's/^\(ok 4 //; s/\)$//') + fi + + local P F + P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/') + F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/') + P=${P:-0} + F=${F:-0} + echo "${P} ${F}" +} + +declare -A SUITE_PASS +declare -A SUITE_FAIL +TOTAL_PASS=0 +TOTAL_FAIL=0 + +echo "Running persist conformance suite..." >&2 +for s in "${SUITES[@]}"; do + read -r p f < <(run_suite "$s") + SUITE_PASS[$s]=$p + SUITE_FAIL[$s]=$f + TOTAL_PASS=$((TOTAL_PASS + p)) + TOTAL_FAIL=$((TOTAL_FAIL + f)) + printf " %-12s %d/%d\n" "$s" "$p" "$((p+f))" >&2 +done + +# scoreboard.json +{ + printf '{\n' + printf ' "suites": {\n' + first=1 + for s in "${SUITES[@]}"; do + if [ $first -eq 0 ]; then printf ',\n'; fi + printf ' "%s": {"pass": %d, "fail": %d}' "$s" "${SUITE_PASS[$s]}" "${SUITE_FAIL[$s]}" + first=0 + done + printf '\n },\n' + printf ' "total_pass": %d,\n' "$TOTAL_PASS" + printf ' "total_fail": %d,\n' "$TOTAL_FAIL" + printf ' "total": %d\n' "$((TOTAL_PASS + TOTAL_FAIL))" + printf '}\n' +} > "$OUT_JSON" + +# scoreboard.md +{ + printf '# persist Conformance Scoreboard\n\n' + printf '_Generated by `lib/persist/conformance.sh`_\n\n' + printf '| Suite | Pass | Fail | Total |\n' + printf '|-------|-----:|-----:|------:|\n' + for s in "${SUITES[@]}"; do + p=${SUITE_PASS[$s]} + f=${SUITE_FAIL[$s]} + printf '| %s | %d | %d | %d |\n' "$s" "$p" "$f" "$((p+f))" + done + printf '| **Total** | **%d** | **%d** | **%d** |\n' "$TOTAL_PASS" "$TOTAL_FAIL" "$((TOTAL_PASS + TOTAL_FAIL))" +} > "$OUT_MD" + +echo "Wrote $OUT_JSON and $OUT_MD" >&2 +echo "Total: $TOTAL_PASS pass, $TOTAL_FAIL fail" >&2 + +[ "$TOTAL_FAIL" -eq 0 ] diff --git a/lib/persist/event.sx b/lib/persist/event.sx new file mode 100644 index 00000000..fca37c5e --- /dev/null +++ b/lib/persist/event.sx @@ -0,0 +1,13 @@ +; persist/event — an event is the unit of the log facet: +; {:stream :seq :type :at :data} +; stream = which append-only stream, seq = 1-based position within it, +; type = event kind, at = caller-supplied timestamp (never a clock here: +; replay must stay pure), data = payload dict. + +(define persist/event (fn (stream seq type at data) {:data data :type type :at at :stream stream :seq seq})) + +(define persist/event-stream (fn (e) (get e :stream))) +(define persist/event-seq (fn (e) (get e :seq))) +(define persist/event-type (fn (e) (get e :type))) +(define persist/event-at (fn (e) (get e :at))) +(define persist/event-data (fn (e) (get e :data))) diff --git a/lib/persist/kv.sx b/lib/persist/kv.sx new file mode 100644 index 00000000..50d57167 --- /dev/null +++ b/lib/persist/kv.sx @@ -0,0 +1,26 @@ +; persist/kv — the kv facet: current-state values, no history. For things +; whose history does NOT matter (stock counts, config, profiles, session +; blobs) and where projections materialize their read models. +; Requires: lib/persist/backend.sx. + +(define persist/kv-get (fn (b key) (persist/backend-kv-get b key))) +(define + persist/kv-put + (fn (b key val) (begin (persist/backend-kv-put b key val) val))) +(define persist/kv-delete (fn (b key) (persist/backend-kv-delete b key))) +(define persist/kv-has? (fn (b key) (persist/backend-kv-has? b key))) +(define persist/kv-keys (fn (b) (persist/backend-kv-keys b))) + +; get with a default when the key is absent +(define + persist/kv-get-or + (fn + (b key dflt) + (if (persist/kv-has? b key) (persist/kv-get b key) dflt))) + +; read-modify-write: apply f to the current value (or dflt if absent), store result +(define + persist/kv-update + (fn + (b key dflt f) + (persist/kv-put b key (f (persist/kv-get-or b key dflt))))) diff --git a/lib/persist/log.sx b/lib/persist/log.sx new file mode 100644 index 00000000..46235f4c --- /dev/null +++ b/lib/persist/log.sx @@ -0,0 +1,37 @@ +; persist/log — the log facet: append-only event streams. seq is assigned +; sequentially per stream (1-based). Reads return events oldest-first. +; Requires: lib/persist/event.sx, lib/persist/backend.sx. + +; current length of a stream +(define + persist/stream-len + (fn (b stream) (len (persist/backend-read b stream)))) + +; last seq in a stream (0 if empty) +(define persist/last-seq (fn (b stream) (persist/stream-len b stream))) + +; append an event, auto-assigning the next seq. Returns the stored event. +(define + persist/append + (fn + (b stream type at data) + (let + ((seq (+ 1 (persist/last-seq b stream)))) + (let + ((ev (persist/event stream seq type at data))) + (begin (persist/backend-append b stream ev) ev))))) + +; read all events in a stream, oldest-first +(define persist/read (fn (b stream) (persist/backend-read b stream))) + +; read events with seq >= from +(define + persist/read-from + (fn + (b stream from) + (filter + (fn (e) (>= (persist/event-seq e) from)) + (persist/read b stream)))) + +; number of events in a stream +(define persist/count (fn (b stream) (persist/stream-len b stream))) diff --git a/lib/persist/scoreboard.json b/lib/persist/scoreboard.json new file mode 100644 index 00000000..0dfa26f3 --- /dev/null +++ b/lib/persist/scoreboard.json @@ -0,0 +1,10 @@ +{ + "suites": { + "event": {"pass": 6, "fail": 0}, + "log": {"pass": 9, "fail": 0}, + "kv": {"pass": 13, "fail": 0} + }, + "total_pass": 28, + "total_fail": 0, + "total": 28 +} diff --git a/lib/persist/scoreboard.md b/lib/persist/scoreboard.md new file mode 100644 index 00000000..bd60db39 --- /dev/null +++ b/lib/persist/scoreboard.md @@ -0,0 +1,10 @@ +# persist Conformance Scoreboard + +_Generated by `lib/persist/conformance.sh`_ + +| Suite | Pass | Fail | Total | +|-------|-----:|-----:|------:| +| event | 6 | 0 | 6 | +| log | 9 | 0 | 9 | +| kv | 13 | 0 | 13 | +| **Total** | **28** | **0** | **28** | diff --git a/lib/persist/tests/event.sx b/lib/persist/tests/event.sx new file mode 100644 index 00000000..7051e609 --- /dev/null +++ b/lib/persist/tests/event.sx @@ -0,0 +1,30 @@ +; Phase 1 — event record accessors. Uses the persist-test harness +; (persist-test name got expected) provided by conformance.sh. + +(persist-test + "event-stream" + (persist/event-stream + (persist/event "s" 1 "t" 0 {})) + "s") +(persist-test + "event-seq" + (persist/event-seq (persist/event "s" 3 "t" 0 {})) + 3) +(persist-test + "event-type" + (persist/event-type + (persist/event "s" 1 "create" 0 {})) + "create") +(persist-test + "event-at" + (persist/event-at (persist/event "s" 1 "t" 42 {})) + 42) +(persist-test + "event-data" + (persist/event-data + (persist/event "s" 1 "t" 0 {:x 9})) + {:x 9}) +(persist-test + "event is a dict with all fields" + (len (keys (persist/event "s" 1 "t" 0 {}))) + 5) diff --git a/lib/persist/tests/kv.sx b/lib/persist/tests/kv.sx new file mode 100644 index 00000000..6fbbc6fb --- /dev/null +++ b/lib/persist/tests/kv.sx @@ -0,0 +1,86 @@ +; Phase 1 — kv facet: get/put/delete/has?/keys, get-or, update. + +(persist-test "absent key reads nil" (persist/kv-get (persist/open) "x") nil) +(persist-test + "has? false when absent" + (persist/kv-has? (persist/open) "x") + false) +(persist-test + "put then get" + (let + ((b (persist/open))) + (begin (persist/kv-put b "x" 7) (persist/kv-get b "x"))) + 7) +(persist-test + "put returns value" + (let ((b (persist/open))) (persist/kv-put b "x" 9)) + 9) +(persist-test + "has? true after put" + (let + ((b (persist/open))) + (begin (persist/kv-put b "x" 1) (persist/kv-has? b "x"))) + true) +(persist-test + "put overwrites" + (let + ((b (persist/open))) + (begin + (persist/kv-put b "x" 1) + (persist/kv-put b "x" 2) + (persist/kv-get b "x"))) + 2) +(persist-test + "delete removes key" + (let + ((b (persist/open))) + (begin + (persist/kv-put b "x" 1) + (persist/kv-delete b "x") + (persist/kv-has? b "x"))) + false) +(persist-test + "delete then get is nil" + (let + ((b (persist/open))) + (begin + (persist/kv-put b "x" 1) + (persist/kv-delete b "x") + (persist/kv-get b "x"))) + nil) +(persist-test + "keys lists stored keys" + (let + ((b (persist/open))) + (begin + (persist/kv-put b "a" 1) + (persist/kv-put b "b" 2) + (len (persist/kv-keys b)))) + 2) +(persist-test + "get-or returns default when absent" + (persist/kv-get-or (persist/open) "x" 99) + 99) +(persist-test + "get-or returns value when present" + (let + ((b (persist/open))) + (begin + (persist/kv-put b "x" 5) + (persist/kv-get-or b "x" 99))) + 5) +(persist-test + "kv-update applies fn over default" + (let + ((b (persist/open))) + (begin + (persist/kv-update b "n" 0 (fn (v) (+ v 1))) + (persist/kv-update b "n" 0 (fn (v) (+ v 1))) + (persist/kv-get b "n"))) + 2) +(persist-test + "kv facet does not touch log" + (let + ((b (persist/open))) + (begin (persist/kv-put b "x" 1) (persist/count b "x"))) + 0) diff --git a/lib/persist/tests/log.sx b/lib/persist/tests/log.sx new file mode 100644 index 00000000..ee207c1a --- /dev/null +++ b/lib/persist/tests/log.sx @@ -0,0 +1,81 @@ +; Phase 1 — log facet: append/read/read-from, sequential seq, stream isolation. +; Note: map returns an array-backed list not equal? to a (list ...) literal, +; so assertions build their compared list with list/nth, not map. + +(persist-test + "empty stream reads empty" + (len (persist/read (persist/open) "orders")) + 0) +(persist-test + "last-seq empty is 0" + (persist/last-seq (persist/open) "orders") + 0) +(persist-test + "append returns event with seq 1" + (persist/event-seq + (persist/append (persist/open) "orders" "placed" 0 {:id 1})) + 1) +(persist-test + "append assigns sequential seqs" + (let + ((b (persist/open))) + (begin + (persist/append b "orders" "placed" 0 {}) + (persist/append b "orders" "placed" 1 {}) + (persist/event-seq + (persist/append b "orders" "placed" 2 {})))) + 3) +(persist-test + "read returns events oldest-first" + (let + ((b (persist/open))) + (begin + (persist/append b "s" "a" 0 {:n 1}) + (persist/append b "s" "b" 0 {:n 2}) + (let + ((es (persist/read b "s"))) + (list + (get (persist/event-data (nth es 0)) :n) + (get (persist/event-data (nth es 1)) :n))))) + (list 1 2)) +(persist-test + "count tracks appends" + (let + ((b (persist/open))) + (begin + (persist/append b "s" "a" 0 {}) + (persist/append b "s" "a" 0 {}) + (persist/count b "s"))) + 2) +(persist-test + "streams are isolated" + (let + ((b (persist/open))) + (begin + (persist/append b "s1" "a" 0 {}) + (persist/append b "s2" "a" 0 {}) + (persist/append b "s2" "a" 0 {}) + (list (persist/count b "s1") (persist/count b "s2")))) + (list 1 2)) +(persist-test + "read-from filters by seq" + (let + ((b (persist/open))) + (begin + (persist/append b "s" "a" 0 {}) + (persist/append b "s" "a" 0 {}) + (persist/append b "s" "a" 0 {}) + (let + ((es (persist/read-from b "s" 2))) + (list + (persist/event-seq (nth es 0)) + (persist/event-seq (nth es 1)))))) + (list 2 3)) +(persist-test + "read-from past end is empty" + (let + ((b (persist/open))) + (begin + (persist/append b "s" "a" 0 {}) + (len (persist/read-from b "s" 5)))) + 0) diff --git a/plans/persist-on-sx.md b/plans/persist-on-sx.md index 53c2b0dd..8d316de2 100644 --- a/plans/persist-on-sx.md +++ b/plans/persist-on-sx.md @@ -42,7 +42,7 @@ read models (feeds, indices, audit logs) update incrementally. ## Status (rolling) -`bash lib/persist/conformance.sh` → **0/0** (not yet started) +`bash lib/persist/conformance.sh` → **28/28** (Phase 1 done) ## Ground rules @@ -87,11 +87,11 @@ lib/persist/backend.sx lib/persist/api.sx ``` ## Phase 1 — Log + kv + in-memory backend -- [ ] `event.sx` — event record, stream/seq helpers -- [ ] `backend.sx` — injectable protocol + in-memory impl (log + kv) -- [ ] `log.sx` — `append` (optimistic seq), `read`, `read-from` -- [ ] `kv.sx` — `get`/`put`/`delete` current-state -- [ ] `api.sx` + tests + scoreboard + conformance.sh +- [x] `event.sx` — event record, stream/seq helpers +- [x] `backend.sx` — injectable protocol + in-memory impl (log + kv) +- [x] `log.sx` — `append` (optimistic seq), `read`, `read-from` +- [x] `kv.sx` — `get`/`put`/`delete` current-state +- [x] `api.sx` + tests + scoreboard + conformance.sh ## Phase 2 — Projections + subscriptions - [ ] `project.sx` — `(project stream step seed)`, incremental fold @@ -113,7 +113,19 @@ feed/-log, flow store, mod/audit, search index, acl grants, identity sessions al become `persist` log or kv. Track each migration in that subsystem's plan. ## Progress log -(loop fills this in) +- **Phase 1 complete (28/28).** `event.sx` (event record + accessors), + `backend.sx` (injectable protocol + in-memory log/kv impl, closure state via + set!), `log.sx` (append/read/read-from, sequential per-stream seq, stream + isolation), `kv.sx` (get/put/delete/has?/keys/get-or/update), `api.sx` + (`persist/open` — mem default, backend injectable). conformance.sh + three + suites (event/log/kv). Gotcha logged in Blockers: `map` returns an + array-backed list not `equal?` to a `(list ...)` literal — assertions build + compared lists with list/nth. ## Blockers -(loop fills this in) +- **Not a blocker, a testing convention:** `map` returns an array-backed list + that is NOT `equal?` to a `(list ...)` cons-literal (two `map` results do + compare equal to each other). When asserting list-shaped results against a + `(list ...)` literal, build the compared value with `list`/`nth`/`cons`, not + `map`. `into`/list-coercion needs the IO bridge and is unusable in the + pure-eval harness.