From 80a2dee22fbadbd26de82a2db50a67c4bcf4ce8f Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 01:44:43 +0000 Subject: [PATCH] events: capacity-safe transactional booking on persist + 24 tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit booking.sx: per-occurrence append-only stream, roster = replay. Booking decided against an observed (roster, last-seq) snapshot, committed via persist/append-expect — atomic check+append, no overbooking, no lock. Explicit last-seat race test: two bookers, one booked, one conflict, roster capped. Idempotent per actor. 97/97 green. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/events/booking.sx | 101 ++++++++++++++++++++ lib/events/conformance.conf | 10 ++ lib/events/scoreboard.json | 9 +- lib/events/scoreboard.md | 3 +- lib/events/tests/booking.sx | 180 ++++++++++++++++++++++++++++++++++++ plans/events-on-sx.md | 18 +++- 6 files changed, 313 insertions(+), 8 deletions(-) create mode 100644 lib/events/booking.sx create mode 100644 lib/events/tests/booking.sx diff --git a/lib/events/booking.sx b/lib/events/booking.sx new file mode 100644 index 00000000..ece9b0c4 --- /dev/null +++ b/lib/events/booking.sx @@ -0,0 +1,101 @@ +;; lib/events/booking.sx — transactional, capacity-safe booking on persist. +;; +;; Each bookable occurrence has an append-only booking stream. A booking is an +;; event in that stream; the roster is the stream replayed. Capacity safety is +;; the contract: two bookers racing for the last seat must NEVER both succeed. +;; The guarantee is delegated to persist's optimistic concurrency — +;; `persist/append-expect` appends only if the stream's last-seq still equals +;; what the booker observed; otherwise it returns a conflict value and the +;; booker retries against the advanced roster. So the capacity check + append +;; are atomic at the persist boundary, with no overbooking and no lock. +;; +;; A booking decision is made against an OBSERVED snapshot (roster + last-seq): +;; two concurrent bookers each see the same free seat, both attempt, and +;; append-expect lets exactly one win — the loser gets a conflict it retries. + +(define ev-booking-stream (fn (occ-key) (str "booking:" occ-key))) + +(define + ev-bk-member? + (fn + (x xs) + (cond + ((empty? xs) false) + ((= x (first xs)) true) + (else (ev-bk-member? x (rest xs)))))) + +(define + ev-bk-index + (fn + (xs x i) + (cond + ((empty? xs) -1) + ((= (first xs) x) i) + (else (ev-bk-index (rest xs) x (+ i 1)))))) + +;; Booked actors for an occurrence, oldest first. +(define + ev-booked-actors + (fn + (b occ-key) + (map + (fn (e) (get (persist/event-data e) :actor)) + (persist/read b (ev-booking-stream occ-key))))) + +(define + ev-actor-booked? + (fn (b occ-key actor) (ev-bk-member? actor (ev-booked-actors b occ-key)))) + +(define + ev-booking-count + (fn (b occ-key) (persist/count b (ev-booking-stream occ-key)))) + +;; 1-based seat number for an actor on the roster (0 if not booked). +(define + ev-seat-of + (fn + (actors actor) + (let + ((i (ev-bk-index actors actor 0))) + (if (< i 0) 0 (+ i 1))))) + +;; One booking attempt decided against an OBSERVED snapshot: `observed-actors` +;; (the roster the booker saw) and `expected` (the last-seq it saw). Returns +;; :already / :full / :booked / :conflict. :conflict means a concurrent append +;; landed since the snapshot — the caller must re-observe and retry. +(define + ev/book-with-observed + (fn + (b occ-key capacity actor observed-actors expected) + (cond + ((ev-bk-member? actor observed-actors) {:seat (ev-seat-of observed-actors actor) :actor actor :status :already}) + ((>= (len observed-actors) capacity) {:actor actor :capacity capacity :status :full}) + (else + (let + ((r (persist/append-expect b (ev-booking-stream occ-key) expected :booking 0 {:actor actor}))) + (if (persist/conflict? r) {:actual (persist/conflict-actual r) :actor actor :status :conflict} {:seat (+ (len observed-actors) 1) :actor actor :status :booked})))))) + +;; Capacity-safe booking with retry. Observes a consistent (roster, last-seq) +;; snapshot, attempts, and retries on conflict (a concurrent booker won the +;; race) — bounded by capacity, since each successful append moves the roster +;; one seat toward full. +(define + ev/book! + (fn + (b occ-key capacity actor) + (let + ((res (ev/book-with-observed b occ-key capacity actor (ev-booked-actors b occ-key) (persist/last-seq b (ev-booking-stream occ-key))))) + (if + (= (get res :status) :conflict) + (ev/book! b occ-key capacity actor) + res)))) + +;; The roster as a plain list of actors (oldest first). +(define ev/roster (fn (b occ-key) (ev-booked-actors b occ-key))) + +;; Seats remaining for an occurrence of the given capacity. +(define + ev/seats-left + (fn + (b occ-key capacity) + (max 0 (- capacity (ev-booking-count b occ-key))))) diff --git a/lib/events/conformance.conf b/lib/events/conformance.conf index addc4154..3810fac1 100644 --- a/lib/events/conformance.conf +++ b/lib/events/conformance.conf @@ -5,6 +5,8 @@ MODE=dict SCOREBOARD_DIR=lib/events PRELOADS=( + spec/stdlib.sx + lib/r7rs.sx lib/datalog/tokenizer.sx lib/datalog/parser.sx lib/datalog/unify.sx @@ -18,10 +20,18 @@ PRELOADS=( lib/events/calendar.sx lib/events/availability.sx lib/events/api.sx + lib/persist/event.sx + lib/persist/backend.sx + lib/persist/log.sx + lib/persist/kv.sx + lib/persist/concurrency.sx + lib/persist/api.sx + lib/events/booking.sx ) SUITES=( "calendar:lib/events/tests/calendar.sx:(ev-calendar-tests-run!)" "availability:lib/events/tests/availability.sx:(ev-availability-tests-run!)" "api:lib/events/tests/api.sx:(ev-api-tests-run!)" + "booking:lib/events/tests/booking.sx:(ev-booking-tests-run!)" ) diff --git a/lib/events/scoreboard.json b/lib/events/scoreboard.json index 730a19ab..744e326e 100644 --- a/lib/events/scoreboard.json +++ b/lib/events/scoreboard.json @@ -1,12 +1,13 @@ { "lang": "events", - "total_passed": 73, + "total_passed": 97, "total_failed": 0, - "total": 73, + "total": 97, "suites": [ {"name":"calendar","passed":37,"failed":0,"total":37}, {"name":"availability","passed":22,"failed":0,"total":22}, - {"name":"api","passed":14,"failed":0,"total":14} + {"name":"api","passed":14,"failed":0,"total":14}, + {"name":"booking","passed":24,"failed":0,"total":24} ], - "generated": "2026-06-07T01:15:49+00:00" + "generated": "2026-06-07T01:44:19+00:00" } diff --git a/lib/events/scoreboard.md b/lib/events/scoreboard.md index 264cca74..74b381fb 100644 --- a/lib/events/scoreboard.md +++ b/lib/events/scoreboard.md @@ -1,9 +1,10 @@ # events scoreboard -**73 / 73 passing** (0 failure(s)). +**97 / 97 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| | calendar | 37 | 37 | ok | | availability | 22 | 22 | ok | | api | 14 | 14 | ok | +| booking | 24 | 24 | ok | diff --git a/lib/events/tests/booking.sx b/lib/events/tests/booking.sx new file mode 100644 index 00000000..e030f04d --- /dev/null +++ b/lib/events/tests/booking.sx @@ -0,0 +1,180 @@ +;; lib/events/tests/booking.sx — capacity-safe transactional booking. + +(define ev-bk-pass 0) +(define ev-bk-fail 0) +(define ev-bk-failures (list)) + +(define + ev-bk-check! + (fn + (name got expected) + (if + (= got expected) + (set! ev-bk-pass (+ ev-bk-pass 1)) + (do + (set! ev-bk-fail (+ ev-bk-fail 1)) + (append! + ev-bk-failures + (str name "\n expected: " expected "\n got: " got)))))) + +;; Take a consistent (roster, last-seq) snapshot of an occurrence's stream. +(define ev-bk-snap (fn (b k) (ev-booked-actors b k))) +(define ev-bk-seq (fn (b k) (persist/last-seq b (ev-booking-stream k)))) + +(define + ev-bk-run-all! + (fn + () + (do + (let + ((b (persist/open))) + (do + (ev-bk-check! + "first booking takes seat 1" + (get (ev/book! b "o1" 3 (quote a)) :seat) + 1) + (ev-bk-check! + "second booking takes seat 2" + (get (ev/book! b "o1" 3 (quote c)) :seat) + 2) + (ev-bk-check! + "booked status reported" + (get (ev/book! b "o1" 3 (quote d)) :status) + :booked) + (ev-bk-check! + "roster is oldest-first" + (ev/roster b "o1") + (list (quote a) (quote c) (quote d))) + (ev-bk-check! + "seats-left is zero when full" + (ev/seats-left b "o1" 3) + 0))) + (let + ((b (persist/open))) + (do + (ev/book! b "o2" 1 (quote a)) + (ev-bk-check! + "booking past capacity is refused" + (get (ev/book! b "o2" 1 (quote c)) :status) + :full) + (ev-bk-check! + "full does not grow the roster" + (ev/roster b "o2") + (list (quote a))) + (ev-bk-check! + "seats-left zero at capacity" + (ev/seats-left b "o2" 1) + 0))) + (let + ((b (persist/open))) + (do + (ev/book! b "o3" 5 (quote a)) + (ev-bk-check! + "re-booking the same actor is idempotent" + (get (ev/book! b "o3" 5 (quote a)) :status) + :already) + (ev-bk-check! + "idempotent re-book reports existing seat" + (get (ev/book! b "o3" 5 (quote a)) :seat) + 1) + (ev-bk-check! + "roster unchanged after re-book" + (ev/roster b "o3") + (list (quote a))) + (ev-bk-check! + "count unchanged after re-book" + (ev-booking-count b "o3") + 1))) + (let + ((b (persist/open))) + (do + (ev/book! b "last" 2 (quote x)) + (let + ((snap (ev-bk-snap b "last")) (exp (ev-bk-seq b "last"))) + (let + ((ra (ev/book-with-observed b "last" 2 (quote a) snap exp)) + (rb + (ev/book-with-observed + b + "last" + 2 + (quote bee) + snap + exp))) + (do + (ev-bk-check! + "race winner is booked" + (get ra :status) + :booked) + (ev-bk-check! + "race winner takes the last seat" + (get ra :seat) + 2) + (ev-bk-check! + "race loser is rejected with a conflict" + (get rb :status) + :conflict) + (ev-bk-check! + "conflict reports the advanced seq" + (get rb :actual) + (+ exp 1)) + (ev-bk-check! + "no overbooking: exactly two on roster" + (ev-booking-count b "last") + 2) + (ev-bk-check! + "race loser is NOT on the roster" + (ev-bk-member? (quote bee) (ev/roster b "last")) + false) + (ev-bk-check! + "race loser retrying gets full" + (get (ev/book! b "last" 2 (quote bee)) :status) + :full)))))) + (let + ((b (persist/open))) + (do + (ev/book! b "room" 3 (quote x)) + (let + ((snap (ev-bk-snap b "room")) (exp (ev-bk-seq b "room"))) + (let + ((ra (ev/book-with-observed b "room" 3 (quote a) snap exp)) + (rb + (ev/book-with-observed + b + "room" + 3 + (quote bee) + snap + exp))) + (do + (ev-bk-check! + "room winner booked seat 2" + (get ra :seat) + 2) + (ev-bk-check! + "room loser first conflicts" + (get rb :status) + :conflict) + (ev-bk-check! + "room loser retry books seat 3" + (get (ev/book! b "room" 3 (quote bee)) :seat) + 3) + (ev-bk-check! + "room roster is x,a,bee" + (ev/roster b "room") + (list (quote x) (quote a) (quote bee))) + (ev-bk-check! + "room is now full" + (ev/seats-left b "room" 3) + 0))))))))) + +(define + ev-booking-tests-run! + (fn + () + (do + (set! ev-bk-pass 0) + (set! ev-bk-fail 0) + (set! ev-bk-failures (list)) + (ev-bk-run-all!) + {:failures ev-bk-failures :total (+ ev-bk-pass ev-bk-fail) :passed ev-bk-pass :failed ev-bk-fail}))) diff --git a/plans/events-on-sx.md b/plans/events-on-sx.md index 2295951d..f5b1544f 100644 --- a/plans/events-on-sx.md +++ b/plans/events-on-sx.md @@ -18,7 +18,7 @@ capacity rules, transactional booking, and a flow-driven notification dispatcher ## Status (rolling) -`bash lib/events/conformance.sh` → **73/73** (Phase 1 complete: calendar + availability + api) +`bash lib/events/conformance.sh` → **97/97** (Phase 1 complete + Phase 2 capacity-safe booking) ## Ground rules @@ -62,9 +62,11 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── - [x] tests + scoreboard + conformance.sh (73/73) ## Phase 2 — Ticketing + booking -- [ ] capacity rules; transactional booking → `persist` (no overbooking) +- [x] capacity rules; transactional booking → `persist` (no overbooking) +- [ ] wire `booking.sx` into `api.sx` (persist-backed `ev/book`) +- [ ] cancellation (tombstone events) + seat release - [ ] paid tickets compose with `commerce` order flow -- [ ] tests: capacity edge, double-book guard, conflict detection +- [x] tests: capacity edge, double-book guard, conflict detection ## Phase 3 — Notification delivery (flow) - [ ] `notify.sx` — reminder/digest flows over injected transport @@ -79,6 +81,16 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── ## Progress log +- 2026-06-07 — **Phase 2 start: capacity-safe booking.** `booking.sx`: one + append-only persist stream per occurrence; roster = stream replayed. Booking + decisions made against an OBSERVED (roster, last-seq) snapshot, committed via + `persist/append-expect` — append only if last-seq unchanged, else a conflict + value the booker retries. This makes capacity-check + append atomic at the + persist boundary: no overbooking, no lock. `ev/book!` (retrying), + `ev/book-with-observed`, `ev/roster`, `ev/seats-left`. Idempotent per actor + (:already). Explicit last-seat race test: two bookers on the same snapshot → + one :booked, one :conflict, roster never exceeds capacity; loser retry → + :full (or next seat when room remains). 24 tests, 97/97 green. - 2026-06-07 — **Phase 1 complete.** `api.sx`: immutable `store` ({:events :bookings}) facade over calendar + availability. `ev/schedule`, `ev/book`, `ev/agenda`, `ev/agenda-for`, `ev/free?`, `ev/next-free`,