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

H3: votes are atomic claims on the persist stream (TDD)

Browse Source 
Failing tests first (2 red: the vote wasn't on the stream, and dedup vanished if the projection
edge was removed — proving it was an edge-scan). host/blog-vote now acquires on stream
'vote:<poll>' via ev/book! (append-expect, retry-on-conflict — the same atomicity as seats);
the option --voted--> edge is a projection recorded only on :booked. Removed the read-check-write
host/blog--voted-in-poll?. Governance-grade: no double vote under concurrency, dedup survives
projection wipes + restarts (store-backed).

blog suite 238/238 (+4).

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
giles
2026-07-03 10:12:32 +00:00
parent eb54d17df9
commit f1238c1a38
2 changed files with 40 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -1379,6 +1379,39 @@
(host-bl-test "H2: /buy-ticket stays PUBLIC (no login redirect)"
(starts-with? (host-bl-h2-loc "POST" "/buy-ticket?showing=s&offering=o" false "email=v@x.com") "/login") false)
;; ── HARDENING H3: votes are ATOMIC claims on the persist stream (not edge-scan dedup) ─────
;; One vote per voter per poll enforced by an ev/book!-style acquire on stream "vote:<poll>" —
;; the same append-expect atomicity as seats. The edge is a projection; the stream is truth.
(host/blog-use-store! (persist/open))
(host/blog-put! "h3-poll" "Q" "(article (h1 \"p\"))" "published")
(host/blog-relate! "h3-poll" "poll" "is-a")
(for-each (fn (o) (begin (host/blog-put! o o "(article (h1 \"o\"))" "published")
(host/blog-relate! "h3-poll" o "option")))
(list "h3-opt-a" "h3-opt-b"))
(define host-bl-h3-vote
(fn (opt voter)
(host-bl-h2-app (dream-request "POST" (str "/vote?poll=h3-poll&option=" opt)
{:content-type "application/x-www-form-urlencoded"} (str "voter=" voter)))))
(host-bl-test "H3: first vote lands"
(begin (host-bl-h3-vote "h3-opt-a" "v1@x.com")
(contains? (host/blog--out-raw "h3-opt-a" "voted") "v1@x.com"))
true)
(host-bl-test "H3: second vote by same voter refused (different option)"
(begin (host-bl-h3-vote "h3-opt-b" "v1@x.com")
(contains? (host/blog--out-raw "h3-opt-b" "voted") "v1@x.com"))
false)
(host-bl-test "H3: the vote is on the persist stream (roster of vote:<poll>)"
(contains? (ev/roster host/blog-store "vote:h3-poll") "v1@x.com")
true)
(host-bl-test "H3: dedup is store-backed — survives edge removal (NOT an edge scan)"
(begin
(host-bl-h3-vote "h3-opt-a" "v2@x.com")
(host/blog-unrelate! "h3-opt-a" "v2@x.com" "voted") ;; wipe the projection
(host-bl-h3-vote "h3-opt-b" "v2@x.com") ;; revote attempt
(contains? (host/blog--out-raw "h3-opt-b" "voted") "v2@x.com"))
false)
(define
host-bl-tests-run!
(fn ()