coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

events: capacity-safe transactional booking on persist + 24 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
Details

Browse Source 
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) <noreply@anthropic.com>
This commit is contained in:
giles
2026-06-07 01:44:43 +00:00
parent 15e9503b05
commit 80a2dee22f
6 changed files with 313 additions and 8 deletions
Download Patch File Download Diff File Expand all files Collapse all files

101
lib/events/booking.sx Normal file
View File

@@ -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)))))

10
lib/events/conformance.conf
View File

@@ -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!)"
)

9
lib/events/scoreboard.json
View File

@@ -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"
}

3
lib/events/scoreboard.md
View File

@@ -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 |

180
lib/events/tests/booking.sx Normal file
View File

@@ -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})))

18
plans/events-on-sx.md
View File

@@ -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`,