events: capacity-safe transactional booking on persist + 24 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
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:
180
lib/events/tests/booking.sx
Normal file
180
lib/events/tests/booking.sx
Normal 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})))
|
||||
Reference in New Issue
Block a user