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

H2: auth-gate cinema/poll admin ops (TDD)

Browse Source 
Failing tests first (6 red: unauth /new-film created a film, etc). new-film / new-showing /
offering-add|update|remove / add-poll / new-event moved from the public route list into
host/blog-write-routes behind protect-html — same gate as every blog write. /vote, /buy-ticket,
/buy stay public (voters + customers) with explicit tests pinning that.

blog suite 234/234 (+9).

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
giles
2026-07-03 10:09:58 +00:00
parent 8e0f06aa28
commit eb54d17df9
2 changed files with 43 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -1346,6 +1346,39 @@
(starts-with? (dream-resp-body (host-bl-h1-post "/person?email=b@x.com" false)) "person:")
true)
;; ── HARDENING H2: cinema/poll ADMIN ops require auth; customer ops stay public ────────────
;; new-film / new-showing / offering-* / add-poll / new-event live behind protect-html (like /new);
;; /vote and /buy-ticket remain public (voters + customers).
(host/blog-use-store! (persist/open))
(define host-bl-h2-app
(host/make-app (list (host/blog-write-routes host-bl-resolve) host/blog-routes)))
(define host-bl-h2-loc
(fn (method target auth body)
(or (dream-resp-header
(host-bl-h2-app (host-bl-send method target auth "application/x-www-form-urlencoded" body))
"location") "")))
(host-bl-test "H2: unauth /new-film -> login redirect"
(starts-with? (host-bl-h2-loc "POST" "/new-film" false "title=Sneaky") "/login") true)
(host-bl-test "H2: unauth /new-film creates NO film"
(contains? (host/blog-slugs) "sneaky") false)
(host-bl-test "H2: authed /new-film creates the film"
(begin (host-bl-h2-loc "POST" "/new-film" "Bearer good" "title=Legit Film")
(contains? (host/blog--out-raw "legit-film" "is-a") "film"))
true)
(host-bl-test "H2: unauth /new-showing -> login redirect"
(starts-with? (host-bl-h2-loc "POST" "/new-showing" false "film=legit-film&calendar=c1&time=t") "/login") true)
(host-bl-test "H2: unauth /add-poll -> login redirect"
(starts-with? (host-bl-h2-loc "POST" "/add-poll?post=x" false "question=Q&options=a,b") "/login") true)
(host-bl-test "H2: unauth /offering-add -> login redirect"
(starts-with? (host-bl-h2-loc "POST" "/offering-add?showing=x" false "tickettype=tt&price=1") "/login") true)
(host-bl-test "H2: unauth /new-event -> login redirect"
(starts-with? (host-bl-h2-loc "POST" "/new-event" false "title=E") "/login") true)
(host-bl-test "H2: /vote stays PUBLIC (no login redirect)"
(starts-with? (host-bl-h2-loc "POST" "/vote?poll=p&option=o" false "voter=v@x.com") "/login") false)
(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)
(define
host-bl-tests-run!
(fn ()