host: reject malformed sx_content at write time (blog 33/33, 199 total)

Complete the malformed-post defence: instead of only degrading on read,
refuse to store a post whose body won't parse, so bad content never enters
the durable store in the first place.

- host/blog-content-ok?: empty body is allowed, otherwise it must parse
  (parse-safe non-nil).
- POST /new (form): missing title OR unparseable body -> 400 HTML page.
- POST /posts (JSON): unparseable sx_content -> 400 "invalid sx_content".
- PUT /posts/:slug (JSON): unparseable sx_content -> 400, existing post left
  intact.
- 6 new blog tests: each write path rejects "<h1 broken)" with 400 and does
  not store / does not mutate.

Verified live: malformed publish -> 400 + slug 404 (not stored); valid
publish unaffected.

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

lib/host/blog.sx

@@ -159,22 +159,42 @@
                 (button :type "submit" "Publish")))
             (p (a :href "/" "all posts"))))))))
 
+;; ── write-time validation ───────────────────────────────────────────
+;; sx_content must be storable as renderable SX: empty is allowed (an empty post),
+;; otherwise it must parse. parse-safe returns nil on malformed input (the kernel
+;; parser raises a native Parse_error an SX guard can't catch), so this rejects a
+;; bad body at write time instead of letting it 500 on read. Mirrors the read-path
+;; guard in host/blog-render — bad content never enters the durable store.
+(define host/blog-content-ok?
+  (fn (sx)
+    (or (nil? sx) (= sx "") (not (nil? (parse-safe sx))))))
+
 ;; ── 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.
+;; Redirects to the new post on success; rejects a missing title or unparseable
+;; body with a 400 HTML page (this path serves a browser form).
 (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>"))))))
+      (cond
+        ((or (nil? title) (= title ""))
+          (dream-html-status 400
+            (host/blog--page "Error"
+              (quasiquote (div (h1 "Error") (p "Title is required.")
+                            (p (a :href "/new" "Back")))))))
+        ((not (host/blog-content-ok? sx-content))
+          (dream-html-status 400
+            (host/blog--page "Error"
+              (quasiquote (div (h1 "Error") (p "Post body is not valid SX markup.")
+                            (p (a :href "/new" "Back")))))))
+        (else
+          (let ((slug (host/blog-slugify title)))
+            (begin
+              (host/blog-put! slug title (or sx-content "") status)
+              (dream-redirect (str "/" slug "/")))))))))
 
 ;; POST /posts — JSON create {slug?,title,sx_content,status}. 409 if slug exists.
 (define host/blog-create
@@ -182,15 +202,18 @@
     (let ((p (dream-json-body req)))
       (if (= (type-of p) "dict")
         (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")))
+          (cond
+            ((or (nil? title) (= title "")) (host/error 400 "title required"))
+            ((not (host/blog-content-ok? (get p :sx_content)))
+              (host/error 400 "invalid sx_content"))
+            (else
+              (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 "invalid payload")))))
 
 ;; PUT /posts/<slug> — JSON update {title?,sx_content?,status?}. 404 if absent.
@@ -199,14 +222,17 @@
     (let ((slug (dream-param req "slug")) (p (dream-json-body req)))
       (if (= (type-of p) "dict")
         (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")))
+          (cond
+            ((nil? r) (host/error 404 "no such post"))
+            ((not (host/blog-content-ok? (get p :sx_content)))
+              (host/error 400 "invalid sx_content"))
+            (else
+              (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 400 "invalid payload")))))
 
 ;; DELETE /posts/<slug>

lib/host/tests/blog.sx

@@ -124,6 +124,31 @@
   (dream-status (host-bl-wapp (host-bl-send "DELETE" "/posts/ghost" "Bearer good" "" "")))
   404)
 
+;; -- write-time validation: malformed sx_content rejected, never stored --
+;; "%3Ch1+broken%29" decodes to "<h1 broken)" — a typo'd paren the parser rejects.
+(host-bl-test "form ingest malformed sx_content -> 400"
+  (dream-status (host-bl-wapp (host-bl-send "POST" "/new" "Bearer good"
+    "application/x-www-form-urlencoded"
+    "title=Bad+Form&sx_content=%3Ch1+broken%29&status=published")))
+  400)
+(host-bl-test "rejected form post was not stored"
+  (dream-status (host-bl-wapp (host-bl-req "/bad-form/")))
+  404)
+(host-bl-test "json create malformed sx_content -> 400"
+  (dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "application/json"
+    "{\"title\":\"Bad Json\",\"sx_content\":\"<h1 broken)\"}")))
+  400)
+(host-bl-test "rejected json post was not stored"
+  (dream-status (host-bl-wapp (host-bl-req "/bad-json/")))
+  404)
+(host-bl-test "json update malformed sx_content -> 400"
+  (dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/my-first-post" "Bearer good"
+    "application/json" "{\"sx_content\":\"<h1 broken)\"}")))
+  400)
+(host-bl-test "rejected update left content intact"
+  (contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "<h1>My First Post</h1>")
+  true)
+
 ;; -- experimental unguarded create-only route (POST /new, no auth) --
 (define host-bl-oapp (host/make-app (list host/blog-open-create-routes host/blog-routes)))
 (host/blog-use-store! (persist/open))