persist: durable backend over the perform IO boundary + 15 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
durable.sx: io-backend with an injectable transport — persist/durable-backend
performs each op as {:op "persist/..." :args (...)} (kernel suspends, host
resumes); persist/mock-durable services via persist/serve over an in-memory
disk. Identical request shapes mean the whole facet/projection/snapshot/
compaction stack runs unchanged on the durable backend. Crash/restart replay
recovers log+kv+snapshot. 91/91.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then
|
||||
exit 1
|
||||
fi
|
||||
|
||||
SUITES=(event log kv project subscribe concurrency snapshot compaction)
|
||||
SUITES=(event log kv project subscribe concurrency snapshot compaction durable)
|
||||
|
||||
OUT_JSON="lib/persist/scoreboard.json"
|
||||
OUT_MD="lib/persist/scoreboard.md"
|
||||
@@ -35,6 +35,7 @@ run_suite() {
|
||||
(load "lib/persist/concurrency.sx")
|
||||
(load "lib/persist/snapshot.sx")
|
||||
(load "lib/persist/compaction.sx")
|
||||
(load "lib/persist/durable.sx")
|
||||
(load "lib/persist/subscribe.sx")
|
||||
(load "lib/persist/api.sx")
|
||||
(epoch 2)
|
||||
|
||||
69
lib/persist/durable.sx
Normal file
69
lib/persist/durable.sx
Normal file
@@ -0,0 +1,69 @@
|
||||
; persist/durable — a backend whose every op crosses the kernel's IO-suspension
|
||||
; boundary. Each op performs an IO request {:op "persist/..." :args (...)};
|
||||
; under the real kernel `perform` suspends the CEK machine and the host (file,
|
||||
; pg, ipfs-ref) services the request and resumes with the result — so the facet
|
||||
; code above (log/kv/project/snapshot/compaction) never changes. The TRANSPORT
|
||||
; is injectable: production passes the kernel's perform; tests pass a mock
|
||||
; servicer over an in-memory disk. Same request shapes either way, so the whole
|
||||
; existing facet stack runs unchanged on the mock-durable backend.
|
||||
; Requires: lib/persist/backend.sx.
|
||||
|
||||
; request encoders — the exact payloads the durable backend performs
|
||||
(define persist/req-append (fn (stream event) {:op "persist/append" :args (list stream event)}))
|
||||
(define persist/req-read (fn (stream) {:op "persist/read" :args (list stream)}))
|
||||
(define persist/req-last-seq (fn (stream) {:op "persist/last-seq" :args (list stream)}))
|
||||
(define persist/req-truncate (fn (stream n) {:op "persist/truncate" :args (list stream n)}))
|
||||
(define persist/req-kv-get (fn (key) {:op "persist/kv-get" :args (list key)}))
|
||||
(define persist/req-kv-put (fn (key val) {:op "persist/kv-put" :args (list key val)}))
|
||||
(define persist/req-kv-delete (fn (key) {:op "persist/kv-delete" :args (list key)}))
|
||||
(define persist/req-kv-has? (fn (key) {:op "persist/kv-has?" :args (list key)}))
|
||||
(define persist/req-kv-keys (fn () {:op "persist/kv-keys" :args (list)}))
|
||||
|
||||
; a backend parameterized over a transport (req -> response)
|
||||
(define persist/io-backend (fn (transport) {:truncate-through (fn (stream n) (transport (persist/req-truncate stream n))) :kv-keys (fn () (transport (persist/req-kv-keys))) :read (fn (stream) (transport (persist/req-read stream))) :kv-has? (fn (key) (transport (persist/req-kv-has? key))) :last-seq (fn (stream) (transport (persist/req-last-seq stream))) :append (fn (stream event) (transport (persist/req-append stream event))) :kv-delete (fn (key) (transport (persist/req-kv-delete key))) :kv-put (fn (key val) (transport (persist/req-kv-put key val))) :kv-get (fn (key) (transport (persist/req-kv-get key)))}))
|
||||
|
||||
; production backend — transport is the kernel's perform (suspends; host resumes)
|
||||
(define
|
||||
persist/durable-backend
|
||||
(fn () (persist/io-backend (fn (req) (perform req)))))
|
||||
|
||||
; reference host: service one request against a disk (any backend protocol impl).
|
||||
; This is what a real host plugs into the kernel's IO resolver, and the mock-IO
|
||||
; harness for tests: it never touches a real disk, just an in-memory backend.
|
||||
(define
|
||||
persist/serve
|
||||
(fn
|
||||
(disk req)
|
||||
(let
|
||||
((op (get req :op)) (args (get req :args)))
|
||||
(cond
|
||||
((equal? op "persist/append")
|
||||
(persist/backend-append disk (first args) (nth args 1)))
|
||||
((equal? op "persist/read")
|
||||
(persist/backend-read disk (first args)))
|
||||
((equal? op "persist/last-seq")
|
||||
(persist/backend-last-seq disk (first args)))
|
||||
((equal? op "persist/truncate")
|
||||
(persist/backend-truncate disk (first args) (nth args 1)))
|
||||
((equal? op "persist/kv-get")
|
||||
(persist/backend-kv-get disk (first args)))
|
||||
((equal? op "persist/kv-put")
|
||||
(persist/backend-kv-put disk (first args) (nth args 1)))
|
||||
((equal? op "persist/kv-delete")
|
||||
(persist/backend-kv-delete disk (first args)))
|
||||
((equal? op "persist/kv-has?")
|
||||
(persist/backend-kv-has? disk (first args)))
|
||||
((equal? op "persist/kv-keys") (persist/backend-kv-keys disk))
|
||||
(else (error (str "persist/serve: unknown op " op)))))))
|
||||
|
||||
; mock transport: a perform-replacement that services against a disk in-process
|
||||
(define
|
||||
persist/mock-transport
|
||||
(fn (disk) (fn (req) (persist/serve disk req))))
|
||||
|
||||
; a durable backend wired to a mock disk — exercises the full io-backend path
|
||||
; (request-encode -> serve -> disk) with no suspension, so the existing facet
|
||||
; suite runs against it unchanged.
|
||||
(define
|
||||
persist/mock-durable
|
||||
(fn (disk) (persist/io-backend (persist/mock-transport disk))))
|
||||
@@ -7,9 +7,10 @@
|
||||
"subscribe": {"pass": 9, "fail": 0},
|
||||
"concurrency": {"pass": 8, "fail": 0},
|
||||
"snapshot": {"pass": 11, "fail": 0},
|
||||
"compaction": {"pass": 11, "fail": 0}
|
||||
"compaction": {"pass": 11, "fail": 0},
|
||||
"durable": {"pass": 15, "fail": 0}
|
||||
},
|
||||
"total_pass": 76,
|
||||
"total_pass": 91,
|
||||
"total_fail": 0,
|
||||
"total": 76
|
||||
"total": 91
|
||||
}
|
||||
|
||||
@@ -12,4 +12,5 @@ _Generated by `lib/persist/conformance.sh`_
|
||||
| concurrency | 8 | 0 | 8 |
|
||||
| snapshot | 11 | 0 | 11 |
|
||||
| compaction | 11 | 0 | 11 |
|
||||
| **Total** | **76** | **0** | **76** |
|
||||
| durable | 15 | 0 | 15 |
|
||||
| **Total** | **91** | **0** | **91** |
|
||||
|
||||
163
lib/persist/tests/durable.sx
Normal file
163
lib/persist/tests/durable.sx
Normal file
@@ -0,0 +1,163 @@
|
||||
; Phase 4 — durable backend over the IO-suspension boundary, tested with a mock
|
||||
; transport (the mock-IO harness for the durable protocol). The whole facet
|
||||
; stack must run unchanged on mock-durable, and a "crash/restart" (drop the
|
||||
; backend, keep the disk) must recover state by replay.
|
||||
|
||||
(define dur-count (fn (acc e) (+ acc 1)))
|
||||
|
||||
; ---------- request encoders ----------
|
||||
(persist-test
|
||||
"req-append encodes op + args"
|
||||
(persist/req-append "s" {:k 1})
|
||||
{:op "persist/append" :args (list "s" {:k 1})})
|
||||
(persist-test
|
||||
"req-kv-put encodes op + args"
|
||||
(persist/req-kv-put "k" 7)
|
||||
{:op "persist/kv-put" :args (list "k" 7)})
|
||||
|
||||
; ---------- serve round-trips against a disk ----------
|
||||
(persist-test
|
||||
"serve append then serve read"
|
||||
(let
|
||||
((disk (persist/mem-backend)))
|
||||
(begin
|
||||
(persist/serve
|
||||
disk
|
||||
(persist/req-append
|
||||
"s"
|
||||
(persist/event "s" 1 "x" 0 {:n 1})))
|
||||
(get
|
||||
(persist/event-data
|
||||
(first (persist/serve disk (persist/req-read "s"))))
|
||||
:n)))
|
||||
1)
|
||||
(persist-test
|
||||
"serve kv-put then kv-get"
|
||||
(let
|
||||
((disk (persist/mem-backend)))
|
||||
(begin
|
||||
(persist/serve disk (persist/req-kv-put "k" 42))
|
||||
(persist/serve disk (persist/req-kv-get "k"))))
|
||||
42)
|
||||
(persist-test
|
||||
"serve unknown op is a clear error"
|
||||
(let
|
||||
((disk (persist/mem-backend)))
|
||||
(guard (e (true "errored")) (persist/serve disk {:op "persist/bogus" :args (list)})))
|
||||
"errored")
|
||||
|
||||
; ---------- full facet stack on mock-durable ----------
|
||||
(persist-test
|
||||
"log facet works on mock-durable"
|
||||
(let
|
||||
((db (persist/mock-durable (persist/mem-backend))))
|
||||
(begin
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/count db "s")))
|
||||
2)
|
||||
(persist-test
|
||||
"seq assignment works on mock-durable"
|
||||
(let
|
||||
((db (persist/mock-durable (persist/mem-backend))))
|
||||
(begin
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/event-seq (persist/append db "s" "x" 0 {}))))
|
||||
2)
|
||||
(persist-test
|
||||
"kv facet works on mock-durable"
|
||||
(let
|
||||
((db (persist/mock-durable (persist/mem-backend))))
|
||||
(begin (persist/kv-put db "k" 5) (persist/kv-get db "k")))
|
||||
5)
|
||||
(persist-test
|
||||
"projection works on mock-durable"
|
||||
(let
|
||||
((db (persist/mock-durable (persist/mem-backend))))
|
||||
(begin
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/project-fold db "s" dur-count 0)))
|
||||
3)
|
||||
(persist-test
|
||||
"snapshot + replay work on mock-durable"
|
||||
(let
|
||||
((db (persist/mock-durable (persist/mem-backend))))
|
||||
(begin
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/checkpoint db "s" "snap" dur-count 0)
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/project-value
|
||||
(persist/replay db "s" "snap" dur-count 0))))
|
||||
3)
|
||||
(persist-test
|
||||
"compaction works on mock-durable"
|
||||
(let
|
||||
((db (persist/mock-durable (persist/mem-backend))))
|
||||
(begin
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/compact db "s" "snap" dur-count 0)
|
||||
(list (persist/count db "s") (persist/last-seq db "s"))))
|
||||
(list 0 2))
|
||||
|
||||
; ---------- crash / restart replay ----------
|
||||
(persist-test
|
||||
"restart recovers log state from the disk"
|
||||
(let
|
||||
((disk (persist/mem-backend)))
|
||||
(begin
|
||||
(let
|
||||
((db (persist/mock-durable disk)))
|
||||
(begin
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/append db "s" "x" 0 {})))
|
||||
(let
|
||||
((db2 (persist/mock-durable disk)))
|
||||
(persist/project-fold db2 "s" dur-count 0))))
|
||||
2)
|
||||
(persist-test
|
||||
"restart continues the seq counter"
|
||||
(let
|
||||
((disk (persist/mem-backend)))
|
||||
(begin
|
||||
(let
|
||||
((db (persist/mock-durable disk)))
|
||||
(begin
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/append db "s" "x" 0 {})))
|
||||
(let
|
||||
((db2 (persist/mock-durable disk)))
|
||||
(persist/event-seq (persist/append db2 "s" "x" 0 {})))))
|
||||
3)
|
||||
(persist-test
|
||||
"restart recovers a kv value"
|
||||
(let
|
||||
((disk (persist/mem-backend)))
|
||||
(begin
|
||||
(let
|
||||
((db (persist/mock-durable disk)))
|
||||
(persist/kv-put db "cfg" "on"))
|
||||
(let ((db2 (persist/mock-durable disk))) (persist/kv-get db2 "cfg"))))
|
||||
"on")
|
||||
(persist-test
|
||||
"restart from snapshot equals full replay"
|
||||
(let
|
||||
((disk (persist/mem-backend)))
|
||||
(begin
|
||||
(let
|
||||
((db (persist/mock-durable disk)))
|
||||
(begin
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/append db "s" "x" 0 {})
|
||||
(persist/checkpoint db "s" "snap" dur-count 0)
|
||||
(persist/append db "s" "x" 0 {})))
|
||||
(let
|
||||
((db2 (persist/mock-durable disk)))
|
||||
(equal?
|
||||
(persist/project-value
|
||||
(persist/replay db2 "s" "snap" dur-count 0))
|
||||
(persist/project-fold db2 "s" dur-count 0)))))
|
||||
true)
|
||||
@@ -42,7 +42,7 @@ read models (feeds, indices, audit logs) update incrementally.
|
||||
|
||||
## Status (rolling)
|
||||
|
||||
`bash lib/persist/conformance.sh` → **76/76** (Phases 1–3 done)
|
||||
`bash lib/persist/conformance.sh` → **91/91** (Phases 1–3 done, Phase 4 in progress)
|
||||
|
||||
## Ground rules
|
||||
|
||||
@@ -103,7 +103,7 @@ lib/persist/backend.sx lib/persist/api.sx
|
||||
- [x] compaction policy; replay-determinism tests
|
||||
|
||||
## Phase 4 — Durable backends via kernel IO
|
||||
- [ ] file/log backend driven through `perform` (IO-suspension boundary)
|
||||
- [x] file/log backend driven through `perform` (IO-suspension boundary)
|
||||
- [ ] blob backend interface (store ref/CID; bytes live in artdag/IPFS)
|
||||
- [ ] crash/restart replay test (mock IO platform)
|
||||
- [ ] migration notes for swapping mem → durable under a live subsystem
|
||||
@@ -113,6 +113,16 @@ 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
|
||||
- **Phase 4a (91/91).** `durable.sx` — a backend whose every op crosses the
|
||||
kernel IO boundary via `(perform {:op "persist/..." :args (...)})`. The
|
||||
transport is injectable: `persist/durable-backend` uses the kernel's
|
||||
`perform` (suspends; host resumes); `persist/mock-durable` uses
|
||||
`persist/serve` over an in-memory disk. `persist/serve` is the reference host
|
||||
+ the mock-IO harness. Because the request shapes are identical, the ENTIRE
|
||||
facet stack (log/kv/project/snapshot/compaction) runs unchanged on
|
||||
mock-durable — verified. Crash/restart (drop backend, keep disk) recovers log
|
||||
+ kv + snapshot by replay; seq counter continues. 15 tests. See Blockers for
|
||||
why end-to-end perform suspension isn't exercised under sx_server.exe.
|
||||
- **Phase 3b (76/76) — Phase 3 complete.** Backend refactor: `last-seq` is now
|
||||
a monotonic per-stream high-water mark (backend `seqs` dict), not physical
|
||||
length, so a compacted log keeps assigning climbing seqs. Added backend
|
||||
@@ -152,6 +162,17 @@ become `persist` log or kv. Track each migration in that subsystem's plan.
|
||||
compared lists with list/nth.
|
||||
|
||||
## Blockers
|
||||
- **Phase 4 perform-suspension not exercised end-to-end under sx_server.exe (by
|
||||
design, not a bug).** The CEK suspension primitives (`cek-step-loop`,
|
||||
`cek-resume`, `cek-suspended?`, `cek-io-request`) and a settable SX-level IO
|
||||
hook are only bound by the `run_tests` OCaml binary (out of scope: hosts/, and
|
||||
sx_build is forbidden). Under `sx_server.exe`, an unhandled `perform` resolves
|
||||
through the OCaml io-request/io-response stdin bridge (production path) — not
|
||||
callable from the pure-eval conformance harness. Resolution: the durable
|
||||
backend's transport is injectable, so the production path is one line
|
||||
`(perform req)` (kernel-handled) and ALL durable logic is tested through the
|
||||
mock transport (`persist/serve` over an in-memory disk). The single untested
|
||||
line is the kernel primitive itself. No host primitive needed; nothing to fix.
|
||||
- **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
|
||||
|
||||
Reference in New Issue
Block a user