wire lib/events capacity-safe booking under the cinema buy path (first subsystem integration)
The events peer's ticket purchase now goes through lib/events' ATOMIC booking instead of a read-check-write race — real domain logic dropping in under the same clickable cinema, exactly as the seam promised. - MODULES (serve.sh + conformance.sh): load lib/persist/concurrency.sx (append-expect/conflict?) + lib/events/booking.sx. host/blog-store (persist/open) is stream-capable, same backend lib/events tests use. - host/blog-buy-ticket: replaced '(< (len sold) capacity)' with (ev/book! host/blog-store <showing> <capacity> <actor>); proceed only on :status :booked. occ-key = showing slug, capacity = host/blog--showing-capacity, actor = email + current roster len (unique per seat, collapses double-clicks, allows a person to hold several seats). persist append-expect retries on conflict — no oversell even under concurrent buys. - Per-offering cap + the sold-edge display are unchanged (render-safe); ev/book! is the authoritative gate in the handler. VERIFIED LIVE on events.rose-ash.com: cap-2 showing → 3 buys, exactly 2 booked (3rd refused); cap-1 showing → 10 CONCURRENT buys → exactly 1 sold, SOLD OUT. Sandbox: ev/book! returns booked/booked/full/already for a cap-2 occ. blog 218/218 (with the two new modules loaded). Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -3242,17 +3242,23 @@
|
||||
(email (or (host/field req "email") "")))
|
||||
(begin
|
||||
(when (and showing offering (not (= email ""))
|
||||
(< (len (host/blog--out-raw showing "sold")) (host/blog--showing-capacity showing))
|
||||
(host/blog--offering-available? offering)
|
||||
(not (= host/blog--shop-base "")))
|
||||
(let ((body (get (http-request "POST"
|
||||
(str host/blog--shop-base "/ticket?showing=" showing "&offering=" offering "&email=" email)
|
||||
{} "") "body")))
|
||||
(when (starts-with? body "ticket:")
|
||||
(let ((tid (substr body 7 (- (len body) 7))))
|
||||
(begin
|
||||
(host/blog-relate! showing tid "sold")
|
||||
(host/blog-relate! offering tid "sold")))))) ;; per-offering tally too
|
||||
;; lib/events ATOMIC capacity-safe booking (persist append-expect, retry-on-conflict) —
|
||||
;; replaces the former read-check-write race. A unique actor per seat (email + current
|
||||
;; count) lets one person hold several seats while collapsing double-clicks; :full ⇒ no
|
||||
;; oversell even under concurrent buys for the last seat.
|
||||
(let ((actor (str email "#" (str (len (ev/roster host/blog-store showing))))))
|
||||
(let ((bk (ev/book! host/blog-store showing (host/blog--showing-capacity showing) actor)))
|
||||
(when (= (get bk :status) :booked)
|
||||
(let ((body (get (http-request "POST"
|
||||
(str host/blog--shop-base "/ticket?showing=" showing "&offering=" offering "&email=" email)
|
||||
{} "") "body")))
|
||||
(when (starts-with? body "ticket:")
|
||||
(let ((tid (substr body 7 (- (len body) 7))))
|
||||
(begin
|
||||
(host/blog-relate! showing tid "sold")
|
||||
(host/blog-relate! offering tid "sold")))))))))
|
||||
(dream-redirect (str "/" showing "/"))))))
|
||||
;; the showing an offering belongs to (showing --offers--> offering).
|
||||
(define host/blog--offering-showing
|
||||
|
||||
@@ -72,6 +72,8 @@ MODULES=(
|
||||
"lib/persist/kv.sx"
|
||||
"lib/persist/api.sx"
|
||||
"lib/persist/durable.sx"
|
||||
"lib/persist/concurrency.sx"
|
||||
"lib/events/booking.sx"
|
||||
"spec/render.sx"
|
||||
"web/adapter-html.sx"
|
||||
"lib/dream/types.sx"
|
||||
|
||||
@@ -105,6 +105,8 @@ MODULES=(
|
||||
"lib/persist/kv.sx"
|
||||
"lib/persist/api.sx"
|
||||
"lib/persist/durable.sx"
|
||||
"lib/persist/concurrency.sx"
|
||||
"lib/events/booking.sx"
|
||||
"spec/render.sx"
|
||||
"web/adapter-html.sx"
|
||||
"lib/dream/types.sx"
|
||||
|
||||
Reference in New Issue
Block a user