giles
b4974db25f
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
The editor was unstyled: editor.css is .koenig-lexical-scoped (the OTHER editor);
the sx-editor's .sx-* styles live in the ~editor/sx-editor-styles component
(inline <style> in blog/sx/editor.sx). Inline them into /new by rendering that
component with the 5.1 render-page primitive (dogfooding the capability live), +
FontAwesome for the +/slash-menu icons. 79 .sx- rules now inlined.
Also: the sx_host container only mounted spec+lib, so web/adapter-html.sx (and
now blog/sx/{layouts,editor}.sx) silently failed to load at boot -> render-page
errored -> /new 502. Mount ./web + ./blog (ro) so they load. (Transitional reuse
of the legacy blog editor component + its styles; retire via the asset-manifest +
native SX-island editor.)
Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
232 lines
11 KiB
Plaintext
232 lines
11 KiB
Plaintext
;; 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.
|
|
;;
|
|
;; 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.
|
|
|
|
;; ── 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--key (fn (slug) (str "blog:" slug)))
|
|
|
|
;; 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) " ")))))
|
|
|
|
;; ── records ─────────────────────────────────────────────────────────
|
|
(define host/blog-get
|
|
(fn (slug) (persist/backend-kv-get host/blog-store (host/blog--key slug))))
|
|
(define host/blog-exists?
|
|
(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) (persist/backend-kv-delete host/blog-store (host/blog--key slug))))
|
|
(define host/blog-seed!
|
|
(fn (slug title sx-content status)
|
|
(when (not (host/blog-exists? slug)) (host/blog-put! slug title sx-content status))))
|
|
|
|
;; all blog slugs (kv keys are "blog:<slug>")
|
|
(define host/blog-slugs
|
|
(fn ()
|
|
(reduce
|
|
(fn (acc k)
|
|
(if (starts-with? k "blog:") (append acc (list (substr k 5))) acc))
|
|
(list)
|
|
(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))))
|
|
|
|
;; ── 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 ((r (host/blog-get slug)))
|
|
(if r
|
|
(dream-html
|
|
(host/blog--page (get r :title) (host/blog-render r)))
|
|
(dream-html-status 404
|
|
(host/blog--page "Not found"
|
|
(str "<h1>404</h1><p>No published post: " slug "</p>"))))))))
|
|
|
|
(define host/blog--li
|
|
(fn (acc p)
|
|
(str acc "<li><a href=\"/" (get p :slug) "/\">" (get p :title) "</a></li>")))
|
|
(define host/blog-home
|
|
(fn (req)
|
|
(let ((posts (host/blog-list)))
|
|
(dream-html
|
|
(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>"))))))
|
|
|
|
(define host/blog-index (fn (req) (host/ok (host/blog-list))))
|
|
|
|
;; ── create page (GET /new) — the real WYSIWYG block editor ──────────
|
|
;; Mounts the self-contained sx-editor.js (Ghost/Koenig-style block editor) that
|
|
;; serializes the visual edit to `sx_content`. Assets (sx-browser.js for Sx.parse,
|
|
;; sx-editor.js, editor.css) are referenced from the docs static host
|
|
;; (sx.rose-ash.com/static/scripts) — no host static-serving needed. On submit the
|
|
;; handle's getSx() fills the hidden sx_content field, then it POSTs to /new.
|
|
;; (This reuses the legacy JS editor; a native SX-island editor is the future.)
|
|
(define host/blog--asset "https://sx.rose-ash.com/static/scripts")
|
|
(define host/blog-new-form
|
|
(fn (req)
|
|
(dream-html
|
|
(str
|
|
"<!doctype html><html><head><meta charset=\"utf-8\"><title>New post</title>"
|
|
;; FontAwesome for the editor's +/slash-menu icons.
|
|
"<link rel=\"stylesheet\" href=\"https://cdnjs.cloudflare.com/ajax/libs/font-awesome/6.5.1/css/all.min.css\">"
|
|
;; The sx-editor's own styles (.sx-*), rendered from its component via 5.1.
|
|
(render-page (quote (~editor/sx-editor-styles)))
|
|
"<style>body{max-width:768px;margin:2rem auto;padding:0 1rem;font-family:system-ui}"
|
|
"#title-input{width:100%;font-size:1.9em;font-weight:700;border:none;outline:none;margin:.5rem 0}"
|
|
".bar{display:flex;gap:1rem;align-items:center;margin-top:1.5rem;border-top:1px solid #eee;padding-top:1rem}</style>"
|
|
"</head><body>"
|
|
"<form id=\"post-new-form\" method=\"post\" action=\"/new\">"
|
|
"<input id=\"title-input\" name=\"title\" placeholder=\"Post title\" autocomplete=\"off\">"
|
|
"<input type=\"hidden\" id=\"sx-content-input\" name=\"sx_content\" value=\"\">"
|
|
"<div id=\"sx-editor\"></div>"
|
|
"<div class=\"bar\">"
|
|
"<select name=\"status\"><option value=\"draft\">Draft</option>"
|
|
"<option value=\"published\" selected>Published</option></select>"
|
|
"<button type=\"submit\">Publish</button>"
|
|
"<a href=\"/\">all posts</a></div>"
|
|
"</form>"
|
|
"<script src=\"" host/blog--asset "/sx-browser.js\"></script>"
|
|
"<script src=\"" host/blog--asset "/sx-editor.js\"></script>"
|
|
"<script>(function(){var h=SxEditor.mount('sx-editor',{});"
|
|
"document.getElementById('post-new-form').addEventListener('submit',function(){"
|
|
"document.getElementById('sx-content-input').value=h.getSx();});})();</script>"
|
|
"</body></html>"))))
|
|
|
|
;; ── 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 ((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> — 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")
|
|
(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>
|
|
(define host/blog-delete-handler
|
|
(fn (req)
|
|
(let ((slug (dream-param req "slug")))
|
|
(if (host/blog-exists? slug)
|
|
(begin (host/blog-delete! slug) (host/ok {:slug slug :deleted true}))
|
|
(host/error 404 "no such post")))))
|
|
|
|
;; ── 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.
|
|
(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: 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
|
|
(list
|
|
host/wrap-errors
|
|
(host/require-auth resolve)
|
|
(host/require-permission "edit" (fn (req) "blog")))
|
|
h)))
|
|
(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)))))
|
|
|
|
;; EXPERIMENTAL: create-only, UNGUARDED — POST /new form ingest with error
|
|
;; trapping but NO auth, for validating the editor->host publish loop on the
|
|
;; experimental subdomain. Create-only by design (no PUT/DELETE), so the worst
|
|
;; case is junk posts, not overwrite/delete. GATE before any real use.
|
|
(define host/blog-open-create-routes
|
|
(list
|
|
(dream-post "/new" (host/pipeline (list host/wrap-errors) host/blog-form-submit))))
|