giles
7153e742c8
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 48s
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) <noreply@anthropic.com>
372 lines
12 KiB
Plaintext
372 lines
12 KiB
Plaintext
;; lib/events/tests/booking.sx — capacity-safe booking, cancel, and holds.
|
|
|
|
(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)
|
|
(ev-bk-check!
|
|
"free booking is confirmed state"
|
|
(ev/seat-state b "o1" (quote a))
|
|
:confirmed)))
|
|
(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)))))
|
|
(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!
|
|
(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})))
|