coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

host: blog published-post read endpoint GET /<slug>/ -> HTML, 156/156
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 15s
Details

Browse Source 
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>
This commit is contained in:
giles
2026-06-19 18:08:12 +00:00
parent 2217a704a6
commit e2a90e3bbd
7 changed files with 200 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

50
lib/host/blog.sx Normal file
View File

@@ -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!)

17
lib/host/conformance.sh
View File

@@ -55,6 +55,21 @@ MODULES=(
"lib/feed/normalize.sx" "lib/feed/normalize.sx"
"lib/feed/stream.sx" "lib/feed/stream.sx"
"lib/feed/api.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/types.sx"
"lib/dream/json.sx" "lib/dream/json.sx"
"lib/dream/auth.sx" "lib/dream/auth.sx"
@@ -66,6 +81,7 @@ MODULES=(
"lib/host/router.sx" "lib/host/router.sx"
"lib/host/feed.sx" "lib/host/feed.sx"
"lib/host/relations.sx" "lib/host/relations.sx"
"lib/host/blog.sx"
"lib/host/server.sx" "lib/host/server.sx"
"lib/host/ledger.sx" "lib/host/ledger.sx"
) )
@@ -78,6 +94,7 @@ SUITES=(
"router host-rt-tests-run! lib/host/tests/router.sx" "router host-rt-tests-run! lib/host/tests/router.sx"
"feed host-fd-tests-run! lib/host/tests/feed.sx" "feed host-fd-tests-run! lib/host/tests/feed.sx"
"relations host-rl-tests-run! lib/host/tests/relations.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" "server host-sv-tests-run! lib/host/tests/server.sx"
"ledger host-lg-tests-run! lib/host/tests/ledger.sx" "ledger host-lg-tests-run! lib/host/tests/ledger.sx"
) )

1
lib/host/ledger.sx
View File

@@ -27,6 +27,7 @@
(define host/ledger (define host/ledger
(list (list
(host/ledger-entry "host" "GET" "/health" nil "native" "host/health-route") (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" "GET" "/feed" "feed:timeline" "migrated" "host/feed-timeline")
(host/ledger-entry "feed" "POST" "/feed" "feed:create" "migrated" "host/feed-create") (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") (host/ledger-entry "relations" "GET" "/internal/data/get-children" "relations:get_children" "migrated" "host/relations-children")

30
lib/host/serve.sh
View File

@@ -60,6 +60,21 @@ MODULES=(
"lib/feed/normalize.sx" "lib/feed/normalize.sx"
"lib/feed/stream.sx" "lib/feed/stream.sx"
"lib/feed/api.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/types.sx"
"lib/dream/json.sx" "lib/dream/json.sx"
"lib/dream/auth.sx" "lib/dream/auth.sx"
@@ -71,6 +86,7 @@ MODULES=(
"lib/host/router.sx" "lib/host/router.sx"
"lib/host/feed.sx" "lib/host/feed.sx"
"lib/host/relations.sx" "lib/host/relations.sx"
"lib/host/blog.sx"
"lib/host/server.sx" "lib/host/server.sx"
) )
@@ -79,9 +95,15 @@ EPOCH=1
for M in "${MODULES[@]}"; do for M in "${MODULES[@]}"; do
echo "(epoch $EPOCH)"; echo "(load \"$M\")"; EPOCH=$((EPOCH+1)) echo "(epoch $EPOCH)"; echo "(load \"$M\")"; EPOCH=$((EPOCH+1))
done 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)" echo "(epoch $EPOCH)"
# Anonymous read endpoints: feed timeline + relations container reads. Guarded 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.\\\"))\")"
# write groups (auth/ACL or internal-HMAC) are added here once their injected EPOCH=$((EPOCH+1))
# policy is supplied at wiring time. echo "(epoch $EPOCH)"
echo "(eval \"(host/serve $PORT (list host/feed-routes host/relations-routes))\")" # 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" } | exec "$SX_SERVER"

85
lib/host/tests/blog.sx Normal file
View File

@@ -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}))

17
lib/host/tests/ledger.sx
View File

@@ -50,8 +50,13 @@
(get (host/ledger-find host/ledger "POST" "/internal/actions/relate") :status) (get (host/ledger-find host/ledger "POST" "/internal/actions/relate") :status)
"proxied") "proxied")
(host-lg-test
"find migrated blog post -> handler"
(get (host/ledger-find host/ledger "GET" "/:slug") :handler)
"host/blog-post")
;; ── status queries ────────────────────────────────────────────────── ;; ── 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 "native count" (len (host/ledger-native host/ledger)) 1)
(host-lg-test "proxied count" (len (host/ledger-proxied host/ledger)) 7) (host-lg-test "proxied count" (len (host/ledger-proxied host/ledger)) 7)
@@ -72,7 +77,7 @@
;; ── domain queries ────────────────────────────────────────────────── ;; ── domain queries ──────────────────────────────────────────────────
(host-lg-test "relations domain count" (len (host/ledger-by-domain host/ledger "relations")) 7) (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 "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 (host-lg-test
"domains has relations" "domains has relations"
(some (fn (d) (= d "relations")) (host/ledger-domains host/ledger)) (some (fn (d) (= d "relations")) (host/ledger-domains host/ledger))
@@ -84,12 +89,12 @@
;; ── coverage ──────────────────────────────────────────────────────── ;; ── coverage ────────────────────────────────────────────────────────
(define host-lg-cov (host/ledger-coverage host/ledger)) (define host-lg-cov (host/ledger-coverage host/ledger))
(host-lg-test "coverage total" (get host-lg-cov :total) 14) (host-lg-test "coverage total" (get host-lg-cov :total) 15)
(host-lg-test "coverage migrated" (get host-lg-cov :migrated) 6) (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 proxied" (get host-lg-cov :proxied) 7)
(host-lg-test "coverage native" (get host-lg-cov :native) 1) (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 served" (get host-lg-cov :served) 8)
(host-lg-test "coverage percent" (get host-lg-cov :percent) 50) (host-lg-test "coverage percent" (get host-lg-cov :percent) 53)
(define (define
host-lg-tests-run! host-lg-tests-run!

12
plans/host-on-sx.md
View File

@@ -36,8 +36,8 @@ host — no `ocaml-on-sx` dependency.
## Status (rolling) ## Status (rolling)
`bash lib/host/conformance.sh` → **145/145** (8 suites: handler, middleware, sxtp, `bash lib/host/conformance.sh` → **156/156** (9 suites: handler, middleware, sxtp,
router, feed, relations, server, ledger). Phases 1 & 2 DONE; Phase 3 cut-over 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` 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` 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/ 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 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 bind re-points to the corrected file. Verified post-restart: blog serves, and
`sx.rose-ash.com`/`rose-ash.com` survived.) `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 - [ ] proxy-to-Quart fallback for un-migrated paths (strangler requirement before
a real subdomain fronts users). a real subdomain fronts users).
- [ ] internal-HMAC middleware on `/internal/*` (service-to-service auth; protocol - [ ] internal-HMAC middleware on `/internal/*` (service-to-service auth; protocol