giles
9adeff1431
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
Booking stream carries :booking/:cancel events; live roster is the folded replay so cancelling frees a seat and capacity reopens. ev/cancel! (retrying append-expect), no-op on unbooked, cancelled actor may re-book. Capacity count is folded roster size. 110/110 green. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
243 lines
7.5 KiB
Plaintext
243 lines
7.5 KiB
Plaintext
;; lib/events/tests/booking.sx — capacity-safe transactional booking + cancel.
|
|
|
|
(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))))))
|
|
(let
|
|
((b (persist/open)))
|
|
(do
|
|
(ev/book! b "cx" 2 (quote a))
|
|
(ev/book! b "cx" 2 (quote c))
|
|
(ev-bk-check!
|
|
"occupied to capacity before cancel"
|
|
(ev/seats-left b "cx" 2)
|
|
0)
|
|
(ev-bk-check!
|
|
"booking when full (pre-cancel) is refused"
|
|
(get (ev/book! b "cx" 2 (quote d)) :status)
|
|
:full)
|
|
(ev-bk-check!
|
|
"cancel reports cancelled"
|
|
(get (ev/cancel! b "cx" (quote a)) :status)
|
|
:cancelled)
|
|
(ev-bk-check!
|
|
"cancel removes actor from roster"
|
|
(ev/roster b "cx")
|
|
(list (quote c)))
|
|
(ev-bk-check!
|
|
"cancel frees a seat"
|
|
(ev/seats-left b "cx" 2)
|
|
1)
|
|
(ev-bk-check!
|
|
"freed seat is bookable again"
|
|
(get (ev/book! b "cx" 2 (quote d)) :status)
|
|
:booked)
|
|
(ev-bk-check!
|
|
"roster after rebook is c,d"
|
|
(ev/roster b "cx")
|
|
(list (quote c) (quote d)))))
|
|
(let
|
|
((b (persist/open)))
|
|
(do
|
|
(ev/book! b "ce" 3 (quote a))
|
|
(ev-bk-check!
|
|
"cancelling an unbooked actor is a no-op"
|
|
(get (ev/cancel! b "ce" (quote z)) :status)
|
|
:not-booked)
|
|
(ev-bk-check!
|
|
"no-op cancel leaves roster intact"
|
|
(ev/roster b "ce")
|
|
(list (quote a)))
|
|
(ev/cancel! b "ce" (quote a))
|
|
(ev-bk-check!
|
|
"double cancel is not-booked the second time"
|
|
(get (ev/cancel! b "ce" (quote a)) :status)
|
|
:not-booked)
|
|
(ev-bk-check!
|
|
"empty roster after cancel"
|
|
(ev/roster b "ce")
|
|
(list))
|
|
(ev-bk-check!
|
|
"cancelled actor may re-book"
|
|
(get (ev/book! b "ce" 3 (quote a)) :status)
|
|
:booked)
|
|
(ev-bk-check!
|
|
"re-booked actor back on roster"
|
|
(ev/roster b "ce")
|
|
(list (quote a))))))))
|
|
|
|
(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})))
|