coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

R1: per-offering cap is atomic stock — the store-shape of the seat race (TDD)

Browse Source 
Failing tests first (3 red: no offering pool stream; the sold-EDGE count was the only gate, so a
buy went through after the projection was wiped; the pool-refused buy leaked a showing seat). A
ticket now acquires from TWO atomic pools: the showing seat (physical capacity) AND the offering
allocation (stream 'offering:<off>', cap = its :cap field, ∞ if unset — so uncapped offerings are
unaffected). Both ev/hold! → guarded mint → confirm both / release both; offering-full releases the
seat. This is the co-op's product stock: in the store shape the offering IS the product and its cap
is the only pool, now genuinely atomic. Advisory offering-available? stays for button-hiding only.

blog suite 259/259 (+3).

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
giles
2026-07-03 11:58:24 +00:00
parent f561deede3
commit 071c2f9a8a
2 changed files with 60 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

31
lib/host/tests/blog.sx
View File

@@ -1560,6 +1560,37 @@
(host/blog--out-raw "h7a" "h7k"))
(list "h7b"))
;; ── R1: per-offering cap is ATOMIC stock (the store-shape of the seat race) ────────────────
;; A ticket consumes a seat (showing pool) AND an allocation (offering pool). The offering pool —
;; not the sold-edge count — is the gate; a pool-full buy must not leak a showing seat.
(host/blog-use-store! (persist/open))
(host/blog-put! "r1-show" "R1" "(article (h1 \"s\"))" "published")
(host/blog-relate! "r1-show" "showing" "is-a")
(host/blog--set-field-values! "r1-show" {"capacity" "100"})
(host/blog-put! "r1-show--vip" "vip" "(article (h1 \"o\"))" "published")
(host/blog-relate! "r1-show" "r1-show--vip" "offers")
(host/blog--set-field-values! "r1-show--vip" {"cap" "1"})
(set! host/blog--shop-base "http://mock-r1")
(set! host/blog--mint-ticket (fn (s o e) (str "ticket:t-" e)))
(define host-bl-r1-buy
(fn (email)
(host-bl-h2-app (dream-request "POST" "/buy-ticket?showing=r1-show&offering=r1-show--vip"
{:content-type "application/x-www-form-urlencoded"} (str "email=" email)))))
(host-bl-r1-buy "r1a@x.com")
(host-bl-test "R1: a capped-offering buy writes the atomic pool stream offering:<off>"
(> (len (ev/roster host/blog-store "offering:r1-show--vip")) 0) true)
;; wipe r1a's sold edge so the ADVISORY edge-count says "available" (0) — the pool must still gate.
(host/blog-unrelate! "r1-show--vip" (first (host/blog--out-raw "r1-show--vip" "sold")) "sold")
(define host-bl-r1-seatbefore (len (ev/roster host/blog-store "r1-show")))
(host-bl-r1-buy "r1b@x.com")
(host-bl-test "R1: the POOL is the gate — refused though the sold-edge projection is empty"
(contains? (host/blog--out-raw "r1-show--vip" "sold") "t-r1b@x.com") false)
(host-bl-test "R1: the pool-refused buy left NO showing seat (no leak)"
(len (ev/roster host/blog-store "r1-show")) host-bl-r1-seatbefore)
(set! host/blog--mint-ticket host-bl-h5-mint-was)
(set! host/blog--shop-base host-bl-h5-shop-was)
(define
host-bl-tests-run!
(fn ()