host: blog published-post read endpoint GET /<slug>/ -> HTML, 156/156

lib/host/blog.sx serves blog posts as HTML at GET /<slug>/ (the original strangler target, Quart blog post_detail). A post is a content-on-sx CtDoc rendered via content/html; anonymous + world-visible. In-memory slug->doc registry now (host/blog-lookup swappable for a persist-backed content stream later, handler/route unchanged). :slug catch-all mounted LAST so /feed, /health, /internal/* take precedence. Needs the Smalltalk+persist+content preload chain + (st-bootstrap-classes!)+(content/bootstrap!) — blog.sx self-bootstraps at load. serve.sh loads the chain + seeds a welcome post. Ledger gains the migrated blog post-detail (off-Quart 50% -> 53%). LIVE: blog.rose-ash.com/welcome/ renders real HTML through Cloudflare->Caddy; /feed still JSON (precedence verified), unknown slug 404. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-06-19 18:08:12 +00:00
parent 2217a704a6
commit e2a90e3bbd
7 changed files with 200 additions and 12 deletions
--- a/lib/host/blog.sx
+++ b/lib/host/blog.sx
@@ -0,0 +1,50 @@
+;; lib/host/blog.sx — Blog domain on the host. Serves published posts as HTML at
+;; GET /<slug>/ — the original strangler target (Quart: blog/bp/post/routes.py,
+;; handler post_detail). Published posts are world-visible, so this endpoint is
+;; ANONYMOUS — no auth, visibility is trivially "visible".
+;;
+;; A post is a content-on-sx document (CtDoc) rendered to HTML via the content
+;; facade (content/html). Posts live in an in-memory registry keyed by slug: this
+;; is the "prove the machinery" step — swap host/blog-lookup for a persist-backed
+;; content stream later without touching the handler or the route.
+;; Depends on lib/content/* (+ the Smalltalk + persist preloads its classes need)
+;; + lib/dream/* + lib/host/handler.sx.
+
+;; Register the content class table + render methods (idempotent). Must run before
+;; any CtDoc is built/rendered; called at module load below.
+(define host/blog-bootstrap!
+  (fn () (begin (st-bootstrap-classes!) (content/bootstrap!))))
+
+;; ── in-memory post registry (slug -> CtDoc) ─────────────────────────
+(define host/blog-posts {})
+(define host/blog-register!
+  (fn (slug doc) (set! host/blog-posts (assoc host/blog-posts slug doc))))
+(define host/blog-lookup (fn (slug) (get host/blog-posts slug)))
+(define host/blog-reset! (fn () (set! host/blog-posts {})))
+
+;; Build a simple post doc (title heading + body paragraph). Convenience for
+;; seeding and tests; real posts arrive from the content store.
+(define host/blog-make
+  (fn (slug title body)
+    (doc-append
+      (doc-append (doc-empty slug) (mk-heading (str slug "-h") 1 title))
+      (mk-text (str slug "-body") body))))
+
+;; ── handler: GET /<slug>/ -> rendered HTML (200) or 404 ─────────────
+(define host/blog-post
+  (fn (req)
+    (let ((slug (dream-param req "slug")))
+      (let ((doc (host/blog-lookup slug)))
+        (if doc
+          (dream-html (content/html doc))
+          (dream-html-status 404
+            (str "<!doctype html><title>Not found</title>"
+              "<h1>404</h1><p>No published post: " slug "</p>")))))))
+
+;; Anonymous read route. MUST be mounted LAST: the :slug pattern matches any
+;; single-segment path, so domain routes (/feed, /health) take precedence.
+(define host/blog-routes
+  (list (dream-get "/:slug" host/blog-post)))
+
+;; Self-bootstrap at load (content modules are loaded before this one).
+(host/blog-bootstrap!)
--- a/lib/host/conformance.sh
+++ b/lib/host/conformance.sh
@@ -55,6 +55,21 @@ MODULES=(
  "lib/feed/normalize.sx"
  "lib/feed/stream.sx"
  "lib/feed/api.sx"
+  "lib/smalltalk/tokenizer.sx"
+  "lib/smalltalk/parser.sx"
+  "lib/guest/reflective/class-chain.sx"
+  "lib/smalltalk/runtime.sx"
+  "lib/guest/reflective/env.sx"
+  "lib/smalltalk/eval.sx"
+  "lib/persist/event.sx"
+  "lib/persist/backend.sx"
+  "lib/persist/log.sx"
+  "lib/persist/kv.sx"
+  "lib/persist/api.sx"
+  "lib/content/block.sx"
+  "lib/content/doc.sx"
+  "lib/content/render.sx"
+  "lib/content/api.sx"
  "lib/dream/types.sx"
  "lib/dream/json.sx"
  "lib/dream/auth.sx"
@@ -66,6 +81,7 @@ MODULES=(
  "lib/host/router.sx"
  "lib/host/feed.sx"
  "lib/host/relations.sx"
+  "lib/host/blog.sx"
  "lib/host/server.sx"
  "lib/host/ledger.sx"
 )
@@ -78,6 +94,7 @@ SUITES=(
  "router      host-rt-tests-run!  lib/host/tests/router.sx"
  "feed        host-fd-tests-run!  lib/host/tests/feed.sx"
  "relations   host-rl-tests-run!  lib/host/tests/relations.sx"
+  "blog        host-bl-tests-run!  lib/host/tests/blog.sx"
  "server      host-sv-tests-run!  lib/host/tests/server.sx"
  "ledger      host-lg-tests-run!  lib/host/tests/ledger.sx"
 )
--- a/lib/host/ledger.sx
+++ b/lib/host/ledger.sx
@@ -27,6 +27,7 @@
 (define host/ledger
  (list
    (host/ledger-entry "host"      "GET"  "/health"                     nil                         "native"   "host/health-route")
+    (host/ledger-entry "blog"      "GET"  "/:slug"                      "blog:post_detail"          "migrated" "host/blog-post")
    (host/ledger-entry "feed"      "GET"  "/feed"                       "feed:timeline"             "migrated" "host/feed-timeline")
    (host/ledger-entry "feed"      "POST" "/feed"                       "feed:create"               "migrated" "host/feed-create")
    (host/ledger-entry "relations" "GET"  "/internal/data/get-children"  "relations:get_children"  "migrated" "host/relations-children")
--- a/lib/host/serve.sh
+++ b/lib/host/serve.sh
@@ -60,6 +60,21 @@ MODULES=(
  "lib/feed/normalize.sx"
  "lib/feed/stream.sx"
  "lib/feed/api.sx"
+  "lib/smalltalk/tokenizer.sx"
+  "lib/smalltalk/parser.sx"
+  "lib/guest/reflective/class-chain.sx"
+  "lib/smalltalk/runtime.sx"
+  "lib/guest/reflective/env.sx"
+  "lib/smalltalk/eval.sx"
+  "lib/persist/event.sx"
+  "lib/persist/backend.sx"
+  "lib/persist/log.sx"
+  "lib/persist/kv.sx"
+  "lib/persist/api.sx"
+  "lib/content/block.sx"
+  "lib/content/doc.sx"
+  "lib/content/render.sx"
+  "lib/content/api.sx"
  "lib/dream/types.sx"
  "lib/dream/json.sx"
  "lib/dream/auth.sx"
@@ -71,6 +86,7 @@ MODULES=(
  "lib/host/router.sx"
  "lib/host/feed.sx"
  "lib/host/relations.sx"
+  "lib/host/blog.sx"
  "lib/host/server.sx"
 )

@@ -79,9 +95,15 @@ EPOCH=1
  for M in "${MODULES[@]}"; do
    echo "(epoch $EPOCH)"; echo "(load \"$M\")"; EPOCH=$((EPOCH+1))
  done
+  # Seed a welcome post so blog.rose-ash.com/welcome/ renders live (until posts
+  # arrive from a persist-backed content store).
  echo "(epoch $EPOCH)"
-  # Anonymous read endpoints: feed timeline + relations container reads. Guarded
-  # write groups (auth/ACL or internal-HMAC) are added here once their injected
-  # policy is supplied at wiring time.
-  echo "(eval \"(host/serve $PORT (list host/feed-routes host/relations-routes))\")"
+  echo "(eval \"(host/blog-register! \\\"welcome\\\" (host/blog-make \\\"welcome\\\" \\\"Welcome to the SX host\\\" \\\"This page is rendered by lib/host on the SX runtime — no Quart.\\\"))\")"
+  EPOCH=$((EPOCH+1))
+  echo "(epoch $EPOCH)"
+  # Anonymous read endpoints: feed timeline + relations container reads + blog
+  # post detail (blog-routes LAST — the :slug catch-all must not shadow the rest).
+  # Guarded write groups (auth/ACL or internal-HMAC) are added here once their
+  # injected policy is supplied at wiring time.
+  echo "(eval \"(host/serve $PORT (list host/feed-routes host/relations-routes host/blog-routes))\")"
 } | exec "$SX_SERVER"
--- a/lib/host/tests/blog.sx
+++ b/lib/host/tests/blog.sx
@@ -0,0 +1,85 @@
+;; 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)))
+
+;; ── render a registered post ────────────────────────────────────────
+(host/blog-reset!)
+(host/blog-register! "welcome" (host/blog-make "welcome" "Hello SX" "Served by lib/host."))
+
+(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 == content facade render of the same doc
+(host-bl-test
+  "golden = content/html"
+  (dream-resp-body (host-bl-app (host-bl-req "/welcome/")))
+  (content/html (host/blog-make "welcome" "Hello SX" "Served by lib/host.")))
+
+;; ── 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}))
--- a/lib/host/tests/ledger.sx
+++ b/lib/host/tests/ledger.sx
@@ -50,8 +50,13 @@
  (get (host/ledger-find host/ledger "POST" "/internal/actions/relate") :status)
  "proxied")

+(host-lg-test
+  "find migrated blog post -> handler"
+  (get (host/ledger-find host/ledger "GET" "/:slug") :handler)
+  "host/blog-post")
+
 ;; ── status queries ──────────────────────────────────────────────────
-(host-lg-test "migrated count" (len (host/ledger-migrated host/ledger)) 6)
+(host-lg-test "migrated count" (len (host/ledger-migrated host/ledger)) 7)
 (host-lg-test "native count" (len (host/ledger-native host/ledger)) 1)
 (host-lg-test "proxied count" (len (host/ledger-proxied host/ledger)) 7)

@@ -72,7 +77,7 @@
 ;; ── domain queries ──────────────────────────────────────────────────
 (host-lg-test "relations domain count" (len (host/ledger-by-domain host/ledger "relations")) 7)
 (host-lg-test "likes domain count" (len (host/ledger-by-domain host/ledger "likes")) 4)
-(host-lg-test "domains count" (len (host/ledger-domains host/ledger)) 4)
+(host-lg-test "domains count" (len (host/ledger-domains host/ledger)) 5)
 (host-lg-test
  "domains has relations"
  (some (fn (d) (= d "relations")) (host/ledger-domains host/ledger))
@@ -84,12 +89,12 @@

 ;; ── coverage ────────────────────────────────────────────────────────
 (define host-lg-cov (host/ledger-coverage host/ledger))
-(host-lg-test "coverage total" (get host-lg-cov :total) 14)
-(host-lg-test "coverage migrated" (get host-lg-cov :migrated) 6)
+(host-lg-test "coverage total" (get host-lg-cov :total) 15)
+(host-lg-test "coverage migrated" (get host-lg-cov :migrated) 7)
 (host-lg-test "coverage proxied" (get host-lg-cov :proxied) 7)
 (host-lg-test "coverage native" (get host-lg-cov :native) 1)
-(host-lg-test "coverage served" (get host-lg-cov :served) 7)
-(host-lg-test "coverage percent" (get host-lg-cov :percent) 50)
+(host-lg-test "coverage served" (get host-lg-cov :served) 8)
+(host-lg-test "coverage percent" (get host-lg-cov :percent) 53)

 (define
  host-lg-tests-run!
--- a/plans/host-on-sx.md
+++ b/plans/host-on-sx.md
@@ -36,8 +36,8 @@ host — no `ocaml-on-sx` dependency.

 ## Status (rolling)

-`bash lib/host/conformance.sh` → **145/145** (8 suites: handler, middleware, sxtp,
-router, feed, relations, server, ledger). Phases 1 & 2 DONE; Phase 3 cut-over
+`bash lib/host/conformance.sh` → **156/156** (9 suites: handler, middleware, sxtp,
+router, feed, relations, blog, server, ledger). Phases 1 & 2 DONE; Phase 3 cut-over
 landed (50% off Quart). **The host now serves live HTTP** — `lib/host/server.sx`
 bridges the native `http-listen` server to the Dream app and `lib/host/serve.sh`
 boots it (verified: GET /health, /feed, /feed?actor=, relations get-children/
@@ -147,6 +147,14 @@ lib/host/sxtp.sx                        subsystem APIs (feed/search/commerce/…
      via reload-from-non-bind-path, then RECONCILED by restarting Caddy so the
      bind re-points to the corrected file. Verified post-restart: blog serves, and
      `sx.rose-ash.com`/`rose-ash.com` survived.)
+- [x] blog published-post read endpoint — `lib/host/blog.sx`: `GET /<slug>/`
+      renders a content-on-sx `CtDoc` to HTML via `content/html` (anonymous,
+      world-visible). In-memory slug→doc registry now (swap `host/blog-lookup` for
+      a persist-backed content stream later, handler/route unchanged). `:slug`
+      catch-all mounted LAST so domain routes win. **LIVE**: `blog.rose-ash.com/
+      welcome/` renders real HTML through Caddy. Needs Smalltalk+persist+content
+      preloads + `(st-bootstrap-classes!)`+`(content/bootstrap!)` (self-bootstraps
+      at load).
 - [ ] proxy-to-Quart fallback for un-migrated paths (strangler requirement before
      a real subdomain fronts users).
 - [ ] internal-HMAC middleware on `/internal/*` (service-to-service auth; protocol