coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
6419aa38c5f4581b90b9c67b02d5e7f8aa32831f
rose-ash/lib/host/tests/blog.sx
giles 6419aa38c5 host: discoverable log in / log out footer link 
Login had no visible entry point — you could only reach it by hitting a guard.
Add an auth footer the pages splice in: "log in" when logged out, "signed in
as <user> · log out" when logged in.

- host/auth-footer: SX fragment reading the session principal; guards a
  session-less request so it's safe to call anywhere.
- GET /logout added alongside POST so the footer link is a plain <a> (logout
  is low-harm; GET is acceptable). Clears the session, redirects home.
- home and post pages splice (host/auth-footer req) into their footer.

Tests: home + post footers show a login link when anonymous; GET /logout ->
303. 221/221. Verified live: anonymous shows "log in"; logged in shows
"signed in as admin · log out"; /logout reverts it.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-06-25 22:36:00 +00:00

230 lines
11 KiB
Plaintext
Raw Blame History

;; lib/host/tests/blog.sx — blog on the editor's content model. Posts are
;; {slug,title,sx_content,status} records in the durable KV; a post page is
;; render-to-html(parse sx_content). Covers read/render, home index, JSON list,
;; slugify, the form-urlencoded editor ingest, and JSON CRUD (auth+ACL guarded).
(define host-bl-pass 0)
(define host-bl-fail 0)
(define host-bl-fails (list))
(define
host-bl-test
(fn (name actual expected)
(if (= actual expected)
(set! host-bl-pass (+ host-bl-pass 1))
(begin
(set! host-bl-fail (+ host-bl-fail 1))
(append! host-bl-fails {:name name :actual actual :expected expected})))))
(define host-bl-req (fn (target) (dream-request "GET" target {} "")))
(define host-bl-app (host/make-app (list host/feed-routes host/blog-routes)))
;; ── slugify ─────────────────────────────────────────────────────────
(host-bl-test "slugify" (host/blog-slugify "Hello World") "hello-world")
(host-bl-test "slugify trims spaces" (host/blog-slugify " A B ") "a-b")
;; ── render a stored post ────────────────────────────────────────────
(host/blog-use-store! (persist/open))
(host/blog-put! "hello" "Hello World"
"(article (h1 \"Hello World\") (p \"A \" (strong \"bold\") \" word.\"))" "published")
(host-bl-test "post 200" (dream-status (host-bl-app (host-bl-req "/hello/"))) 200)
(host-bl-test "post content-type html"
(contains? (dream-resp-header (host-bl-app (host-bl-req "/hello/")) "content-type") "text/html")
true)
(host-bl-test "post renders sx_content markup"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/hello/"))) "<strong>bold</strong>")
true)
(host-bl-test "post title in page"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/hello/"))) "<title>Hello World</title>")
true)
;; ── home + list ─────────────────────────────────────────────────────
(host-bl-test "home lists post"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/"))) "href=\"/hello/\"")
true)
(host-bl-test "json list shows post"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/posts"))) "\"slug\":\"hello\"")
true)
(host-bl-test "GET /new shows form"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/new"))) "<form")
true)
;; ── unknown + precedence ────────────────────────────────────────────
(host-bl-test "unknown slug 404" (dream-status (host-bl-app (host-bl-req "/nope/"))) 404)
(feed/reset!)
(host-bl-test "/feed not captured by :slug"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/feed"))) "\"ok\":true")
true)
;; ── writes: editor form ingest + JSON CRUD (auth+ACL) ───────────────
(acl/load! (list (acl-grant "editor" "edit" "blog")))
(define host-bl-resolve
(fn (tok) (cond ((= tok "good") "editor") ((= tok "weak") "reader") (true nil))))
(define host-bl-wapp
(host/make-app (list (host/blog-write-routes host-bl-resolve) host/blog-routes)))
(define host-bl-send
(fn (method target auth ctype body)
(dream-request method target
(merge (if auth {:authorization auth} {}) (if ctype {:content-type ctype} {})) body)))
(host/blog-use-store! (persist/open))
;; -- editor form ingest (form-urlencoded, the editor's submit shape) --
(host-bl-test "form ingest no auth -> redirect to login"
(dream-status (host-bl-wapp (host-bl-send "POST" "/new" nil
"application/x-www-form-urlencoded" "title=X")))
303)
(host-bl-test "form ingest no auth Location is /login"
(contains? (dream-resp-header (host-bl-wapp (host-bl-send "POST" "/new" nil
"application/x-www-form-urlencoded" "title=X")) "location") "/login")
true)
(host-bl-test "form ingest authed -> 303 redirect"
(dream-status (host-bl-wapp (host-bl-send "POST" "/new" "Bearer good"
"application/x-www-form-urlencoded"
"title=My+First+Post&sx_content=(article+(h1+%22My+First+Post%22)+(p+%22Hi%22))&status=published")))
303)
(host-bl-test "form ingest set Location to the new slug"
(dream-resp-header
(host-bl-wapp (host-bl-send "POST" "/new" "Bearer good"
"application/x-www-form-urlencoded"
"title=Another+One&sx_content=(p+%22x%22)&status=published"))
"location")
"/another-one/")
(host-bl-test "ingested post renders"
(contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "<h1>My First Post</h1>")
true)
;; -- JSON CRUD --
(host-bl-test "json create -> 201"
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "application/json"
"{\"title\":\"Json Post\",\"sx_content\":\"(p \\\"jp\\\")\",\"status\":\"draft\"}")))
201)
(host-bl-test "json create unpermitted -> 403"
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer weak" "application/json"
"{\"title\":\"Nope\"}")))
403)
(host-bl-test "json create duplicate -> 409"
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "application/json"
"{\"slug\":\"json-post\",\"title\":\"Json Post\"}")))
409)
(host-bl-test "json create no title -> 400"
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "application/json" "{}")))
400)
(host-bl-test "update -> 200"
(dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/json-post" "Bearer good" "application/json"
"{\"sx_content\":\"(p \\\"edited\\\")\"}")))
200)
(host-bl-test "update changed content"
(contains? (dream-resp-body (host-bl-wapp (host-bl-req "/json-post/"))) "edited")
true)
(host-bl-test "update missing -> 404"
(dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/ghost" "Bearer good" "application/json" "{}")))
404)
(host-bl-test "delete -> 200"
(dream-status (host-bl-wapp (host-bl-send "DELETE" "/posts/json-post" "Bearer good" "" "")))
200)
(host-bl-test "deleted -> 404" (dream-status (host-bl-wapp (host-bl-req "/json-post/"))) 404)
(host-bl-test "delete missing -> 404"
(dream-status (host-bl-wapp (host-bl-send "DELETE" "/posts/ghost" "Bearer good" "" "")))
404)
;; -- write-time validation: malformed sx_content rejected, never stored --
;; "%3Ch1+broken%29" decodes to "<h1 broken)" — a typo'd paren the parser rejects.
(host-bl-test "form ingest malformed sx_content -> 400"
(dream-status (host-bl-wapp (host-bl-send "POST" "/new" "Bearer good"
"application/x-www-form-urlencoded"
"title=Bad+Form&sx_content=%3Ch1+broken%29&status=published")))
400)
(host-bl-test "rejected form post was not stored"
(dream-status (host-bl-wapp (host-bl-req "/bad-form/")))
404)
(host-bl-test "json create malformed sx_content -> 400"
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "application/json"
"{\"title\":\"Bad Json\",\"sx_content\":\"<h1 broken)\"}")))
400)
(host-bl-test "rejected json post was not stored"
(dream-status (host-bl-wapp (host-bl-req "/bad-json/")))
404)
(host-bl-test "json update malformed sx_content -> 400"
(dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/my-first-post" "Bearer good"
"application/json" "{\"sx_content\":\"<h1 broken)\"}")))
400)
(host-bl-test "rejected update left content intact"
(contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "<h1>My First Post</h1>")
true)
;; -- view source (public) --
(host-bl-test "view source -> 200"
(dream-status (host-bl-wapp (host-bl-req "/my-first-post/source"))) 200)
(host-bl-test "view source is text/plain"
(dream-resp-header (host-bl-wapp (host-bl-req "/my-first-post/source")) "content-type")
"text/plain; charset=utf-8")
(host-bl-test "view source returns raw sx_content"
(contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/source"))) "(article")
true)
(host-bl-test "view source missing -> 404"
(dream-status (host-bl-wapp (host-bl-req "/ghost/source"))) 404)
(host-bl-test "/:slug not shadowed by /:slug/source"
(dream-status (host-bl-wapp (host-bl-req "/my-first-post/"))) 200)
;; -- edit source (guarded GET form + guarded POST save) --
(host-bl-test "edit form no auth -> redirect to login"
(dream-status (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" nil "" ""))) 303)
(host-bl-test "edit form no auth Location carries next=/…/edit"
(contains?
(dream-resp-header (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" nil "" "")) "location")
"/login?next=/my-first-post/edit")
true)
(host-bl-test "edit form authed -> 200"
(dream-status (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" "Bearer good" "" ""))) 200)
(host-bl-test "edit form shows current source"
(contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" "Bearer good" "" "")))
"(article")
true)
(host-bl-test "edit submit no auth -> redirect to login"
(dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" nil
"application/x-www-form-urlencoded" "sx_content=(p+%22x%22)"))) 303)
(host-bl-test "edit submit authed -> 303"
(dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" "Bearer good"
"application/x-www-form-urlencoded"
"title=My+First+Post&sx_content=(p+%22edited+via+editor%22)&status=published"))) 303)
(host-bl-test "edit persisted the new content"
(contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "edited via editor")
true)
(host-bl-test "edit preserves the slug"
(dream-resp-header
(host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" "Bearer good"
"application/x-www-form-urlencoded" "title=Renamed&sx_content=(p+%22y%22)&status=draft"))
"location")
"/my-first-post/")
(host-bl-test "edit malformed body -> 400"
(dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" "Bearer good"
"application/x-www-form-urlencoded" "sx_content=%3Ch1+broken%29"))) 400)
(host-bl-test "edit missing post -> 404"
(dream-status (host-bl-wapp (host-bl-send "GET" "/ghost/edit" "Bearer good" "" ""))) 404)
;; -- auth footer (discoverable login/logout) --
(host-bl-test "home footer shows a log in link when anonymous"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/"))) ">log in</a>") true)
(host-bl-test "post footer shows a log in link when anonymous"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/my-first-post/"))) ">log in</a>") true)
(host-bl-test "GET /logout -> 303"
(dream-status (host-bl-app (host-bl-req "/logout"))) 303)
;; -- experimental unguarded create-only route (POST /new, no auth) --
(define host-bl-oapp (host/make-app (list host/blog-open-create-routes host/blog-routes)))
(host/blog-use-store! (persist/open))
(host-bl-test "open create no auth -> 303"
(dream-status (host-bl-oapp (host-bl-send "POST" "/new" nil
"application/x-www-form-urlencoded" "title=Open+Post&sx_content=(p+%22o%22)&status=published")))
303)
(host-bl-test "open-created post renders"
(contains? (dream-resp-body (host-bl-oapp (host-bl-req "/open-post/"))) "<p>o</p>")
true)
(define
host-bl-tests-run!
(fn ()
{:total (+ host-bl-pass host-bl-fail)
:passed host-bl-pass :failed host-bl-fail :fails host-bl-fails}))
Reference in New Issue View Git Blame Copy Permalink