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:
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)
|
||||
Reference in New Issue
Block a user