diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 61c6e031..0b2498fb 100644 --- a/lib/host/blog.sx +++ b/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 // read a post (public) -> rendered HTML / 404 -;; POST /posts create (guarded) -> 201 / 400 / 409 -;; PUT /posts/ update title+body (guarded)-> 200 / 400 / 404 -;; DELETE /posts/ 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:": a heading (id "-h") -;; and a body paragraph (id "-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 // 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. -;; 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:"; 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:") +(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 // -> 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 "

(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 ((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 "Not found" - "

404

No published post: " slug "

"))))))) + (host/blog--page "Not found" + (str "

404

No published post: " slug "

")))))))) -;; 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 //. (define host/blog--li (fn (acc p) (str acc "
  • " (get p :title) "
    • "))) @@ -115,44 +89,82 @@ (fn (req) (let ((posts (host/blog-list))) (dream-html - (str - "Blog" - "

    Posts

    " - (if (> (len posts) 0) - (str "
      " (reduce host/blog--li "" posts) "
    ") - "

    No posts yet.

    ")))))) + (host/blog--page "Blog" + (str "

    Posts

    " + (if (> (len posts) 0) + (str "
      " (reduce host/blog--li "" posts) "
    ") + "

    No posts yet.

    ") + "

    + New post

    ")))))) -;; 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 + "

    New post

    " + "
    " + "

    " + "

    " + "

    " + "

    " + "

    ← all posts

    "))))) + +;; ── 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 ((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/ -> update title+body from JSON {title,body}. 404 if absent. +;; 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") - (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/ -> delete. 404 if absent. +;; DELETE /posts/ (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!) diff --git a/lib/host/conformance.sh b/lib/host/conformance.sh index 9a13159c..8e4974dd 100755 --- a/lib/host/conformance.sh +++ b/lib/host/conformance.sh @@ -55,27 +55,19 @@ MODULES=( "lib/feed/normalize.sx" "lib/feed/stream.sx" "lib/feed/api.sx" - "lib/smalltalk/tokenizer.sx" - "lib/smalltalk/parser.sx" - "lib/guest/reflective/class-chain.sx" - "lib/smalltalk/runtime.sx" - "lib/guest/reflective/env.sx" - "lib/smalltalk/eval.sx" "lib/persist/event.sx" "lib/persist/backend.sx" "lib/persist/log.sx" "lib/persist/kv.sx" "lib/persist/api.sx" - "lib/content/block.sx" - "lib/content/doc.sx" - "lib/content/render.sx" - "lib/content/api.sx" - "lib/content/store.sx" "lib/persist/durable.sx" + "spec/render.sx" + "web/adapter-html.sx" "lib/dream/types.sx" "lib/dream/json.sx" "lib/dream/auth.sx" "lib/dream/error.sx" + "lib/dream/form.sx" "lib/dream/router.sx" "lib/host/handler.sx" "lib/host/middleware.sx" diff --git a/lib/host/serve.sh b/lib/host/serve.sh index e2298ecb..9ffc1d24 100755 --- a/lib/host/serve.sh +++ b/lib/host/serve.sh @@ -60,27 +60,19 @@ MODULES=( "lib/feed/normalize.sx" "lib/feed/stream.sx" "lib/feed/api.sx" - "lib/smalltalk/tokenizer.sx" - "lib/smalltalk/parser.sx" - "lib/guest/reflective/class-chain.sx" - "lib/smalltalk/runtime.sx" - "lib/guest/reflective/env.sx" - "lib/smalltalk/eval.sx" "lib/persist/event.sx" "lib/persist/backend.sx" "lib/persist/log.sx" "lib/persist/kv.sx" "lib/persist/api.sx" - "lib/content/block.sx" - "lib/content/doc.sx" - "lib/content/render.sx" - "lib/content/api.sx" - "lib/content/store.sx" "lib/persist/durable.sx" + "spec/render.sx" + "web/adapter-html.sx" "lib/dream/types.sx" "lib/dream/json.sx" "lib/dream/auth.sx" "lib/dream/error.sx" + "lib/dream/form.sx" "lib/dream/router.sx" "lib/host/handler.sx" "lib/host/middleware.sx" @@ -98,15 +90,13 @@ EPOCH=1 echo "(epoch $EPOCH)"; echo "(load \"$M\")"; EPOCH=$((EPOCH+1)) done # Point the blog at the DURABLE file backend (persists under $SX_PERSIST_DIR), - # then idempotently seed a welcome post — re-seeding is a no-op if it already - # exists on disk, so restarts don't duplicate blocks. + # then idempotently seed a welcome post (sx_content = SX element markup, the + # editor's content model). Re-seeding is a no-op if the slug already exists. echo "(epoch $EPOCH)" echo "(eval \"(host/blog-use-store! (persist/durable-backend))\")" EPOCH=$((EPOCH+1)) echo "(epoch $EPOCH)" - # Idempotently seed the welcome post into the durable store (no-op if present). - # Handlers read + render from the store per request (per-request IO). - echo "(eval \"(host/blog-seed! \\\"welcome\\\" \\\"Welcome to the SX host\\\" \\\"This page is rendered by lib/host on the SX runtime, persisted in the SX store — no Quart.\\\" 1)\")" + echo "(eval \"(host/blog-seed! \\\"welcome\\\" \\\"Welcome to the SX host\\\" \\\"(article (h1 \\\\\\\"Welcome to the SX host\\\\\\\") (p \\\\\\\"Rendered by lib/host via render-to-html, from the durable SX store.\\\\\\\"))\\\" \\\"published\\\")\")" EPOCH=$((EPOCH+1)) echo "(epoch $EPOCH)" # Anonymous read endpoints: feed timeline + relations container reads + blog diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx index 08d7088f..65076017 100644 --- a/lib/host/tests/blog.sx +++ b/lib/host/tests/blog.sx @@ -1,185 +1,131 @@ -;; lib/host/tests/blog.sx — the blog published-post read endpoint. A registered -;; post renders to HTML at GET //; unknown slugs 404. Also pins route -;; precedence: the catch-all :slug must NOT shadow domain routes mounted before it. +;; lib/host/tests/blog.sx — blog on the editor's content model. Posts are +;; {slug,title,sx_content,status} records in the durable KV; a post page is +;; render-to-html(parse sx_content). Covers read/render, home index, JSON list, +;; slugify, the form-urlencoded editor ingest, and JSON CRUD (auth+ACL guarded). (define host-bl-pass 0) (define host-bl-fail 0) (define host-bl-fails (list)) - (define host-bl-test - (fn - (name actual expected) - (if - (= actual expected) + (fn (name actual expected) + (if (= actual expected) (set! host-bl-pass (+ host-bl-pass 1)) (begin (set! host-bl-fail (+ host-bl-fail 1)) (append! host-bl-fails {:name name :actual actual :expected expected}))))) (define host-bl-req (fn (target) (dream-request "GET" target {} ""))) -;; feed mounted BEFORE blog so /feed is not captured by the :slug catch-all. -(define host-bl-app - (host/make-app (list host/feed-routes host/blog-routes))) +(define host-bl-app (host/make-app (list host/feed-routes host/blog-routes))) -;; ── publish a post to a fresh in-memory store (hermetic) ──────────── +;; ── slugify ───────────────────────────────────────────────────────── +(host-bl-test "slugify" (host/blog-slugify "Hello World") "hello-world") +(host-bl-test "slugify trims spaces" (host/blog-slugify " A B ") "a-b") + +;; ── render a stored post ──────────────────────────────────────────── (host/blog-use-store! (persist/open)) -(host/blog-publish! "welcome" "Hello SX" "Served by lib/host." 1) +(host/blog-put! "hello" "Hello World" + "(article (h1 \"Hello World\") (p \"A \" (strong \"bold\") \" word.\"))" "published") -(host-bl-test - "post 200" - (dream-status (host-bl-app (host-bl-req "/welcome/"))) - 200) -(host-bl-test - "post content-type html" - (contains? (dream-resp-header (host-bl-app (host-bl-req "/welcome/")) "content-type") "text/html") +(host-bl-test "post 200" (dream-status (host-bl-app (host-bl-req "/hello/"))) 200) +(host-bl-test "post content-type html" + (contains? (dream-resp-header (host-bl-app (host-bl-req "/hello/")) "content-type") "text/html") true) -(host-bl-test - "post renders heading" - (contains? (dream-resp-body (host-bl-app (host-bl-req "/welcome/"))) "

    Hello SX

    ") +(host-bl-test "post renders sx_content markup" + (contains? (dream-resp-body (host-bl-app (host-bl-req "/hello/"))) "bold") true) -(host-bl-test - "post renders body" - (contains? (dream-resp-body (host-bl-app (host-bl-req "/welcome/"))) "Served by lib/host.") - true) -;; trailing slash optional — /welcome and /welcome/ both resolve -(host-bl-test - "no trailing slash also 200" - (dream-status (host-bl-app (host-bl-req "/welcome"))) - 200) - -;; golden: endpoint body == the exact rendered HTML of the published post -(host-bl-test - "golden render" - (dream-resp-body (host-bl-app (host-bl-req "/welcome/"))) - "

    Hello SX

    Served by lib/host.

    ") - -;; persistence: the store holds 2 blocks (op-log replay), lookup materialises the -;; doc from the store per call, and re-seeding is idempotent (no duplicate blocks). -(host-bl-test "store has 2 blocks" (content/count (content/head host/blog-store "welcome")) 2) -(host-bl-test "lookup materialises the doc" (content/count (host/blog-lookup "welcome")) 2) -(host/blog-seed! "welcome" "Hello SX" "Served by lib/host." 2) -(host-bl-test "re-seed is idempotent" (content/count (content/head host/blog-store "welcome")) 2) - -;; ── unknown slug -> 404 ───────────────────────────────────────────── -(host-bl-test - "unknown slug 404" - (dream-status (host-bl-app (host-bl-req "/nope/"))) - 404) -(host-bl-test - "404 names the slug" - (contains? (dream-resp-body (host-bl-app (host-bl-req "/nope/"))) "nope") +(host-bl-test "post title in page" + (contains? (dream-resp-body (host-bl-app (host-bl-req "/hello/"))) "Hello World") true) -;; ── route precedence: domain routes win over the :slug catch-all ──── +;; ── home + list ───────────────────────────────────────────────────── +(host-bl-test "home lists post" + (contains? (dream-resp-body (host-bl-app (host-bl-req "/"))) "href=\"/hello/\"") + true) +(host-bl-test "json list shows post" + (contains? (dream-resp-body (host-bl-app (host-bl-req "/posts"))) "\"slug\":\"hello\"") + true) +(host-bl-test "GET /new shows form" + (contains? (dream-resp-body (host-bl-app (host-bl-req "/new"))) " data:[]" - (contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/posts" nil ""))) "\"data\":[]") - true) -;; HTML home page when empty -(host-bl-test "home / -> 200 html" - (contains? (dream-resp-header (host-bl-wapp (host-bl-send "GET" "/" nil "")) "content-type") "text/html") - true) -(host-bl-test "empty home says no posts" - (contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/" nil ""))) "No posts yet") +;; -- editor form ingest (form-urlencoded, the editor's submit shape) -- +(host-bl-test "form ingest no auth -> 401" + (dream-status (host-bl-wapp (host-bl-send "POST" "/new" nil + "application/x-www-form-urlencoded" "title=X"))) + 401) +(host-bl-test "form ingest authed -> 303 redirect" + (dream-status (host-bl-wapp (host-bl-send "POST" "/new" "Bearer good" + "application/x-www-form-urlencoded" + "title=My+First+Post&sx_content=(article+(h1+%22My+First+Post%22)+(p+%22Hi%22))&status=published"))) + 303) +(host-bl-test "form ingest set Location to the new slug" + (dream-resp-header + (host-bl-wapp (host-bl-send "POST" "/new" "Bearer good" + "application/x-www-form-urlencoded" + "title=Another+One&sx_content=(p+%22x%22)&status=published")) + "location") + "/another-one/") +(host-bl-test "ingested post renders" + (contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "

    My First Post

    ") true) -;; create requires auth -(host-bl-test "create no auth -> 401" - (dream-status (host-bl-wapp (host-bl-send "POST" "/posts" nil "{}"))) - 401) -(host-bl-test "create authed-unpermitted -> 403" - (dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer weak" - "{\"slug\":\"hello\",\"title\":\"Hi\",\"body\":\"B\"}"))) - 403) -;; create permitted -> 201 -(host-bl-test "create -> 201" - (dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" - "{\"slug\":\"hello\",\"title\":\"Hello World\",\"body\":\"First post.\"}"))) +;; -- JSON CRUD -- +(host-bl-test "json create -> 201" + (dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "application/json" + "{\"title\":\"Json Post\",\"sx_content\":\"(p \\\"jp\\\")\",\"status\":\"draft\"}"))) 201) -;; created post renders at GET // -(host-bl-test "created post reads back as HTML" - (contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/hello/" nil ""))) "

    Hello World

    ") - true) -;; appears in the list -(host-bl-test "list shows created post" - (contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/posts" nil ""))) "Hello World") - true) -;; home page lists it with a link to // -(host-bl-test "home lists post title" - (contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/" nil ""))) "Hello World") - true) -(host-bl-test "home links to the post" - (contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/" nil ""))) "href=\"/hello/\"") - true) -;; create duplicate -> 409 -(host-bl-test "create duplicate -> 409" - (dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" - "{\"slug\":\"hello\",\"title\":\"X\",\"body\":\"Y\"}"))) +(host-bl-test "json create unpermitted -> 403" + (dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer weak" "application/json" + "{\"title\":\"Nope\"}"))) + 403) +(host-bl-test "json create duplicate -> 409" + (dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "application/json" + "{\"slug\":\"json-post\",\"title\":\"Json Post\"}"))) 409) -;; missing fields -> 400 -(host-bl-test "create missing fields -> 400" - (dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "{\"slug\":\"x\"}"))) +(host-bl-test "json create no title -> 400" + (dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "application/json" "{}"))) 400) - -;; update -> 200 and content changes (host-bl-test "update -> 200" - (dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/hello" "Bearer good" - "{\"title\":\"Edited Title\",\"body\":\"Edited body.\"}"))) + (dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/json-post" "Bearer good" "application/json" + "{\"sx_content\":\"(p \\\"edited\\\")\"}"))) 200) -(host-bl-test "update changed the rendered post" - (contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/hello/" nil ""))) "

    Edited Title

    ") +(host-bl-test "update changed content" + (contains? (dream-resp-body (host-bl-wapp (host-bl-req "/json-post/"))) "edited") true) -(host-bl-test "update missing post -> 404" - (dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/ghost" "Bearer good" - "{\"title\":\"T\",\"body\":\"B\"}"))) +(host-bl-test "update missing -> 404" + (dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/ghost" "Bearer good" "application/json" "{}"))) 404) -(host-bl-test "update no auth -> 401" - (dream-status (host-bl-wapp (host-bl-send "PUT" "/posts/hello" nil "{}"))) - 401) - -;; delete -> 200, then gone (404) and absent from list (host-bl-test "delete -> 200" - (dream-status (host-bl-wapp (host-bl-send "DELETE" "/posts/hello" "Bearer good" ""))) + (dream-status (host-bl-wapp (host-bl-send "DELETE" "/posts/json-post" "Bearer good" "" ""))) 200) -(host-bl-test "deleted post -> 404" - (dream-status (host-bl-wapp (host-bl-send "GET" "/hello/" nil ""))) - 404) -(host-bl-test "deleted post gone from list" - (contains? (dream-resp-body (host-bl-wapp (host-bl-send "GET" "/posts" nil ""))) "hello") - false) +(host-bl-test "deleted -> 404" (dream-status (host-bl-wapp (host-bl-req "/json-post/"))) 404) (host-bl-test "delete missing -> 404" - (dream-status (host-bl-wapp (host-bl-send "DELETE" "/posts/ghost" "Bearer good" ""))) + (dream-status (host-bl-wapp (host-bl-send "DELETE" "/posts/ghost" "Bearer good" "" ""))) 404) (define host-bl-tests-run! - (fn - () + (fn () {:total (+ host-bl-pass host-bl-fail) - :passed host-bl-pass - :failed host-bl-fail - :fails host-bl-fails})) + :passed host-bl-pass :failed host-bl-fail :fails host-bl-fails})) diff --git a/plans/host-on-sx.md b/plans/host-on-sx.md index 17f1734b..993ba3c3 100644 --- a/plans/host-on-sx.md +++ b/plans/host-on-sx.md @@ -36,10 +36,15 @@ host — no `ocaml-on-sx` dependency. ## Status (rolling) -`bash lib/host/conformance.sh` → **158/158** (9 suites: handler, middleware, sxtp, -router, feed, relations, blog, server, ledger). Blog posts now persist in the -durable SX store (`persist/durable-backend`, on-disk under `$SX_PERSIST_DIR`), -materialised into an in-memory view at boot and served from there. +`bash lib/host/conformance.sh` → **171/171** (9 suites: handler, middleware, sxtp, +router, feed, relations, blog, server, ledger). **Blog now runs on the EDITOR's +content model** (`sx_content` = SX element markup, what `blog/sx/editor.sx` +emits), NOT content-on-sx CtDoc: a post is a `{slug,title,sx_content,status}` +record in the durable persist **KV**, and a post page is `render-to-html (parse +sx_content)`. Full CRUD + an editor form-ingest endpoint (`POST /new`, +form-urlencoded) + JSON API, writes auth+ACL guarded. **`render-to-html` is fast +(~0ms)** — it doesn't hit the JIT-miscompiled Smalltalk path, so blog rendering +is no longer the 2s problem (that was content-on-sx's `asHTML`). > **Per-request IO (kernel) — FIXED.** `http-listen` handlers used to run via > `Sx_runtime.sx_call` (bare CEK, no IO resolution), so a handler doing a durable