From e2a90e3bbdfab1e865464660619e6c19bb3afa38 Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 19 Jun 2026 18:08:12 +0000 Subject: [PATCH] host: blog published-post read endpoint GET // -> HTML, 156/156 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit lib/host/blog.sx serves blog posts as HTML at GET // (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 --- lib/host/blog.sx | 50 +++++++++++++++++++++++ lib/host/conformance.sh | 17 ++++++++ lib/host/ledger.sx | 1 + lib/host/serve.sh | 30 ++++++++++++-- lib/host/tests/blog.sx | 85 ++++++++++++++++++++++++++++++++++++++++ lib/host/tests/ledger.sx | 17 +++++--- plans/host-on-sx.md | 12 +++++- 7 files changed, 200 insertions(+), 12 deletions(-) create mode 100644 lib/host/blog.sx create mode 100644 lib/host/tests/blog.sx diff --git a/lib/host/blog.sx b/lib/host/blog.sx new file mode 100644 index 00000000..049dec76 --- /dev/null +++ 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 // — 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 // -> 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 "Not found" + "

404

No published post: " slug "

"))))))) + +;; 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!) diff --git a/lib/host/conformance.sh b/lib/host/conformance.sh index 8b4d6b0c..05e8dd30 100755 --- 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" ) diff --git a/lib/host/ledger.sx b/lib/host/ledger.sx index f6a66f44..fc03be47 100644 --- 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") diff --git a/lib/host/serve.sh b/lib/host/serve.sh index 6f79032f..87ea91ef 100755 --- 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" diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx new file mode 100644 index 00000000..02899e73 --- /dev/null +++ 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 //; 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/"))) "

Hello SX

") + 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})) diff --git a/lib/host/tests/ledger.sx b/lib/host/tests/ledger.sx index d2c3b628..bd85a827 100644 --- 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! diff --git a/plans/host-on-sx.md b/plans/host-on-sx.md index 74532f49..1ea233cd 100644 --- 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 //` + 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