giles
80a2dee22f
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>
181 lines
5.5 KiB
Plaintext
181 lines
5.5 KiB
Plaintext
;; 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})))
|