Files
rose-ash/lib/host/tests/blog.sx
giles 7c11d4edaa
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 16s
host: per-request IO kernel fix + fully-dynamic blog (no cache), 159/159
KERNEL (sx_server.ml): route http-listen handlers through cek_run_with_io
instead of bare Sx_runtime.sx_call, so handlers resolve per-request IO
(durable persist reads/writes) via the same IO-driving runner the REPL uses.
Verified: per-request read+write, 10 concurrent writes (15 on disk, no
corruption), handler errors don't crash the server, http contract 6/6.

BLOG: fully dynamic — host/blog-post reads the post from the durable store
(content/head) AND renders (content/html) per request, no in-memory view, no
cached output. Possible because of the IO fix. Honest ~2s due to interpreted
Smalltalk render.

Render speed is NOT solved here: the JIT (precompiler) isn't installed in the
serving mode and currently miscompiles the Smalltalk evaluator's nested ASTs
(enabling it breaks ~60% of tests). Fixing the JIT is a separate, high-payoff
effort. Documented in the plan.

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

93 lines
3.3 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)
(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}))