diff --git a/lib/persist/conformance.sh b/lib/persist/conformance.sh index 1ce9c1e3..50c502c8 100755 --- a/lib/persist/conformance.sh +++ b/lib/persist/conformance.sh @@ -13,7 +13,7 @@ if [ ! -x "$SX_SERVER" ]; then exit 1 fi -SUITES=(event log kv project subscribe concurrency snapshot compaction durable blob view recovery) +SUITES=(event log kv project subscribe concurrency snapshot compaction durable blob view cas recovery) OUT_JSON="lib/persist/scoreboard.json" OUT_MD="lib/persist/scoreboard.md" diff --git a/lib/persist/kv.sx b/lib/persist/kv.sx index 50d57167..e85483cf 100644 --- a/lib/persist/kv.sx +++ b/lib/persist/kv.sx @@ -24,3 +24,21 @@ (fn (b key dflt f) (persist/kv-put b key (f (persist/kv-get-or b key dflt))))) + +; compare-and-swap: set key to new ONLY if its current value equals expected. +; Returns new on success, or a conflict value {:conflict true :expected :actual} +; the caller can re-read and retry on. The kv analogue of log append-expect. +(define + persist/kv-cas + (fn + (b key expected new) + (let + ((actual (persist/kv-get b key))) + (if (equal? actual expected) (persist/kv-put b key new) {:actual actual :expected expected :conflict true})))) + +; create-only: put a value only if the key is absent; conflict if it exists +(define + persist/kv-put-new + (fn + (b key val) + (if (persist/kv-has? b key) {:actual (persist/kv-get b key) :conflict true :reason "exists"} (persist/kv-put b key val)))) diff --git a/lib/persist/scoreboard.json b/lib/persist/scoreboard.json index 4c3650f0..25e612b6 100644 --- a/lib/persist/scoreboard.json +++ b/lib/persist/scoreboard.json @@ -11,9 +11,10 @@ "durable": {"pass": 15, "fail": 0}, "blob": {"pass": 14, "fail": 0}, "view": {"pass": 11, "fail": 0}, + "cas": {"pass": 11, "fail": 0}, "recovery": {"pass": 6, "fail": 0} }, - "total_pass": 122, + "total_pass": 133, "total_fail": 0, - "total": 122 + "total": 133 } diff --git a/lib/persist/scoreboard.md b/lib/persist/scoreboard.md index 41ad6a35..b4bfb284 100644 --- a/lib/persist/scoreboard.md +++ b/lib/persist/scoreboard.md @@ -15,5 +15,6 @@ _Generated by `lib/persist/conformance.sh`_ | durable | 15 | 0 | 15 | | blob | 14 | 0 | 14 | | view | 11 | 0 | 11 | +| cas | 11 | 0 | 11 | | recovery | 6 | 0 | 6 | -| **Total** | **122** | **0** | **122** | +| **Total** | **133** | **0** | **133** | diff --git a/lib/persist/tests/cas.sx b/lib/persist/tests/cas.sx new file mode 100644 index 00000000..130584ea --- /dev/null +++ b/lib/persist/tests/cas.sx @@ -0,0 +1,96 @@ +; Extension — kv compare-and-swap: atomic current-state updates. Uses +; persist/conflict? from concurrency.sx. + +(persist-test + "cas on absent key with nil expected succeeds" + (let ((b (persist/open))) (persist/kv-cas b "k" nil 1)) + 1) +(persist-test + "cas with matching expected succeeds" + (let + ((b (persist/open))) + (begin + (persist/kv-put b "k" 5) + (persist/kv-cas b "k" 5 6) + (persist/kv-get b "k"))) + 6) +(persist-test + "cas with stale expected returns a conflict" + (let + ((b (persist/open))) + (begin + (persist/kv-put b "k" 5) + (persist/conflict? (persist/kv-cas b "k" 4 6)))) + true) +(persist-test + "a conflicting cas does not write" + (let + ((b (persist/open))) + (begin + (persist/kv-put b "k" 5) + (persist/kv-cas b "k" 4 6) + (persist/kv-get b "k"))) + 5) +(persist-test + "cas conflict carries expected and actual" + (let + ((b (persist/open))) + (begin + (persist/kv-put b "k" 5) + (let + ((r (persist/kv-cas b "k" 4 6))) + (list (persist/conflict-expected r) (persist/conflict-actual r))))) + (list 4 5)) +(persist-test + "two cas racers: first wins, second conflicts" + (let + ((b (persist/open))) + (begin + (persist/kv-put b "stock" 10) + (persist/kv-cas b "stock" 10 9) + (persist/conflict? (persist/kv-cas b "stock" 10 9)))) + true) +(persist-test + "retry after cas conflict succeeds" + (let + ((b (persist/open))) + (begin + (persist/kv-put b "stock" 10) + (persist/kv-cas b "stock" 10 9) + (let + ((r (persist/kv-cas b "stock" 10 9))) + (if + (persist/conflict? r) + (persist/kv-cas b "stock" (persist/conflict-actual r) 8) + r)))) + 8) +(persist-test + "put-new on absent key succeeds" + (let ((b (persist/open))) (persist/kv-put-new b "k" 1)) + 1) +(persist-test + "put-new on existing key conflicts" + (let + ((b (persist/open))) + (begin + (persist/kv-put b "k" 1) + (persist/conflict? (persist/kv-put-new b "k" 2)))) + true) +(persist-test + "put-new does not overwrite" + (let + ((b (persist/open))) + (begin + (persist/kv-put b "k" 1) + (persist/kv-put-new b "k" 2) + (persist/kv-get b "k"))) + 1) +(persist-test + "cas works on the durable backend" + (let + ((db (persist/mock-durable (persist/mem-backend)))) + (begin + (persist/kv-put db "k" 1) + (persist/kv-cas db "k" 1 2) + (persist/kv-get db "k"))) + 2) diff --git a/plans/persist-on-sx.md b/plans/persist-on-sx.md index 8ebb7427..13a288a8 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` → **122/122** (Phases 1–4 complete + extensions) +`bash lib/persist/conformance.sh` → **133/133** (Phases 1–4 complete + extensions) ## Ground rules @@ -150,11 +150,20 @@ over an in-process disk (the mock-IO harness). O(1) read. The consumer-facing read-model abstraction (feed indices, audit rollups, search counters). +- [x] `kv.sx` CAS — `persist/kv-cas` (compare-and-swap) + `persist/kv-put-new` + (create-only): atomic current-state updates, conflict as a real value (kv + analogue of log `append-expect`). For sessions, acl grants, stock counts. + ## Consumers (post-foundation, not in scope here) feed/-log, flow store, mod/audit, search index, acl grants, identity sessions all become `persist` log or kv. Track each migration in that subsystem's plan. ## Progress log +- **Ext: kv compare-and-swap (133/133).** `persist/kv-cas` sets a key only if + its current value equals expected, else returns `{:conflict :expected + :actual}`; `persist/kv-put-new` is create-only. The kv analogue of log + `append-expect` — atomic current-state for sessions/acl/stock. 11 tests incl. + racer + retry + durable backend. - **Ext: materialized views (122/122).** `view.sx` — `persist/view` bundles stream + step + seed + snapshot name; `view-attach` subscribes it to a hub so every publish refreshes the snapshot incrementally; `view-peek` is then an