giles
85e0af83f6
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
CRUD on the durable content store, per-request IO:
GET /posts list (public) -> [{slug,title}]
GET /<slug>/ read (public) -> HTML / 404
POST /posts create (auth+ACL edit/blog) -> 201/400/409
PUT /posts/<slug> update title+body -> 200/400/404
DELETE /posts/<slug> delete (truncate) -> 200/404
Writes behind the auth+ACL pipeline; create=insert ops, update=op-updates,
delete=stream truncate. 16 new CRUD tests (full lifecycle + 401/403/409/404).
GOTCHA fixed: is a reserved CEK special form — a (let ((guard ...)))
helper was shadowed by it ((guard h) ran the guard special form -> 'first:
expected list'). Renamed to host/blog--protect; namespace-prefix all helpers.
HARDENING: conformance.sh now FAILS LOUD on load/eval errors. A test file that
errors mid-load silently truncates its suite and reports a false green (this hid
the CRUD failure as 'blog 13 passed, 0 failed'). The runner greps for error
markers and aborts. Documented the SX gotcha set + prevention ladder in the plan.
Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
172 lines
6.5 KiB
Plaintext
172 lines
6.5 KiB
Plaintext
;; lib/host/tests/blog.sx — the blog published-post read endpoint. A registered
|
|
;; post renders to HTML at GET /<slug>/; unknown slugs 404. Also pins route
|
|
;; precedence: the catch-all :slug must NOT shadow domain routes mounted before it.
|
|
|
|
(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 {} "")))
|
|
;; feed mounted BEFORE blog so /feed is not captured by the :slug catch-all.
|
|
(define host-bl-app
|
|
(host/make-app (list host/feed-routes host/blog-routes)))
|
|
|
|
;; ── publish a post to a fresh in-memory store (hermetic) ────────────
|
|
(host/blog-use-store! (persist/open))
|
|
(host/blog-publish! "welcome" "Hello SX" "Served by lib/host." 1)
|
|
|
|
(host-bl-test
|
|
"post 200"
|
|
(dream-status (host-bl-app (host-bl-req "/welcome/")))
|
|
200)
|
|
(host-bl-test
|
|
"post content-type html"
|
|
(contains? (dream-resp-header (host-bl-app (host-bl-req "/welcome/")) "content-type") "text/html")
|
|
true)
|
|
(host-bl-test
|
|
"post renders heading"
|
|
(contains? (dream-resp-body (host-bl-app (host-bl-req "/welcome/"))) "<h1>Hello SX</h1>")
|
|
true)
|
|
(host-bl-test
|
|
"post renders body"
|
|
(contains? (dream-resp-body (host-bl-app (host-bl-req "/welcome/"))) "Served by lib/host.")
|
|
true)
|
|
;; trailing slash optional — /welcome and /welcome/ both resolve
|
|
(host-bl-test
|
|
"no trailing slash also 200"
|
|
(dream-status (host-bl-app (host-bl-req "/welcome")))
|
|
200)
|
|
|
|
;; golden: endpoint body == the exact rendered HTML of the published post
|
|
(host-bl-test
|
|
"golden render"
|
|
(dream-resp-body (host-bl-app (host-bl-req "/welcome/")))
|
|
"<h1>Hello SX</h1><p>Served by lib/host.</p>")
|
|
|
|
;; persistence: the store holds 2 blocks (op-log replay), lookup materialises the
|
|
;; doc from the store per call, and re-seeding is idempotent (no duplicate blocks).
|
|
(host-bl-test "store has 2 blocks" (content/count (content/head host/blog-store "welcome")) 2)
|
|
(host-bl-test "lookup materialises the doc" (content/count (host/blog-lookup "welcome")) 2)
|
|
(host/blog-seed! "welcome" "Hello SX" "Served by lib/host." 2)
|
|
(host-bl-test "re-seed is idempotent" (content/count (content/head host/blog-store "welcome")) 2)
|
|
|
|
;; ── unknown slug -> 404 ─────────────────────────────────────────────
|
|
(host-bl-test
|
|
"unknown slug 404"
|
|
(dream-status (host-bl-app (host-bl-req "/nope/")))
|
|
404)
|
|
(host-bl-test
|
|
"404 names the slug"
|
|
(contains? (dream-resp-body (host-bl-app (host-bl-req "/nope/"))) "nope")
|
|
true)
|
|
|
|
;; ── route precedence: domain routes win over the :slug catch-all ────
|
|
(feed/reset!)
|
|
(host-bl-test
|
|
"/feed served by feed, not blog 404"
|
|
(dream-status (host-bl-app (host-bl-req "/feed")))
|
|
200)
|
|
(host-bl-test
|
|
"/feed body is the feed envelope, not HTML"
|
|
(contains? (dream-resp-body (host-bl-app (host-bl-req "/feed"))) "\"ok\":true")
|
|
true)
|
|
|
|
;; ── CRUD: list / create / update / delete (writes auth+ACL guarded) ─
|
|
(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 body)
|
|
(dream-request method target (if auth {:authorization auth} {}) body)))
|
|
|
|
;; start from a clean store
|
|
(host/blog-use-store! (persist/open))
|
|
|
|
;; list empty
|
|
(host-bl-test "list empty -> data:[]"
|
|
(contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/posts" nil ""))) "\"data\":[]")
|
|
true)
|
|
|
|
;; create requires auth
|
|
(host-bl-test "create no auth -> 401"
|
|
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" nil "{}")))
|
|
401)
|
|
(host-bl-test "create authed-unpermitted -> 403"
|
|
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer weak"
|
|
"{\"slug\":\"hello\",\"title\":\"Hi\",\"body\":\"B\"}")))
|
|
403)
|
|
;; create permitted -> 201
|
|
(host-bl-test "create -> 201"
|
|
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good"
|
|
"{\"slug\":\"hello\",\"title\":\"Hello World\",\"body\":\"First post.\"}")))
|
|
201)
|
|
;; created post renders at GET /<slug>/
|
|
(host-bl-test "created post reads back as HTML"
|
|
(contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/hello/" nil ""))) "<h1>Hello World</h1>")
|
|
true)
|
|
;; appears in the list
|
|
(host-bl-test "list shows created post"
|
|
(contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/posts" nil ""))) "Hello World")
|
|
true)
|
|
;; create duplicate -> 409
|
|
(host-bl-test "create duplicate -> 409"
|
|
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good"
|
|
"{\"slug\":\"hello\",\"title\":\"X\",\"body\":\"Y\"}")))
|
|
409)
|
|
;; missing fields -> 400
|
|
(host-bl-test "create missing fields -> 400"
|
|
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "{\"slug\":\"x\"}")))
|
|
400)
|
|
|
|
;; update -> 200 and content changes
|
|
(host-bl-test "update -> 200"
|
|
(dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/hello" "Bearer good"
|
|
"{\"title\":\"Edited Title\",\"body\":\"Edited body.\"}")))
|
|
200)
|
|
(host-bl-test "update changed the rendered post"
|
|
(contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/hello/" nil ""))) "<h1>Edited Title</h1>")
|
|
true)
|
|
(host-bl-test "update missing post -> 404"
|
|
(dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/ghost" "Bearer good"
|
|
"{\"title\":\"T\",\"body\":\"B\"}")))
|
|
404)
|
|
(host-bl-test "update no auth -> 401"
|
|
(dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/hello" nil "{}")))
|
|
401)
|
|
|
|
;; delete -> 200, then gone (404) and absent from list
|
|
(host-bl-test "delete -> 200"
|
|
(dream-status (host-bl-wapp (host-bl-send "DELETE" "/posts/hello" "Bearer good" "")))
|
|
200)
|
|
(host-bl-test "deleted post -> 404"
|
|
(dream-status (host-bl-wapp (host-bl-send "GET" "/hello/" nil "")))
|
|
404)
|
|
(host-bl-test "deleted post gone from list"
|
|
(contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/posts" nil ""))) "hello")
|
|
false)
|
|
(host-bl-test "delete missing -> 404"
|
|
(dream-status (host-bl-wapp (host-bl-send "DELETE" "/posts/ghost" "Bearer good" "")))
|
|
404)
|
|
|
|
(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}))
|