host: blog on the editor's sx_content model + render-to-html, 171/171

Pivot blog to the SX editor's content model. The editor (blog/sx/editor.sx)
emits sx_content = SX element markup, NOT content-on-sx CtDoc blocks. So a post
is now a {slug,title,sx_content,status} record in the durable persist KV, and a
post page is render-to-html(parse sx_content) — server-side, static, no client
runtime needed to view.

Endpoints: GET / (HTML index), /<slug>/ (rendered post), /posts (JSON list),
/new (create form); POST /new (form-urlencoded editor ingest, slug from title,
303 redirect), POST /posts (JSON create), PUT/DELETE /posts/<slug>. Writes
behind auth+ACL (edit/blog). Dropped the content-on-sx/Smalltalk preload chain;
added spec/render + web/adapter-html (render-to-html) + lib/dream/form.

BONUS: render-to-html is ~0ms (vs the 2s content-on-sx Smalltalk asHTML) — it
doesn't hit the JIT-miscompiled path, so blog rendering is no longer slow.

Live: blog.rose-ash.com/ lists posts, /welcome/ renders instantly. Reads live;
the form-ingest write path needs an auth decision before going live (browser
forms can't send bearer; needs session or a Caddy basicauth gate).

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>

lib/host/blog.sx

@@ -1,113 +1,87 @@
-;; lib/host/blog.sx — Blog domain on the host. Posts are content-on-sx documents
-;; whose source of truth is the durable SX store (persist op-log on disk). Full
-;; post CRUD, all dispatching to the content store per request (per-request IO):
-;;   GET    /posts        list posts (public)        -> JSON [{slug,title}]
-;;   GET    /<slug>/      read a post (public)       -> rendered HTML / 404
-;;   POST   /posts        create (guarded)           -> 201 / 400 / 409
-;;   PUT    /posts/<slug> update title+body (guarded)-> 200 / 400 / 404
-;;   DELETE /posts/<slug> delete (guarded)           -> 200 / 404
-;; Reads are anonymous (published posts are world-visible); writes run behind the
-;; auth + ACL pipeline ("edit" on "blog"), like the editor would require.
+;; lib/host/blog.sx — Blog domain on the host, on the EDITOR's content model.
+;; The SX post editor (blog/sx/editor.sx) emits `sx_content`: SX element markup
+;; (e.g. "(article (h1 \"T\") (p \"body\" (strong \"x\")))"), NOT content-on-sx
+;; CtDoc blocks. So a post here is a record {slug,title,sx_content,status} stored
+;; in the durable persist KV, and a post page is `render-to-html (parse sx_content)`
+;; — server-side, static, no client runtime needed to view a published post.
 ;;
-;; A post is two blocks under stream "content:<slug>": a heading (id "<slug>-h")
-;; and a body paragraph (id "<slug>-body"). create appends insert ops, update
-;; appends op-updates to those ids, delete truncates the stream. Materialising +
-;; rendering happens per request (interpreted Smalltalk render is ~2s — a JIT
-;; concern, tracked separately, NOT solved by caching).
-;; Depends on lib/content/* (+ Smalltalk + persist preloads) + lib/dream/* +
-;; lib/host/{handler,middleware}.sx.
+;;   GET    /              HTML index of posts (public)
+;;   GET    /<slug>/       rendered post (public) -> HTML / 404
+;;   GET    /posts         JSON list (public)     -> [{slug,title,status}]
+;;   GET    /new           HTML create form (public chrome)
+;;   POST   /new           form-urlencoded ingest from the editor (guarded)
+;;   POST   /posts         JSON create (guarded)
+;;   PUT    /posts/<slug>  JSON update (guarded)
+;;   DELETE /posts/<slug>  delete (guarded)
+;; Reads anonymous; writes behind the auth+ACL pipeline ("edit" on "blog").
+;; Depends on spec/render + web/adapter-html (render-to-html), lib/persist/*
+;; (durable KV), lib/dream/* (+ form), lib/host/{handler,middleware}.sx.
 
-;; Register content classes + render methods (idempotent); called at load below.
-(define host/blog-bootstrap!
-  (fn () (begin (st-bootstrap-classes!) (content/bootstrap!))))
-
-;; ── store (durable source of truth, injectable) + logical clock ─────
+;; ── store (durable persist KV, injectable) ──────────────────────────
 (define host/blog-store (persist/open))
 (define host/blog-use-store! (fn (b) (set! host/blog-store b)))
-(define host/blog-clock 0)
-(define host/blog-tick! (fn () (begin (set! host/blog-clock (+ host/blog-clock 1)) host/blog-clock)))
+(define host/blog--key (fn (slug) (str "blog:" slug)))
 
-;; content streams are keyed "content:<slug>"; recover the slug ("content:" = 8).
-(define host/blog--stream-slug
-  (fn (stream) (if (starts-with? stream "content:") (substr stream 8) nil)))
+;; slug from a title: lowercase, words joined by '-'. (Punctuation kept simple.)
+(define host/blog-slugify
+  (fn (title)
+    (join "-" (filter (fn (w) (not (= w ""))) (split (lower title) " ")))))
 
-;; ── post helpers (per-request, against the store) ───────────────────
+;; ── records ─────────────────────────────────────────────────────────
+(define host/blog-get
+  (fn (slug) (persist/backend-kv-get host/blog-store (host/blog--key slug))))
 (define host/blog-exists?
-  (fn (slug) (> (content/count (content/head host/blog-store slug)) 0)))
-
-;; First heading's text, else a placeholder.
-(define host/blog-title
-  (fn (doc)
-    (let ((hs (filter (fn (b) (= (blk-type b) "heading")) (content/blocks doc))))
-      (if (> (len hs) 0) (str (blk-get (first hs) "text")) "(untitled)"))))
-
-;; Create: append the post's insert ops to its stream.
-(define host/blog-publish!
-  (fn (slug title body at)
-    (let ((hid (str slug "-h")) (tid (str slug "-body")))
-      (content/commit-all! host/blog-store slug
-        (list
-          (op-insert (mk-heading hid 1 title) nil)
-          (op-insert (mk-text tid body) hid))
-        at))))
-
-;; Update: append op-updates to the post's heading + body blocks.
-(define host/blog-update!
-  (fn (slug title body at)
-    (let ((hid (str slug "-h")) (tid (str slug "-body")))
-      (content/commit-all! host/blog-store slug
-        (list (op-update hid "text" title) (op-update tid "text" body))
-        at))))
-
-;; Delete: truncate the post's stream (clears all content -> lookup nil -> 404).
+  (fn (slug) (persist/backend-kv-has? host/blog-store (host/blog--key slug))))
+(define host/blog-put!
+  (fn (slug title sx-content status)
+    (persist/backend-kv-put host/blog-store (host/blog--key slug)
+      {:slug slug :title title :sx-content sx-content :status status})))
 (define host/blog-delete!
-  (fn (slug)
-    (let ((stream (content/-stream slug)))
-      (persist/truncate host/blog-store stream (persist/last-seq host/blog-store stream)))))
-
-;; Idempotent seed: publish only if the slug has no content yet.
+  (fn (slug) (persist/backend-kv-delete host/blog-store (host/blog--key slug))))
 (define host/blog-seed!
-  (fn (slug title body at)
-    (when (= (content/count (content/head host/blog-store slug)) 0)
-      (host/blog-publish! slug title body at))))
+  (fn (slug title sx-content status)
+    (when (not (host/blog-exists? slug)) (host/blog-put! slug title sx-content status))))
 
-;; Materialise the post from the store by replaying its op-log; nil if no content.
-(define host/blog-lookup
-  (fn (slug)
-    (let ((doc (content/head host/blog-store slug)))
-      (if (> (content/count doc) 0) doc nil))))
-
-;; All posts with content, as [{:slug :title}].
-(define host/blog-list
+;; all blog slugs (kv keys are "blog:<slug>")
+(define host/blog-slugs
   (fn ()
     (reduce
-      (fn (acc stream)
-        (let ((slug (host/blog--stream-slug stream)))
-          (if slug
-            (let ((doc (content/head host/blog-store slug)))
-              (if (> (content/count doc) 0)
-                (append acc (list {:slug slug :title (host/blog-title doc)}))
-                acc))
-            acc)))
+      (fn (acc k)
+        (if (starts-with? k "blog:") (append acc (list (substr k 5))) acc))
       (list)
-      (persist/backend-streams host/blog-store))))
+      (persist/backend-kv-keys host/blog-store))))
+(define host/blog-list
+  (fn ()
+    (map
+      (fn (slug)
+        (let ((r (host/blog-get slug)))
+          {:slug slug :title (get r :title) :status (get r :status)}))
+      (host/blog-slugs))))
 
-;; ── handlers ────────────────────────────────────────────────────────
-;; GET /<slug>/ -> rendered HTML (200) or 404.
+;; ── render ──────────────────────────────────────────────────────────
+;; A post's sx_content is SX element markup -> HTML via the component renderer.
+(define host/blog-render
+  (fn (record)
+    (let ((sx (get record :sx-content)))
+      (if (and sx (not (= sx "")))
+        (render-to-html (parse sx))
+        (str "<p>(empty post)</p>")))))
+(define host/blog--page
+  (fn (title body)
+    (str "<!doctype html><meta charset=\"utf-8\"><title>" title "</title>" body)))
+
+;; ── read handlers ───────────────────────────────────────────────────
 (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))
+      (let ((r (host/blog-get slug)))
+        (if r
+          (dream-html
+            (host/blog--page (get r :title) (host/blog-render r)))
           (dream-html-status 404
-            (str "<!doctype html><title>Not found</title>"
-              "<h1>404</h1><p>No published post: " slug "</p>")))))))
+            (host/blog--page "Not found"
+              (str "<h1>404</h1><p>No published post: " slug "</p>"))))))))
 
-;; GET /posts -> JSON list of posts (API).
-(define host/blog-index (fn (req) (host/ok (host/blog-list))))
-
-;; GET / -> HTML index page listing posts, each linking to /<slug>/.
 (define host/blog--li
   (fn (acc p)
     (str acc "<li><a href=\"/" (get p :slug) "/\">" (get p :title) "</a></li>")))
@@ -115,44 +89,82 @@
   (fn (req)
     (let ((posts (host/blog-list)))
       (dream-html
-        (str
-          "<!doctype html><meta charset=\"utf-8\"><title>Blog</title>"
-          "<h1>Posts</h1>"
-          (if (> (len posts) 0)
-            (str "<ul>" (reduce host/blog--li "" posts) "</ul>")
-            "<p>No posts yet.</p>"))))))
+        (host/blog--page "Blog"
+          (str "<h1>Posts</h1>"
+            (if (> (len posts) 0)
+              (str "<ul>" (reduce host/blog--li "" posts) "</ul>")
+              "<p>No posts yet.</p>")
+            "<p><a href=\"/new\">+ New post</a></p>"))))))
 
-;; POST /posts -> create from JSON {slug,title,body}. 409 if it exists.
+(define host/blog-index (fn (req) (host/ok (host/blog-list))))
+
+;; ── create form (GET /new) — minimal chrome; the SX editor posts here too ──
+(define host/blog-new-form
+  (fn (req)
+    (dream-html
+      (host/blog--page "New post"
+        (str
+          "<h1>New post</h1>"
+          "<form method=\"post\" action=\"/new\">"
+          "<p><input name=\"title\" placeholder=\"Title\" style=\"font-size:1.4em;width:100%\"></p>"
+          "<p><textarea name=\"sx_content\" rows=\"12\" style=\"width:100%\" "
+          "placeholder=\"(article (h1 &quot;Title&quot;) (p &quot;Body&quot;))\"></textarea></p>"
+          "<p><select name=\"status\"><option value=\"draft\">Draft</option>"
+          "<option value=\"published\">Published</option></select> "
+          "<button type=\"submit\">Publish</button></p>"
+          "</form><p><a href=\"/\">&larr; all posts</a></p>")))))
+
+;; ── write handlers ──────────────────────────────────────────────────
+;; POST /new — form-urlencoded ingest (the editor's submit shape: title,
+;; sx_content, status, custom_excerpt, csrf_token). Slug derived from the title.
+;; Redirects to the new post on success.
+(define host/blog-form-submit
+  (fn (req)
+    (let ((title (dream-form-field req "title"))
+          (sx-content (dream-form-field req "sx_content"))
+          (status (or (dream-form-field req "status") "published")))
+      (if (and title (not (= title "")))
+        (let ((slug (host/blog-slugify title)))
+          (begin
+            (host/blog-put! slug title (or sx-content "") status)
+            (dream-redirect (str "/" slug "/"))))
+        (dream-html-status 400
+          (host/blog--page "Error" "<p>Title is required. <a href=\"/new\">back</a></p>"))))))
+
+;; POST /posts — JSON create {slug?,title,sx_content,status}. 409 if slug exists.
 (define host/blog-create
   (fn (req)
     (let ((p (dream-json-body req)))
       (if (= (type-of p) "dict")
-        (let ((slug (get p :slug)) (title (get p :title)) (body (get p :body)))
-          (if (and slug title body)
-            (if (host/blog-exists? slug)
-              (host/error 409 "post already exists")
-              (begin
-                (host/blog-publish! slug title body (host/blog-tick!))
-                (host/ok-status 201 {:slug slug :title title})))
-            (host/error 400 "slug, title, body required")))
+        (let ((title (get p :title)))
+          (if (and title (not (= title "")))
+            (let ((slug (or (get p :slug) (host/blog-slugify title))))
+              (if (host/blog-exists? slug)
+                (host/error 409 "post already exists")
+                (begin
+                  (host/blog-put! slug title (or (get p :sx_content) "")
+                    (or (get p :status) "published"))
+                  (host/ok-status 201 {:slug slug :title title}))))
+            (host/error 400 "title required")))
         (host/error 400 "invalid payload")))))
 
-;; PUT /posts/<slug> -> update title+body from JSON {title,body}. 404 if absent.
+;; PUT /posts/<slug> — JSON update {title?,sx_content?,status?}. 404 if absent.
 (define host/blog-update-handler
   (fn (req)
     (let ((slug (dream-param req "slug")) (p (dream-json-body req)))
       (if (= (type-of p) "dict")
-        (if (host/blog-exists? slug)
-          (let ((title (get p :title)) (body (get p :body)))
-            (if (and title body)
-              (begin
-                (host/blog-update! slug title body (host/blog-tick!))
-                (host/ok {:slug slug :title title :updated true}))
-              (host/error 400 "title, body required")))
-          (host/error 404 "no such post"))
+        (let ((r (host/blog-get slug)))
+          (if r
+            (begin
+              (host/blog-put! slug
+                (or (get p :title) (get r :title))
+                (or (get p :sx_content) (get r :sx-content))
+                (or (get p :status) (get r :status)))
+              (host/ok {:slug slug :updated true}))
+            (host/error 404 "no such post")))
         (host/error 400 "invalid payload")))))
 
-;; DELETE /posts/<slug> -> delete. 404 if absent.
+;; DELETE /posts/<slug>
 (define host/blog-delete-handler
   (fn (req)
     (let ((slug (dream-param req "slug")))
@@ -161,19 +173,17 @@
         (host/error 404 "no such post")))))
 
 ;; ── routes ──────────────────────────────────────────────────────────
-;; Public reads: /posts (list) BEFORE /:slug (the catch-all), so a literal
-;; /posts isn't captured as a slug. MUST be mounted LAST in the app (the :slug
-;; pattern matches any single-segment path, so domain routes take precedence).
+;; Public reads + the create form. /, /posts, /new BEFORE /:slug (catch-all).
+;; MUST be mounted LAST in the app so domain routes (/feed, /health) win.
 (define host/blog-routes
   (list
     (dream-get "/" host/blog-home)
     (dream-get "/posts" host/blog-index)
+    (dream-get "/new" host/blog-new-form)
     (dream-get "/:slug" host/blog-post)))
 
-;; Guarded writes: create/update/delete behind auth + ACL ("edit","blog").
-;; resolve : token -> principal | nil (injected auth policy, like the feed writes).
-;; NB: the wrapper is named host/blog--protect, NOT `guard` — `guard` is a reserved
-;; CEK special form and a local binding of that name is shadowed by it.
+;; Guarded writes: form ingest + JSON create/update/delete behind auth+ACL.
+;; NB: helper is host/blog--protect, NOT `guard` (reserved special form).
 (define host/blog--protect
   (fn (resolve h)
     (host/pipeline
@@ -185,9 +195,7 @@
 (define host/blog-write-routes
   (fn (resolve)
     (list
+      (dream-post "/new" (host/blog--protect resolve host/blog-form-submit))
       (dream-post "/posts" (host/blog--protect resolve host/blog-create))
       (dream-put "/posts/:slug" (host/blog--protect resolve host/blog-update-handler))
       (dream-delete "/posts/:slug" (host/blog--protect resolve host/blog-delete-handler)))))
-
-;; Self-bootstrap at load (content modules are loaded before this one).
-(host/blog-bootstrap!)