;; 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 // 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/ JSON update (guarded) ;; DELETE /posts/ 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:") (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 "

(empty post)

"))))) (define host/blog--page (fn (title body) (str "" 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 "

404

No published post: " slug "

")))))))) (define host/blog--li (fn (acc p) (str acc "

" (get p :title) "

"))) (define host/blog-home (fn (req) (let ((posts (host/blog-list))) (dream-html (host/blog--page "Blog" (str "

Posts

" (if (> (len posts) 0) (str "

" (reduce host/blog--li "" posts) "") "

No posts yet.

") "

+ New post

")))))) (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 "New post" ;; FontAwesome for the editor's +/slash-menu icons. "" ;; The sx-editor's own styles (.sx-*), rendered from its component via 5.1. (render-page (quote (~editor/sx-editor-styles))) "" "" "" "" "" "" "")))) ;; ── 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" "

Title is required. back

")))))) ;; 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/ — 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/ (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))))