events: paid-ticket contract (commerce) over holds + 31 tests (Phase 2 done)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 42s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 42s
ticket.sx: checkout-request (events->commerce) + payment-result (commerce->events) wire shapes — commerce imports the contract. ev/request- ticket! holds a seat + emits a checkout request; ev/settle-payment! confirms on :paid, releases on failure/expiry. Idempotent; late paid for a vanished hold -> :paid-but-no-hold (refund signal). 175/175 green. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
252
lib/events/tests/ticket.sx
Normal file
252
lib/events/tests/ticket.sx
Normal file
@@ -0,0 +1,252 @@
|
||||
;; lib/events/tests/ticket.sx — paid-ticket contract + settlement orchestration.
|
||||
|
||||
(define ev-tk-pass 0)
|
||||
(define ev-tk-fail 0)
|
||||
(define ev-tk-failures (list))
|
||||
|
||||
(define
|
||||
ev-tk-check!
|
||||
(fn
|
||||
(name got expected)
|
||||
(if
|
||||
(= got expected)
|
||||
(set! ev-tk-pass (+ ev-tk-pass 1))
|
||||
(do
|
||||
(set! ev-tk-fail (+ ev-tk-fail 1))
|
||||
(append!
|
||||
ev-tk-failures
|
||||
(str name "\n expected: " expected "\n got: " got))))))
|
||||
|
||||
(define
|
||||
ev-tk-run-all!
|
||||
(fn
|
||||
()
|
||||
(do
|
||||
(let
|
||||
((req (ev/checkout-request "occ1" (quote nia) 1500 "GBP" "ref-1")))
|
||||
(do
|
||||
(ev-tk-check!
|
||||
"checkout-request is tagged"
|
||||
(ev/checkout-request? req)
|
||||
true)
|
||||
(ev-tk-check!
|
||||
"payment-result is not a checkout-request"
|
||||
(ev/checkout-request? (ev/payment-paid "o" (quote a) "r"))
|
||||
false)
|
||||
(ev-tk-check!
|
||||
"request occ-key accessor"
|
||||
(ev/req-occ-key req)
|
||||
"occ1")
|
||||
(ev-tk-check!
|
||||
"request actor accessor"
|
||||
(ev/req-actor req)
|
||||
(quote nia))
|
||||
(ev-tk-check!
|
||||
"request amount accessor"
|
||||
(ev/req-amount req)
|
||||
1500)
|
||||
(ev-tk-check!
|
||||
"request currency accessor"
|
||||
(ev/req-currency req)
|
||||
"GBP")
|
||||
(ev-tk-check! "request ref accessor" (ev/req-ref req) "ref-1")))
|
||||
(let
|
||||
((res (ev/payment-paid "occ1" (quote nia) "ref-1")))
|
||||
(do
|
||||
(ev-tk-check!
|
||||
"payment-result is tagged"
|
||||
(ev/payment-result? res)
|
||||
true)
|
||||
(ev-tk-check! "result status accessor" (ev/result-status res) :paid)
|
||||
(ev-tk-check!
|
||||
"failed constructor carries status"
|
||||
(ev/result-status (ev/payment-failed "o" (quote a) "r"))
|
||||
:failed)
|
||||
(ev-tk-check!
|
||||
"expired constructor carries status"
|
||||
(ev/result-status (ev/payment-expired "o" (quote a) "r"))
|
||||
:expired)))
|
||||
(let
|
||||
((b (persist/open)))
|
||||
(do
|
||||
(let
|
||||
((r (ev/request-ticket! b "show" 1 (quote a) 2000 "GBP" "ref-a")))
|
||||
(do
|
||||
(ev-tk-check!
|
||||
"request-ticket awaiting-payment"
|
||||
(get r :status)
|
||||
:awaiting-payment)
|
||||
(ev-tk-check!
|
||||
"request-ticket returns a checkout-request"
|
||||
(ev/checkout-request? (get r :request))
|
||||
true)
|
||||
(ev-tk-check!
|
||||
"checkout-request carries the amount"
|
||||
(ev/req-amount (get r :request))
|
||||
2000)))
|
||||
(ev-tk-check!
|
||||
"held seat reserves capacity"
|
||||
(ev/seats-left b "show" 1)
|
||||
0)
|
||||
(ev-tk-check!
|
||||
"second buyer is full while payment pends"
|
||||
(get
|
||||
(ev/request-ticket!
|
||||
b
|
||||
"show"
|
||||
1
|
||||
(quote c)
|
||||
2000
|
||||
"GBP"
|
||||
"ref-c")
|
||||
:status)
|
||||
:full)
|
||||
(ev-tk-check!
|
||||
"held seat state pending"
|
||||
(ev/seat-state b "show" (quote a))
|
||||
:held)))
|
||||
(let
|
||||
((b (persist/open)))
|
||||
(do
|
||||
(ev/request-ticket!
|
||||
b
|
||||
"gig"
|
||||
2
|
||||
(quote a)
|
||||
2000
|
||||
"GBP"
|
||||
"ref-a")
|
||||
(let
|
||||
((s (ev/settle-payment! b (ev/payment-paid "gig" (quote a) "ref-a"))))
|
||||
(ev-tk-check! "settle paid confirms" (get s :status) :confirmed))
|
||||
(ev-tk-check!
|
||||
"confirmed seat state"
|
||||
(ev/seat-state b "gig" (quote a))
|
||||
:confirmed)
|
||||
(ev-tk-check!
|
||||
"redelivered paid is still confirmed (idempotent)"
|
||||
(get
|
||||
(ev/settle-payment!
|
||||
b
|
||||
(ev/payment-paid "gig" (quote a) "ref-a"))
|
||||
:status)
|
||||
:confirmed)
|
||||
(ev-tk-check!
|
||||
"still exactly one seat taken"
|
||||
(ev-booking-count b "gig")
|
||||
1)))
|
||||
(let
|
||||
((b (persist/open)))
|
||||
(do
|
||||
(ev/request-ticket!
|
||||
b
|
||||
"fail"
|
||||
1
|
||||
(quote a)
|
||||
2000
|
||||
"GBP"
|
||||
"ref-a")
|
||||
(ev-tk-check!
|
||||
"seat held before failure"
|
||||
(ev/seats-left b "fail" 1)
|
||||
0)
|
||||
(let
|
||||
((s (ev/settle-payment! b (ev/payment-failed "fail" (quote a) "ref-a"))))
|
||||
(ev-tk-check! "settle failed releases" (get s :status) :released))
|
||||
(ev-tk-check!
|
||||
"released seat frees capacity"
|
||||
(ev/seats-left b "fail" 1)
|
||||
1)
|
||||
(ev-tk-check!
|
||||
"redelivered failure is a noop"
|
||||
(get
|
||||
(ev/settle-payment!
|
||||
b
|
||||
(ev/payment-failed "fail" (quote a) "ref-a"))
|
||||
:status)
|
||||
:noop)
|
||||
(ev-tk-check!
|
||||
"freed seat available to next buyer"
|
||||
(get
|
||||
(ev/request-ticket!
|
||||
b
|
||||
"fail"
|
||||
1
|
||||
(quote c)
|
||||
2000
|
||||
"GBP"
|
||||
"ref-c")
|
||||
:status)
|
||||
:awaiting-payment)
|
||||
(ev/request-ticket!
|
||||
b
|
||||
"exp"
|
||||
1
|
||||
(quote a)
|
||||
2000
|
||||
"GBP"
|
||||
"ref-a")
|
||||
(ev-tk-check!
|
||||
"settle expired releases"
|
||||
(get
|
||||
(ev/settle-payment!
|
||||
b
|
||||
(ev/payment-expired "exp" (quote a) "ref-a"))
|
||||
:status)
|
||||
:released)))
|
||||
(let
|
||||
((b (persist/open)))
|
||||
(do
|
||||
(ev/request-ticket!
|
||||
b
|
||||
"race"
|
||||
1
|
||||
(quote a)
|
||||
2000
|
||||
"GBP"
|
||||
"ref-a")
|
||||
(ev/settle-payment!
|
||||
b
|
||||
(ev/payment-expired "race" (quote a) "ref-a"))
|
||||
(ev-tk-check!
|
||||
"late paid for a vanished hold needs a refund"
|
||||
(get
|
||||
(ev/settle-payment!
|
||||
b
|
||||
(ev/payment-paid "race" (quote a) "ref-a"))
|
||||
:status)
|
||||
:paid-but-no-hold)
|
||||
(ev-tk-check!
|
||||
"no phantom seat created"
|
||||
(ev-booking-count b "race")
|
||||
0)))
|
||||
(let
|
||||
((b (persist/open)))
|
||||
(do
|
||||
(let
|
||||
((start (ev/request-ticket! b "e2e" 3 (quote nia) 2500 "GBP" "ref-nia")))
|
||||
(ev/settle-payment!
|
||||
b
|
||||
(ev/payment-paid
|
||||
(ev/req-occ-key (get start :request))
|
||||
(ev/req-actor (get start :request))
|
||||
(ev/req-ref (get start :request)))))
|
||||
(ev-tk-check!
|
||||
"e2e roster holds the buyer"
|
||||
(ev/roster b "e2e")
|
||||
(list (quote nia)))
|
||||
(ev-tk-check!
|
||||
"e2e seat confirmed"
|
||||
(ev/seat-state b "e2e" (quote nia))
|
||||
:confirmed))))))
|
||||
|
||||
(define
|
||||
ev-ticket-tests-run!
|
||||
(fn
|
||||
()
|
||||
(do
|
||||
(set! ev-tk-pass 0)
|
||||
(set! ev-tk-fail 0)
|
||||
(set! ev-tk-failures (list))
|
||||
(ev-tk-run-all!)
|
||||
{:failures ev-tk-failures :total (+ ev-tk-pass ev-tk-fail) :passed ev-tk-pass :failed ev-tk-fail})))
|
||||
Reference in New Issue
Block a user