From 1eec131101d23ef77230112309966aa3eb3a5f1b Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 25 Jun 2026 22:19:54 +0000 Subject: [PATCH] host: view + edit the SX source of each blog post (blog 47/47, 213 total) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Posts ARE SX source, so expose it: a public raw-source view and a guarded in-browser source editor. - GET //source — raw sx_content as text/plain (public; a published post's source isn't secret). - GET //edit — edit form pre-filled with the post's title, raw source (in a textarea, render-to-html-escaped so it shows verbatim), and status (current value pre-selected). Guarded (editor only). Slug is preserved. - POST //edit — save the edited source; same write-time validation as create (unparseable body -> 400, post left intact); 303 back to the post. - post page gains "view source · edit · all posts" footer links. Routing: /:slug/source + /:slug/edit are two-segment patterns; the router consumes :param as exactly one segment and requires a full match, so /:slug does not shadow them (asserted). 14 new blog tests cover view (200/text-plain/ raw body/404/no-shadow) and edit (401 unauth GET+POST, 200 form, source shown, 303 save, persisted, slug preserved, 400 malformed, 404 missing). Verified live on blog.rose-ash.com: view source, guarded edit form, save round-trip (rendered post + source both reflect the edit). Co-Authored-By: Claude Opus 4.8 --- lib/host/blog.sx | 87 +++++++++++++++++++++++++++++++++++++++++- lib/host/tests/blog.sx | 45 ++++++++++++++++++++++ 2 files changed, 131 insertions(+), 1 deletion(-) diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 7138cfdc..4a62fc46 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -107,7 +107,15 @@ (if r (dream-html (host/blog--page (get r :title) - (quasiquote (article (raw! (unquote (host/blog-render r))))))) + (quasiquote + (div + (article (raw! (unquote (host/blog-render r)))) + (p :style "margin-top:2em;font-size:0.9em;opacity:0.8" + (a :href (unquote (str "/" slug "/source")) "view source") + " · " + (a :href (unquote (str "/" slug "/edit")) "edit") + " · " + (a :href "/" "all posts")))))) (dream-html-status 404 (host/blog--page "Not found" (quasiquote @@ -136,6 +144,20 @@ (define host/blog-index (fn (req) (host/ok (host/blog-list)))) +;; GET //source — the raw sx_content as text/plain. Posts ARE SX source, so +;; this just hands back the stored markup (public; a published post's source is +;; not secret). 404 if the post is absent. +(define host/blog-source + (fn (req) + (let ((slug (dream-param req "slug"))) + (let ((r (host/blog-get slug))) + (if r + (dream-response 200 {:content-type "text/plain; charset=utf-8"} + (or (get r :sx-content) "")) + (dream-html-status 404 + (host/blog--page "Not found" + (quasiquote (div (h1 "404") (p (unquote (str "No post: " slug)))))))))))) + ;; ── create page (GET /new) — clean minimal form as an SX tree ─────── ;; No legacy JS editor, no external assets, no shims. The rich WYSIWYG is a ;; future native SX-island editor (Phase 5.2+). Posts to /new. @@ -243,6 +265,66 @@ (begin (host/blog-delete! slug) (host/ok {:slug slug :deleted true})) (host/error 404 "no such post"))))) +;; GET //edit — edit form pre-filled with the post's current title, raw +;; sx_content (in a textarea — render-to-html escapes the text child, so the +;; browser shows the source verbatim), and status (current value pre-selected). +;; Guarded: only an editor reaches the editor. Keeps the slug (edits don't re-slug). +(define host/blog-edit-form + (fn (req) + (let ((slug (dream-param req "slug"))) + (let ((r (host/blog-get slug))) + (if (nil? r) + (dream-html-status 404 + (host/blog--page "Not found" + (quasiquote (div (h1 "404") (p (unquote (str "No post: " slug))))))) + (let ((status (get r :status))) + (let ((mk-opt + (fn (val label) + (if (= val status) + (quasiquote (option :value (unquote val) :selected "selected" (unquote label))) + (quasiquote (option :value (unquote val) (unquote label))))))) + (dream-html + (host/blog--page (str "Edit: " (get r :title)) + (quasiquote + (div + (h1 (unquote (str "Edit: " (get r :title)))) + (form :method "post" :action (unquote (str "/" slug "/edit")) + (p (input :name "title" :value (unquote (get r :title)) + :style "font-size:1.4em;width:100%")) + (p (textarea :name "sx_content" :rows "16" + :style "width:100%;font-family:monospace" + (unquote (or (get r :sx-content) "")))) + (p (select :name "status" + (unquote (mk-opt "draft" "Draft")) + (unquote (mk-opt "published" "Published"))) + " " + (button :type "submit" "Save"))) + (p (a :href (unquote (str "/" slug "/")) "view post") + " · " + (a :href (unquote (str "/" slug "/source")) "view source"))))))))))))) + +;; POST //edit — save the edited source. Same write-time validation as the +;; create paths (unparseable body -> 400, post left intact). Slug is preserved. +(define host/blog-edit-submit + (fn (req) + (let ((slug (dream-param req "slug"))) + (let ((r (host/blog-get slug))) + (if (nil? r) + (dream-html-status 404 + (host/blog--page "Not found" + (quasiquote (div (h1 "404") (p (unquote (str "No post: " slug))))))) + (let ((title (or (dream-form-field req "title") (get r :title))) + (sx-content (or (dream-form-field req "sx_content") "")) + (status (or (dream-form-field req "status") (get r :status)))) + (if (host/blog-content-ok? sx-content) + (begin + (host/blog-put! slug title sx-content status) + (dream-redirect (str "/" slug "/"))) + (dream-html-status 400 + (host/blog--page "Error" + (quasiquote (div (h1 "Error") (p "Post body is not valid SX markup.") + (p (a :href (unquote (str "/" slug "/edit")) "Back"))))))))))))) + ;; ── routes ────────────────────────────────────────────────────────── ;; Public reads + the create form. /, /posts, /new BEFORE /:slug (catch-all). ;; MUST be mounted LAST in the app so domain routes (/feed, /health) win. @@ -251,6 +333,7 @@ (dream-get "/" host/blog-home) (dream-get "/posts" host/blog-index) (dream-get "/new" host/blog-new-form) + (dream-get "/:slug/source" host/blog-source) (dream-get "/:slug" host/blog-post))) ;; Guarded writes: form ingest + JSON create/update/delete behind auth+ACL. @@ -267,6 +350,8 @@ (fn (resolve) (list (dream-post "/new" (host/blog--protect resolve host/blog-form-submit)) + (dream-get "/:slug/edit" (host/blog--protect resolve host/blog-edit-form)) + (dream-post "/:slug/edit" (host/blog--protect resolve host/blog-edit-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))))) diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx index 692355ee..93819b0e 100644 --- a/lib/host/tests/blog.sx +++ b/lib/host/tests/blog.sx @@ -149,6 +149,51 @@ (contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "

