H5: two-phase buy — hold → guarded mint → confirm/release (TDD, seat-leak fix)
Failing tests first (red: a failed mint left the seat consumed — the cross-domain leak; a RAISING mint escaped the handler entirely, proving no guard). host/blog--mint-ticket is now an injectable seam (default: signed HTTP to the shop). buy-ticket: ev/hold! reserves (capacity-counted, atomic) → mint runs inside (guard (e (true "")) ...) → 'ticket:' ⇒ ev/confirm! + sold edges + a 'sell' activity (H4's missing emission); anything else ⇒ ev/release! frees the seat. Held seats count toward capacity, so a pending mint can't be oversold either. blog suite 247/247 (+3). Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -1463,6 +1463,47 @@
|
||||
(some (fn (e) (contains? (str e) "secret@x.com")) host/blog--activity-log)))))
|
||||
(list true false))
|
||||
|
||||
;; ── HARDENING H5: hold→confirm→release — a failed mint must NOT consume the seat ──────────
|
||||
;; The buy is two-phase: ev/hold! reserves; the mint (injectable seam host/blog--mint-ticket) runs
|
||||
;; guarded; success → ev/confirm! + sold edges + a sell activity; failure/raise → ev/release!.
|
||||
(host/blog-use-store! (persist/open))
|
||||
(host/blog-put! "h5-show" "H5 Showing" "(article (h1 \"s\"))" "published")
|
||||
(host/blog-relate! "h5-show" "showing" "is-a")
|
||||
(host/blog--set-field-values! "h5-show" {"capacity" "2"})
|
||||
(host/blog-put! "h5-show--adult" "adult @ h5" "(article (h1 \"o\"))" "published")
|
||||
(host/blog-relate! "h5-show" "h5-show--adult" "offers")
|
||||
(define host-bl-h5-shop-was host/blog--shop-base)
|
||||
(define host-bl-h5-mint-was host/blog--mint-ticket)
|
||||
(set! host/blog--shop-base "http://mock-shop")
|
||||
(define host-bl-h5-buy
|
||||
(fn (email)
|
||||
(host-bl-h2-app (dream-request "POST" "/buy-ticket?showing=h5-show&offering=h5-show--adult"
|
||||
{:content-type "application/x-www-form-urlencoded"} (str "email=" email)))))
|
||||
|
||||
(host-bl-test "H5: FAILED mint releases the seat (no leak)"
|
||||
(begin
|
||||
(set! host/blog--mint-ticket (fn (s o e) "")) ;; shop says no
|
||||
(host-bl-h5-buy "leak@x.com")
|
||||
(len (ev/roster host/blog-store "h5-show")))
|
||||
0)
|
||||
(host-bl-test "H5: RAISING mint also releases (guarded)"
|
||||
(begin
|
||||
(set! host/blog--mint-ticket (fn (s o e) (raise "shop down")))
|
||||
(host-bl-h5-buy "crash@x.com")
|
||||
(len (ev/roster host/blog-store "h5-show")))
|
||||
0)
|
||||
(host-bl-test "H5: successful mint confirms seat + sold edge + sell activity"
|
||||
(begin
|
||||
(set! host/blog--mint-ticket (fn (s o e) "ticket:h5-t1"))
|
||||
(set! host/blog--activity-log (list))
|
||||
(host-bl-h5-buy "ok@x.com")
|
||||
(list (len (ev/roster host/blog-store "h5-show"))
|
||||
(contains? (host/blog--out-raw "h5-show" "sold") "h5-t1")
|
||||
(contains? (map (fn (e) (get e "verb")) host/blog--activity-log) "sell")))
|
||||
(list 1 true true))
|
||||
(set! host/blog--shop-base host-bl-h5-shop-was)
|
||||
(set! host/blog--mint-ticket host-bl-h5-mint-was)
|
||||
|
||||
(define
|
||||
host-bl-tests-run!
|
||||
(fn ()
|
||||
|
||||
Reference in New Issue
Block a user