diff --git a/lib/events/conformance.conf b/lib/events/conformance.conf index f2355985..52719eaf 100644 --- a/lib/events/conformance.conf +++ b/lib/events/conformance.conf @@ -26,6 +26,7 @@ PRELOADS=( lib/persist/concurrency.sx lib/persist/api.sx lib/events/booking.sx + lib/events/ticket.sx lib/events/api.sx ) @@ -34,4 +35,5 @@ SUITES=( "availability:lib/events/tests/availability.sx:(ev-availability-tests-run!)" "api:lib/events/tests/api.sx:(ev-api-tests-run!)" "booking:lib/events/tests/booking.sx:(ev-booking-tests-run!)" + "ticket:lib/events/tests/ticket.sx:(ev-ticket-tests-run!)" ) diff --git a/lib/events/scoreboard.json b/lib/events/scoreboard.json index 9f7a24cc..5568a285 100644 --- a/lib/events/scoreboard.json +++ b/lib/events/scoreboard.json @@ -1,13 +1,14 @@ { "lang": "events", - "total_passed": 144, + "total_passed": 175, "total_failed": 0, - "total": 144, + "total": 175, "suites": [ {"name":"calendar","passed":37,"failed":0,"total":37}, {"name":"availability","passed":22,"failed":0,"total":22}, {"name":"api","passed":24,"failed":0,"total":24}, - {"name":"booking","passed":61,"failed":0,"total":61} + {"name":"booking","passed":61,"failed":0,"total":61}, + {"name":"ticket","passed":31,"failed":0,"total":31} ], - "generated": "2026-06-07T03:07:09+00:00" + "generated": "2026-06-07T03:33:46+00:00" } diff --git a/lib/events/scoreboard.md b/lib/events/scoreboard.md index 10dbf9b1..e9847412 100644 --- a/lib/events/scoreboard.md +++ b/lib/events/scoreboard.md @@ -1,6 +1,6 @@ # events scoreboard -**144 / 144 passing** (0 failure(s)). +**175 / 175 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| @@ -8,3 +8,4 @@ | availability | 22 | 22 | ok | | api | 24 | 24 | ok | | booking | 61 | 61 | ok | +| ticket | 31 | 31 | ok | diff --git a/lib/events/tests/ticket.sx b/lib/events/tests/ticket.sx new file mode 100644 index 00000000..720d355b --- /dev/null +++ b/lib/events/tests/ticket.sx @@ -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}))) diff --git a/lib/events/ticket.sx b/lib/events/ticket.sx new file mode 100644 index 00000000..817ecf43 --- /dev/null +++ b/lib/events/ticket.sx @@ -0,0 +1,101 @@ +;; lib/events/ticket.sx — paid-ticket contract between events and commerce. +;; +;; A paid booking spans two subsystems. events does NOT import commerce; instead +;; this module defines the CONTRACT — the two messages on the wire — and the +;; events-side orchestration over provisional holds (booking.sx). commerce +;; imports these shapes; the dependency only points one way. +;; +;; checkout-request events -> commerce "take payment for this seat" +;; {:kind :events.checkout :occ-key :actor :amount :currency :ref} +;; +;; payment-result commerce -> events "here's how payment went" +;; {:kind :events.payment :occ-key :actor :ref :status} +;; :status ∈ :paid | :failed | :expired +;; +;; Flow: ev/request-ticket! places a capacity-safe HOLD (reserving the seat so +;; it can't be oversold while payment pends) and returns a checkout-request to +;; hand to commerce. When commerce reports back, ev/settle-payment! confirms the +;; hold on :paid or releases it otherwise. Settlement is idempotent — an +;; at-least-once redelivery of the same result is safe. `ref` is the opaque +;; correlation/idempotency id; occ-key + actor locate the hold, so settlement +;; needs no side table. + +;; ---- contract: checkout request (events -> commerce) ---- + +(define + ev/checkout-request + (fn (occ-key actor amount currency ref) {:actor actor :amount amount :kind :events.checkout :ref ref :currency currency :occ-key occ-key})) + +(define + ev/checkout-request? + (fn (m) (and (dict? m) (= (get m :kind) :events.checkout)))) + +(define ev/req-occ-key (fn (r) (get r :occ-key))) +(define ev/req-actor (fn (r) (get r :actor))) +(define ev/req-amount (fn (r) (get r :amount))) +(define ev/req-currency (fn (r) (get r :currency))) +(define ev/req-ref (fn (r) (get r :ref))) + +;; ---- contract: payment result (commerce -> events) ---- + +(define ev/payment-result (fn (occ-key actor ref status) {:actor actor :kind :events.payment :status status :ref ref :occ-key occ-key})) + +(define + ev/payment-result? + (fn (m) (and (dict? m) (= (get m :kind) :events.payment)))) + +(define ev/result-occ-key (fn (r) (get r :occ-key))) +(define ev/result-actor (fn (r) (get r :actor))) +(define ev/result-ref (fn (r) (get r :ref))) +(define ev/result-status (fn (r) (get r :status))) + +(define + ev/payment-paid + (fn (occ-key actor ref) (ev/payment-result occ-key actor ref :paid))) +(define + ev/payment-failed + (fn (occ-key actor ref) (ev/payment-result occ-key actor ref :failed))) +(define + ev/payment-expired + (fn (occ-key actor ref) (ev/payment-result occ-key actor ref :expired))) + +;; ---- orchestration ---- + +;; Begin a paid booking: place a capacity-safe hold and, if reserved, return a +;; checkout-request for commerce. :full when no seat; :already when the actor +;; already holds/booked this occurrence (no duplicate request). +(define + ev/request-ticket! + (fn + (b occ-key capacity actor amount currency ref) + (let + ((h (ev/hold! b occ-key capacity actor))) + (cond + ((= (get h :status) :held) {:seat (get h :seat) :request (ev/checkout-request occ-key actor amount currency ref) :status :awaiting-payment}) + ((= (get h :status) :already) {:seat (get h :seat) :status :already}) + (else {:capacity capacity :status :full}))))) + +;; Settle a payment result from commerce. :paid confirms the hold; :failed / +;; :expired release it. Idempotent: a redelivered :paid stays :confirmed, a +;; redelivered release is a :noop. If a :paid arrives for a hold that is already +;; gone (released/expired first), returns :paid-but-no-hold so the caller can +;; trigger a refund. +(define + ev/settle-payment! + (fn + (b result) + (let + ((occ-key (ev/result-occ-key result)) + (actor (ev/result-actor result)) + (ref (ev/result-ref result))) + (if + (= (ev/result-status result) :paid) + (let + ((c (ev/confirm! b occ-key actor))) + (cond + ((= (get c :status) :confirmed) {:actor actor :status :confirmed :ref ref}) + ((= (get c :status) :already-confirmed) {:actor actor :status :confirmed :ref ref}) + (else {:actor actor :status :paid-but-no-hold :ref ref}))) + (let + ((r (ev/release! b occ-key actor))) + (if (= (get r :status) :released) {:actor actor :status :released :ref ref} {:actor actor :status :noop :ref ref})))))) diff --git a/plans/events-on-sx.md b/plans/events-on-sx.md index 520839bb..72db93e1 100644 --- a/plans/events-on-sx.md +++ b/plans/events-on-sx.md @@ -18,7 +18,7 @@ capacity rules, transactional booking, and a flow-driven notification dispatcher ## Status (rolling) -`bash lib/events/conformance.sh` → **144/144** (Phase 1 + Phase 2 booking/cancel/holds + persist-backed api) +`bash lib/events/conformance.sh` → **175/175** (Phase 1 + Phase 2 complete: booking/holds/paid-ticket contract) ## Ground rules @@ -66,7 +66,7 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── - [x] wire `booking.sx` into `api.sx` (persist-backed `ev/book-occ!` + derived availability) - [x] cancellation (tombstone events) + seat release - [x] provisional holds (hold/confirm/release) — reserve a seat during pending payment -- [ ] paid tickets compose with `commerce` order flow (contract module over holds) +- [x] paid tickets compose with `commerce` order flow (contract module over holds) - [x] tests: capacity edge, double-book guard, conflict detection ## Phase 3 — Notification delivery (flow) @@ -82,6 +82,16 @@ lib/events/api.sx ── (events/schedule) (events/book) (events/agenda) ── ## Progress log +- 2026-06-07 — **Phase 2 complete: paid-ticket contract.** `ticket.sx` defines + the two wire messages between events and commerce — `checkout-request` + (events→commerce) and `payment-result` (commerce→events, :paid/:failed/ + :expired) — so commerce imports the contract, not vice versa. Orchestration + over holds: `ev/request-ticket!` places a capacity-safe hold + emits a + checkout-request; `ev/settle-payment!` confirms on :paid, releases on + failure/expiry. Idempotent (redelivered :paid stays confirmed, redelivered + release is :noop); a late :paid for a vanished hold → :paid-but-no-hold + (refund signal), no phantom seat. occ-key+actor locate the hold so no side + table. +31 tests, 175/175 green. Phase 3 (notification flows) is next. - 2026-06-07 — Provisional holds (paid-ticket foundation). Booking stream now carries :booking/:hold/:confirm/:release/:cancel; the fold tracks per-actor seat STATE (:held / :confirmed). A held seat counts toward capacity, so a