From 7153e742c89417784268f84c27ea32cbea6d5edf Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 03:07:29 +0000 Subject: [PATCH] events: provisional holds (hold/confirm/release) for paid tickets + 24 tests Booking stream gains :hold/:confirm/:release; fold tracks per-actor seat state (:held/:confirmed). A held seat counts toward capacity so a pending payment can't be oversold. ev/hold! (capacity-safe), ev/confirm!, ev/release!, ev/seat-state. Holds race test mirrors the booking race. 144/144 green. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/events/booking.sx | 236 +++++++++++++++++++++++++++--------- lib/events/scoreboard.json | 8 +- lib/events/scoreboard.md | 4 +- lib/events/tests/booking.sx | 135 ++++++++++++++++++++- plans/events-on-sx.md | 14 ++- 5 files changed, 331 insertions(+), 66 deletions(-) diff --git a/lib/events/booking.sx b/lib/events/booking.sx index 1e3d9196..522203ca 100644 --- a/lib/events/booking.sx +++ b/lib/events/booking.sx @@ -1,19 +1,24 @@ ;; lib/events/booking.sx — transactional, capacity-safe booking on persist. ;; -;; Each bookable occurrence has an append-only stream of :booking / :cancel -;; events. The live roster is the stream FOLDED in order — a booking adds an -;; actor, a cancel removes them — so a cancellation frees a seat and capacity -;; reopens. 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 writer observed; otherwise it returns -;; a conflict value and the writer retries against the advanced roster. So the -;; capacity check + append are atomic at the persist boundary, no lock. +;; Each bookable occurrence has an append-only stream of booking events: ;; -;; A booking/cancel decision is made against an OBSERVED snapshot (folded -;; 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. +;; :booking free booking — actor immediately holds a confirmed seat +;; :hold provisional hold — seat reserved while payment is pending +;; :confirm a held seat becomes confirmed (payment succeeded) +;; :release a held seat is abandoned (payment failed/expired) — seat freed +;; :cancel a held or confirmed seat is given up — seat freed +;; +;; The live state is the stream FOLDED in order into per-actor seat states +;; (:held / :confirmed); an actor in ANY state occupies a seat, so both held and +;; confirmed seats count toward capacity — a pending payment cannot be +;; oversold. A freed seat (release/cancel) reopens capacity. +;; +;; Capacity safety is the contract: two writers racing for the last seat must +;; NEVER both succeed. Seat-ACQUIRING writes (:booking, :hold) go through +;; persist's optimistic concurrency — `persist/append-expect` appends only if +;; the stream's last-seq still equals what the writer observed; else it returns +;; a conflict the writer retries. Seat-FREEING writes (:cancel, :release) and +;; the state transition (:confirm) never oversell, so they append directly. (define ev-booking-stream (fn (occ-key) (str "booking:" occ-key))) @@ -35,12 +40,42 @@ ((= (first xs) x) i) (else (ev-bk-index (rest xs) x (+ i 1)))))) -(define ev-bk-remove (fn (xs a) (filter (fn (x) (not (= x a))) xs))) -(define ev-bk-append (fn (xs a) (append xs (list a)))) +;; ---- per-actor state association list: ((actor state) ...) in join order ---- -;; Fold a booking stream into the live roster (join order, cancels removed). (define - ev-fold-roster + ev-state-has? + (fn + (states actor) + (cond + ((empty? states) false) + ((= (first (first states)) actor) true) + (else (ev-state-has? (rest states) actor))))) + +(define + ev-state-get + (fn + (states actor) + (cond + ((empty? states) :none) + ((= (first (first states)) actor) (first (rest (first states)))) + (else (ev-state-get (rest states) actor))))) + +(define + ev-state-del + (fn (states actor) (filter (fn (p) (not (= (first p) actor))) states))) + +(define + ev-state-set + (fn + (states actor st) + (if + (ev-state-has? states actor) + (map (fn (p) (if (= (first p) actor) (list actor st) p)) states) + (append states (list (list actor st)))))) + +;; Fold the booking stream into per-actor seat states (join order preserved). +(define + ev-fold-states (fn (events) (reduce @@ -50,29 +85,44 @@ ((typ (persist/event-type e)) (actor (get (persist/event-data e) :actor))) (cond - ((= typ :booking) - (if (ev-bk-member? actor acc) acc (ev-bk-append acc actor))) - ((= typ :cancel) (ev-bk-remove acc actor)) + ((= typ :booking) (ev-state-set acc actor :confirmed)) + ((= typ :hold) (ev-state-set acc actor :held)) + ((= typ :confirm) + (if + (ev-state-has? acc actor) + (ev-state-set acc actor :confirmed) + acc)) + ((= typ :cancel) (ev-state-del acc actor)) + ((= typ :release) (ev-state-del acc actor)) (else acc)))) (list) events))) -;; Live roster (actors currently holding a seat), oldest active first. (define - ev-booked-actors + ev-states-of (fn (b occ-key) - (ev-fold-roster (persist/read b (ev-booking-stream occ-key))))) + (ev-fold-states (persist/read b (ev-booking-stream occ-key))))) + +;; Live roster (actors holding a seat — held or confirmed), oldest active first. +(define + ev-booked-actors + (fn (b occ-key) (map (fn (p) (first p)) (ev-states-of b occ-key)))) (define ev-actor-booked? (fn (b occ-key actor) (ev-bk-member? actor (ev-booked-actors b occ-key)))) -;; Live seat count (folded roster size — not the physical event count). +;; Live seat count (folded roster size — both held and confirmed seats). (define ev-booking-count (fn (b occ-key) (len (ev-booked-actors b occ-key)))) +;; Seat state for an actor: :held / :confirmed / :none. +(define + ev/seat-state + (fn (b occ-key actor) (ev-state-get (ev-states-of b occ-key) actor))) + ;; 1-based seat number for an actor on the roster (0 if not booked). (define ev-seat-of @@ -82,57 +132,133 @@ ((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. +;; ---- seat-acquiring writes (capacity-guarded via append-expect) ---- + +;; One seat-acquiring attempt of `kind` (:booking or :hold) against an OBSERVED +;; snapshot (roster the writer saw + the last-seq). Returns :already / :full / +;; :conflict, or a success dict tagged with `ok-status`. :conflict means a +;; concurrent append landed since the snapshot — the caller must re-observe. (define - ev/book-with-observed + ev-acquire-with-observed (fn - (b occ-key capacity actor observed-actors expected) + (b occ-key capacity actor observed-actors expected kind ok-status) (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})))))) + ((r (persist/append-expect b (ev-booking-stream occ-key) expected kind 0 {:actor actor}))) + (if (persist/conflict? r) {:actual (persist/conflict-actual r) :actor actor :status :conflict} {:seat (+ (len observed-actors) 1) :actor actor :status ok-status})))))) -;; 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. +(define + ev-acquire! + (fn + (b occ-key capacity actor kind ok-status) + (let + ((res (ev-acquire-with-observed b occ-key capacity actor (ev-booked-actors b occ-key) (persist/last-seq b (ev-booking-stream occ-key)) kind ok-status))) + (if + (= (get res :status) :conflict) + (ev-acquire! b occ-key capacity actor kind ok-status) + res)))) + +;; Capacity-safe confirmed booking (retrying on conflict). (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)))) + (ev-acquire! b occ-key capacity actor :booking :booked))) -;; One cancellation attempt against an observed snapshot. :not-booked when the -;; actor holds no seat; :conflict on a racing append (retry); else :cancelled. +;; Capacity-safe provisional hold (retrying on conflict). The seat is reserved +;; (counts toward capacity) until confirmed or released. (define - ev/cancel-with-observed + ev/hold! (fn - (b occ-key actor observed-actors expected) - (cond - ((not (ev-bk-member? actor observed-actors)) {:actor actor :status :not-booked}) - (else - (let - ((r (persist/append-expect b (ev-booking-stream occ-key) expected :cancel 0 {:actor actor}))) - (if (persist/conflict? r) {:actual (persist/conflict-actual r) :actor actor :status :conflict} {:actor actor :status :cancelled})))))) + (b occ-key capacity actor) + (ev-acquire! b occ-key capacity actor :hold :held))) -;; Cancel an actor's seat, freeing capacity. Retries on conflict. +;; Test seam: one attempt against a caller-supplied snapshot (book or hold). +(define + ev/book-with-observed + (fn + (b occ-key capacity actor observed-actors expected) + (ev-acquire-with-observed + b + occ-key + capacity + actor + observed-actors + expected + :booking :booked))) + +(define + ev/hold-with-observed + (fn + (b occ-key capacity actor observed-actors expected) + (ev-acquire-with-observed + b + occ-key + capacity + actor + observed-actors + expected + :hold :held))) + +;; ---- state transitions / seat-freeing writes (no oversell, append direct) ---- + +;; Confirm a held seat (payment succeeded). :confirmed on success, +;; :already-confirmed if it was confirmed, :not-held otherwise. +(define + ev/confirm! + (fn + (b occ-key actor) + (let + ((st (ev/seat-state b occ-key actor))) + (cond + ((= st :held) + (begin + (persist/append + b + (ev-booking-stream occ-key) + :confirm 0 + {:actor actor}) + {:actor actor :status :confirmed})) + ((= st :confirmed) {:actor actor :status :already-confirmed}) + (else {:actor actor :status :not-held}))))) + +;; Release a held seat (payment failed/expired), freeing it. Only valid for a +;; held seat — confirmed bookings are given up via ev/cancel!. +(define + ev/release! + (fn + (b occ-key actor) + (let + ((st (ev/seat-state b occ-key actor))) + (if + (= st :held) + (begin + (persist/append + b + (ev-booking-stream occ-key) + :release 0 + {:actor actor}) + {:actor actor :status :released}) + {:actor actor :status :not-held})))) + +;; Cancel a held or confirmed seat, freeing it. :cancelled or :not-booked. (define ev/cancel! (fn (b occ-key actor) - (let - ((res (ev/cancel-with-observed b occ-key actor (ev-booked-actors b occ-key) (persist/last-seq b (ev-booking-stream occ-key))))) - (if (= (get res :status) :conflict) (ev/cancel! b occ-key actor) res)))) + (if + (ev-bk-member? actor (ev-booked-actors b occ-key)) + (begin + (persist/append + b + (ev-booking-stream occ-key) + :cancel 0 + {:actor actor}) + {:actor actor :status :cancelled}) + {:actor actor :status :not-booked}))) ;; The roster as a plain list of actors (oldest active first). (define ev/roster (fn (b occ-key) (ev-booked-actors b occ-key))) diff --git a/lib/events/scoreboard.json b/lib/events/scoreboard.json index 8b529d61..9f7a24cc 100644 --- a/lib/events/scoreboard.json +++ b/lib/events/scoreboard.json @@ -1,13 +1,13 @@ { "lang": "events", - "total_passed": 120, + "total_passed": 144, "total_failed": 0, - "total": 120, + "total": 144, "suites": [ {"name":"calendar","passed":37,"failed":0,"total":37}, {"name":"availability","passed":22,"failed":0,"total":22}, {"name":"api","passed":24,"failed":0,"total":24}, - {"name":"booking","passed":37,"failed":0,"total":37} + {"name":"booking","passed":61,"failed":0,"total":61} ], - "generated": "2026-06-07T02:39:08+00:00" + "generated": "2026-06-07T03:07:09+00:00" } diff --git a/lib/events/scoreboard.md b/lib/events/scoreboard.md index 0032b155..10dbf9b1 100644 --- a/lib/events/scoreboard.md +++ b/lib/events/scoreboard.md @@ -1,10 +1,10 @@ # events scoreboard -**120 / 120 passing** (0 failure(s)). +**144 / 144 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| | calendar | 37 | 37 | ok | | availability | 22 | 22 | ok | | api | 24 | 24 | ok | -| booking | 37 | 37 | ok | +| booking | 61 | 61 | ok | diff --git a/lib/events/tests/booking.sx b/lib/events/tests/booking.sx index 6a0f1666..52bd070b 100644 --- a/lib/events/tests/booking.sx +++ b/lib/events/tests/booking.sx @@ -1,4 +1,4 @@ -;; lib/events/tests/booking.sx — capacity-safe transactional booking + cancel. +;; lib/events/tests/booking.sx — capacity-safe booking, cancel, and holds. (define ev-bk-pass 0) (define ev-bk-fail 0) @@ -48,7 +48,11 @@ (ev-bk-check! "seats-left is zero when full" (ev/seats-left b "o1" 3) - 0))) + 0) + (ev-bk-check! + "free booking is confirmed state" + (ev/seat-state b "o1" (quote a)) + :confirmed))) (let ((b (persist/open))) (do @@ -228,7 +232,132 @@ (ev-bk-check! "re-booked actor back on roster" (ev/roster b "ce") - (list (quote a)))))))) + (list (quote a))))) + (let + ((b (persist/open))) + (do + (ev/book! b "h" 2 (quote a)) + (ev-bk-check! + "hold reports held" + (get (ev/hold! b "h" 2 (quote p)) :status) + :held) + (ev-bk-check! + "held seat is :held state" + (ev/seat-state b "h" (quote p)) + :held) + (ev-bk-check! + "held actor is on the roster" + (ev/roster b "h") + (list (quote a) (quote p))) + (ev-bk-check! + "held seat blocks the last booking" + (get (ev/book! b "h" 2 (quote x)) :status) + :full) + (ev-bk-check! + "no seats left with one held" + (ev/seats-left b "h" 2) + 0))) + (let + ((b (persist/open))) + (do + (ev/hold! b "hc" 3 (quote p)) + (ev-bk-check! + "confirm reports confirmed" + (get (ev/confirm! b "hc" (quote p)) :status) + :confirmed) + (ev-bk-check! + "confirmed seat is :confirmed state" + (ev/seat-state b "hc" (quote p)) + :confirmed) + (ev-bk-check! + "re-confirm is already-confirmed" + (get (ev/confirm! b "hc" (quote p)) :status) + :already-confirmed) + (ev-bk-check! + "confirming a non-holder is not-held" + (get (ev/confirm! b "hc" (quote z)) :status) + :not-held) + (ev-bk-check! + "confirmed seat still occupies" + (ev/seats-left b "hc" 3) + 2))) + (let + ((b (persist/open))) + (do + (ev/book! b "hr" 2 (quote a)) + (ev/hold! b "hr" 2 (quote p)) + (ev-bk-check! + "full while hold pending" + (ev/seats-left b "hr" 2) + 0) + (ev-bk-check! + "release reports released" + (get (ev/release! b "hr" (quote p)) :status) + :released) + (ev-bk-check! + "release frees the held seat" + (ev/seats-left b "hr" 2) + 1) + (ev-bk-check! + "released actor off the roster" + (ev/roster b "hr") + (list (quote a))) + (ev-bk-check! + "freed seat bookable after release" + (get (ev/book! b "hr" 2 (quote x)) :status) + :booked) + (ev/hold! b "hr2" 1 (quote q)) + (ev/confirm! b "hr2" (quote q)) + (ev-bk-check! + "release on a confirmed seat is not-held" + (get (ev/release! b "hr2" (quote q)) :status) + :not-held) + (ev-bk-check! + "cancel frees a confirmed-from-hold seat" + (get (ev/cancel! b "hr2" (quote q)) :status) + :cancelled))) + (let + ((b (persist/open))) + (do + (ev/book! b "hlast" 2 (quote x)) + (let + ((snap (ev-bk-snap b "hlast")) (exp (ev-bk-seq b "hlast"))) + (let + ((ra (ev/hold-with-observed b "hlast" 2 (quote p) snap exp)) + (rb + (ev/hold-with-observed + b + "hlast" + 2 + (quote q) + snap + exp))) + (do + (ev-bk-check! "hold race winner held" (get ra :status) :held) + (ev-bk-check! + "hold race loser conflicts" + (get rb :status) + :conflict) + (ev-bk-check! + "no oversell via concurrent holds" + (ev-booking-count b "hlast") + 2) + (ev-bk-check! + "hold loser retry gets full" + (get (ev/hold! b "hlast" 2 (quote q)) :status) + :full)))))) + (let + ((b (persist/open))) + (do + (ev/hold! b "hi" 4 (quote p)) + (ev-bk-check! + "re-holding the same actor is idempotent" + (get (ev/hold! b "hi" 4 (quote p)) :status) + :already) + (ev-bk-check! + "hold idempotency keeps one seat" + (ev-booking-count b "hi") + 1)))))) (define ev-booking-tests-run! diff --git a/plans/events-on-sx.md b/plans/events-on-sx.md index 29406a31..520839bb 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` → **120/120** (Phase 1 + Phase 2 booking/cancel + persist-backed api) +`bash lib/events/conformance.sh` → **144/144** (Phase 1 + Phase 2 booking/cancel/holds + persist-backed api) ## Ground rules @@ -65,7 +65,8 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── - [x] capacity rules; transactional booking → `persist` (no overbooking) - [x] wire `booking.sx` into `api.sx` (persist-backed `ev/book-occ!` + derived availability) - [x] cancellation (tombstone events) + seat release -- [ ] paid tickets compose with `commerce` order flow +- [x] provisional holds (hold/confirm/release) — reserve a seat during pending payment +- [ ] paid tickets compose with `commerce` order flow (contract module over holds) - [x] tests: capacity edge, double-book guard, conflict detection ## Phase 3 — Notification delivery (flow) @@ -81,6 +82,15 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── ## Progress log +- 2026-06-07 — Provisional holds (paid-ticket foundation). Booking stream now + carries :booking/:hold/:confirm/:release/:cancel; the fold tracks per-actor + seat STATE (:held / :confirmed). A held seat counts toward capacity, so a + pending payment cannot be oversold. `ev/hold!` (capacity-safe, retrying), + `ev/confirm!` (held→confirmed), `ev/release!` (frees a held seat only), + `ev/seat-state`. Seat-acquiring writes (:booking/:hold) go through + append-expect; seat-freeing writes (:cancel/:release) and :confirm append + directly (never oversell). Holds race test mirrors the booking race. +24 + tests, 144/144 green. Next: ticket.sx contract module over holds. - 2026-06-07 — Wired `booking.sx` into `api.sx`: durable persist-backed booking path alongside the in-memory one. `ev/book-occ!`, `ev/cancel-occ!`, `ev/roster-occ`, `ev/seats-left-occ` (capacity from the scheduled event);