My First Post

") true) +;; -- view source (public) -- +(host-bl-test "view source -> 200" + (dream-status (host-bl-wapp (host-bl-req "/my-first-post/source"))) 200) +(host-bl-test "view source is text/plain" + (dream-resp-header (host-bl-wapp (host-bl-req "/my-first-post/source")) "content-type") + "text/plain; charset=utf-8") +(host-bl-test "view source returns raw sx_content" + (contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/source"))) "(article") + true) +(host-bl-test "view source missing -> 404" + (dream-status (host-bl-wapp (host-bl-req "/ghost/source"))) 404) +(host-bl-test "/:slug not shadowed by /:slug/source" + (dream-status (host-bl-wapp (host-bl-req "/my-first-post/"))) 200) + +;; -- edit source (guarded GET form + guarded POST save) -- +(host-bl-test "edit form no auth -> 401" + (dream-status (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" nil "" ""))) 401) +(host-bl-test "edit form authed -> 200" + (dream-status (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" "Bearer good" "" ""))) 200) +(host-bl-test "edit form shows current source" + (contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" "Bearer good" "" ""))) + "(article") + true) +(host-bl-test "edit submit no auth -> 401" + (dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" nil + "application/x-www-form-urlencoded" "sx_content=(p+%22x%22)"))) 401) +(host-bl-test "edit submit authed -> 303" + (dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" "Bearer good" + "application/x-www-form-urlencoded" + "title=My+First+Post&sx_content=(p+%22edited+via+editor%22)&status=published"))) 303) +(host-bl-test "edit persisted the new content" + (contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "edited via editor") + true) +(host-bl-test "edit preserves the slug" + (dream-resp-header + (host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" "Bearer good" + "application/x-www-form-urlencoded" "title=Renamed&sx_content=(p+%22y%22)&status=draft")) + "location") + "/my-first-post/") +(host-bl-test "edit malformed body -> 400" + (dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" "Bearer good" + "application/x-www-form-urlencoded" "sx_content=%3Ch1+broken%29"))) 400) +(host-bl-test "edit missing post -> 404" + (dream-status (host-bl-wapp (host-bl-send "GET" "/ghost/edit" "Bearer good" "" ""))) 404) + ;; -- 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))