diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 66d4c4a5..0754fb77 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -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 diff --git a/lib/host/conformance.sh b/lib/host/conformance.sh index e3270964..c47b1162 100755 --- a/lib/host/conformance.sh +++ b/lib/host/conformance.sh @@ -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" diff --git a/lib/host/serve.sh b/lib/host/serve.sh index dc86e1f8..af582d6b 100755 --- a/lib/host/serve.sh +++ b/lib/host/serve.sh @@ -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"