coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
62b7fc1ff0a245cdac1b319053ca50da9dcc70f3
rose-ash/lib/host/tests/blog.sx
giles 62b7fc1ff0 host: typed relations — Phase 3, tags as posts 
A tag is just a post that is-a tag; tagging is a "tagged" edge to it. End to end:
mark a post a tag, tag posts with it, see a post's tags and a tag's members.

- helpers: host/blog-is-tag? (= is-a? slug "tag"), host/blog-tags (out tagged),
  host/blog-tagged-with (in tagged), host/blog-instances-of (a type's members,
  O(#subtypes) not O(#posts) — the efficient candidate source).
- picker generalised to be KIND-AWARE and MULTI-INSTANCE: relate-options takes
  &kind=, candidates come from the kind's registry :candidates (all/tags/types);
  /relate-picker.js wires every .relate-picker box by data-kind (a Related picker
  and a Tags picker now coexist on the edit page).
- render: post page gains a "Tags" block; a tag post additionally lists "Tagged
  with this" (its members). edit page: a Related editor + a Tags editor + an
  "is this post a tag" toggle (reuses /relate kind=is-a — no new route).
- GOTCHA (again): host/blog--relation-editor read host/blog-out INSIDE its
  quasiquote -> VmSuspended/500 under http-listen + durable edges; moved the read
  to a let before the quasiquote (conformance can't see it — in-memory store;
  the ephemeral Playwright run caught it).

6 conformance tests (is-tag?, instances-of, tag+tagged-with, tagged picker offers
only tags, related picker still all, is-a-tag toggle) -> 261/261. Playwright
multi-picker 4/4. Verified live: ocaml made a tag, welcome tagged ocaml, Tags
block + Tagged-with-this both render.

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
2026-06-28 17:09:53 +00:00

414 lines
21 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters
This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;; 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)
(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 {} "")))
(define host-bl-app (host/make-app (list host/feed-routes host/blog-routes)))
;; ── 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-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 "/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 sx_content markup"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/hello/"))) "<strong>bold</strong>")
true)
(host-bl-test "post title in page"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/hello/"))) "<title>Hello World</title>")
true)
;; ── 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"))) "<form")
true)
;; ── unknown + precedence ────────────────────────────────────────────
(host-bl-test "unknown slug 404" (dream-status (host-bl-app (host-bl-req "/nope/"))) 404)
(feed/reset!)
(host-bl-test "/feed not captured by :slug"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/feed"))) "\"ok\":true")
true)
;; ── writes: editor form ingest + JSON CRUD (auth+ACL) ───────────────
(acl/load! (list (acl-grant "editor" "edit" "blog")))
(define host-bl-resolve
(fn (tok) (cond ((= tok "good") "editor") ((= tok "weak") "reader") (true nil))))
(define host-bl-wapp
(host/make-app (list (host/blog-write-routes host-bl-resolve) host/blog-routes)))
(define host-bl-send
(fn (method target auth ctype body)
(dream-request method target
(merge (if auth {:authorization auth} {}) (if ctype {:content-type ctype} {})) body)))
(host/blog-use-store! (persist/open))
;; -- editor form ingest (form-urlencoded, the editor's submit shape) --
(host-bl-test "form ingest no auth -> redirect to login"
(dream-status (host-bl-wapp (host-bl-send "POST" "/new" nil
"application/x-www-form-urlencoded" "title=X")))
303)
(host-bl-test "form ingest no auth Location is /login"
(contains? (dream-resp-header (host-bl-wapp (host-bl-send "POST" "/new" nil
"application/x-www-form-urlencoded" "title=X")) "location") "/login")
true)
(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/"))) "<h1>My First Post</h1>")
true)
;; -- 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)
(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)
(host-bl-test "json create no title -> 400"
(dream-status (host-bl-wapp (host-bl-send "POST" "/posts" "Bearer good" "application/json" "{}")))
400)
(host-bl-test "update -> 200"
(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 content"
(contains? (dream-resp-body (host-bl-wapp (host-bl-req "/json-post/"))) "edited")
true)
(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 "delete -> 200"
(dream-status (host-bl-wapp (host-bl-send "DELETE" "/posts/json-post" "Bearer good" "" "")))
200)
(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" "" "")))
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)
;; -- 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 -> redirect to login"
(dream-status (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" nil "" ""))) 303)
(host-bl-test "edit form no auth Location carries next=/…/edit"
(contains?
(dream-resp-header (host-bl-wapp (host-bl-send "GET" "/my-first-post/edit" nil "" "")) "location")
"/login?next=/my-first-post/edit")
true)
(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 -> redirect to login"
(dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/edit" nil
"application/x-www-form-urlencoded" "sx_content=(p+%22x%22)"))) 303)
(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)
;; -- auth footer (discoverable login/logout) --
(host-bl-test "home footer shows a log in link when anonymous"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/"))) ">log in</a>") true)
(host-bl-test "post footer shows a log in link when anonymous"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/my-first-post/"))) ">log in</a>") true)
(host-bl-test "GET /logout -> 303"
(dream-status (host-bl-app (host-bl-req "/logout"))) 303)
;; -- relate posts (blog × relations) --
;; my-first-post and another-one both exist in the write-test store at this point.
(host-bl-test "relate no auth -> redirect to login"
(dream-status (host-bl-wapp (host-bl-send "POST" "/my-first-post/relate" nil
"application/x-www-form-urlencoded" "other=another-one"))) 303)
(host-bl-test "relate authed -> 303 back to edit"
(dream-resp-header (host-bl-wapp (host-bl-send "POST" "/my-first-post/relate" "Bearer good"
"application/x-www-form-urlencoded" "other=another-one")) "location")
"/my-first-post/edit")
(host-bl-test "related is symmetric (a -> b)"
(contains? (host/blog-related "my-first-post") "another-one") true)
(host-bl-test "related is symmetric (b -> a)"
(contains? (host/blog-related "another-one") "my-first-post") true)
(host-bl-test "post page shows a Related posts block"
(contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "Related posts") true)
(host-bl-test "post page links the related post"
(contains? (dream-resp-body (host-bl-wapp (host-bl-req "/my-first-post/"))) "/another-one/") true)
(host-bl-test "relate nonexistent other -> no-op"
(begin
(host-bl-wapp (host-bl-send "POST" "/my-first-post/relate" "Bearer good"
"application/x-www-form-urlencoded" "other=ghost-post"))
(contains? (host/blog-related "my-first-post") "ghost-post"))
false)
(host-bl-test "unrelate -> removes the link both ways"
(begin
(host-bl-wapp (host-bl-send "POST" "/my-first-post/unrelate" "Bearer good"
"application/x-www-form-urlencoded" "other=another-one"))
(list (contains? (host/blog-related "my-first-post") "another-one")
(contains? (host/blog-related "another-one") "my-first-post")))
(list false false))
(host-bl-test "delete cleans up related edges"
(begin
(host-bl-wapp (host-bl-send "POST" "/my-first-post/relate" "Bearer good"
"application/x-www-form-urlencoded" "other=another-one"))
(host-bl-wapp (host-bl-send "DELETE" "/posts/another-one" "Bearer good" "" ""))
(contains? (host/blog-related "my-first-post") "another-one"))
false)
;; -- relate picker (filterable candidate endpoint + glue + hint) --
(host/blog-put! "alpha-post" "Alpha Post" "(p \"a\")" "published")
(host/blog-put! "beta-post" "Beta Post" "(p \"b\")" "published")
(host/blog-put! "gamma-post" "Gamma Post" "(p \"g\")" "published")
(host-bl-test "relate-options lists other posts"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options"))) "Beta Post") true)
(host-bl-test "relate-options excludes the post itself"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options"))) ">Alpha Post<") false)
(host-bl-test "relate-options filters by q (title substring)"
(let ((body (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options?q=beta")))))
(list (contains? body "Beta Post") (contains? body "Gamma Post")))
(list true false))
(host-bl-test "relate-options filter url-decodes q (spaces)"
(let ((body (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options?q=Beta%20Post")))))
(list (contains? body "Beta Post") (contains? body "Gamma Post")))
(list true false))
(host-bl-test "relate-options excludes already-related candidates"
(begin
(host/blog-relate! "alpha-post" "beta-post" "related")
(contains? (dream-resp-body (host-bl-app (host-bl-req "/alpha-post/relate-options"))) "Beta Post"))
false)
(host/blog-unrelate! "alpha-post" "beta-post" "related")
(host-bl-test "relate-picker.js served as javascript"
(dream-resp-header (host-bl-app (host-bl-req "/relate-picker.js")) "content-type")
"application/javascript; charset=utf-8")
(host-bl-test "relate-picker.js carries the fetch glue"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/relate-picker.js"))) "relate-options") true)
(host-bl-test "related block: hint when logged-in + no relations"
(contains? (str (host/blog--related-block "gamma-post" true)) "add some") true)
(host-bl-test "related block: empty when anonymous + no relations"
(= (host/blog--related-block "gamma-post" false) "") true)
;; -- Phase 1: relations carry a kind --
(host-bl-test "symmetric kind (related) reads from both sides"
(begin
(host/blog-relate! "alpha-post" "gamma-post" "related")
(list (contains? (host/blog-out "alpha-post" "related") "gamma-post")
(contains? (host/blog-out "gamma-post" "related") "alpha-post")))
(list true true))
(host-bl-test "directed kind (tagged) writes one direction; inverse via host/blog-in"
(begin
(host/blog-relate! "alpha-post" "beta-post" "tagged")
(list (contains? (host/blog-out "alpha-post" "tagged") "beta-post")
(contains? (host/blog-out "beta-post" "tagged") "alpha-post")
(contains? (host/blog-in "beta-post" "tagged") "alpha-post")))
(list true false true))
(host-bl-test "unrelate is kind-scoped (related edge survives a tagged unrelate)"
(begin
(host/blog-unrelate! "alpha-post" "beta-post" "tagged")
(list (contains? (host/blog-out "alpha-post" "tagged") "beta-post")
(contains? (host/blog-out "alpha-post" "related") "gamma-post")))
(list false true))
(host/blog-unrelate! "alpha-post" "gamma-post" "related")
(host-bl-test "relate-submit rejects an unknown kind (no-op)"
(begin
(host-bl-wapp (host-bl-send "POST" "/alpha-post/relate" "Bearer good"
"application/x-www-form-urlencoded" "other=beta-post&kind=bogus"))
(contains? (host/blog-out "alpha-post" "bogus") "beta-post"))
false)
(host-bl-test "default kind is related (no kind field)"
(begin
(host-bl-wapp (host-bl-send "POST" "/alpha-post/relate" "Bearer good"
"application/x-www-form-urlencoded" "other=beta-post"))
(contains? (host/blog-out "alpha-post" "related") "beta-post"))
true)
(host-bl-test "edges are durable: KV row written on relate"
(begin
(host/blog-relate! "alpha-post" "gamma-post" "tagged")
(persist/backend-kv-has? host/blog-store (host/blog--edge-key "alpha-post" "tagged" "gamma-post")))
true)
(host-bl-test "replay rebuilds the graph after an in-memory wipe (restart sim)"
(begin
(relations/load! (list)) ;; simulate a fresh process
(host/blog-load-edges!) ;; replay from the durable store
(list (contains? (host/blog-out "alpha-post" "tagged") "gamma-post")
(contains? (host/blog-out "alpha-post" "related") "beta-post")
(contains? (host/blog-out "beta-post" "related") "alpha-post")))
(list true true true))
(host-bl-test "unrelate deletes the durable KV row"
(begin
(host/blog-unrelate! "alpha-post" "gamma-post" "tagged")
(persist/backend-kv-has? host/blog-store (host/blog--edge-key "alpha-post" "tagged" "gamma-post")))
false)
;; -- Phase 2: typing with subsumption (is-a + subtype-of) --
;; ppost --is-a--> ptutorial ; ptutorial --subtype-of--> particle --subtype-of--> pdoc
(host/blog-put! "ptutorial" "P Tutorial" "(p \"t\")" "published")
(host/blog-put! "particle" "P Article" "(p \"a\")" "published")
(host/blog-put! "pdoc" "P Doc" "(p \"d\")" "published")
(host/blog-put! "ppost" "P Post" "(p \"p\")" "published")
(host/blog-relate! "ptutorial" "particle" "subtype-of")
(host/blog-relate! "particle" "pdoc" "subtype-of")
(host/blog-relate! "ppost" "ptutorial" "is-a")
(host-bl-test "types-of = declared type + ALL its subtype-of supertypes"
(list (contains? (host/blog-types-of "ppost") "ptutorial")
(contains? (host/blog-types-of "ppost") "particle")
(contains? (host/blog-types-of "ppost") "pdoc"))
(list true true true))
(host-bl-test "is-a? is transitive THROUGH subtype-of (subsumption)"
(list (host/blog-is-a? "ppost" "ptutorial")
(host/blog-is-a? "ppost" "pdoc"))
(list true true))
(host-bl-test "is-a? alone does NOT chain (instance-of is not transitive)"
(begin
(host/blog-put! "pmeta" "P Meta" "(p \"m\")" "published")
(host/blog-relate! "pmeta" "ppost" "is-a") ;; pmeta is-a ppost is-a ptutorial
(host/blog-is-a? "pmeta" "ptutorial")) ;; ... does NOT make pmeta is-a ptutorial
false)
(host-bl-test "is-a? false for an unrelated type"
(host/blog-is-a? "ppost" "particle") true) ;; sanity: this one IS reachable
(host-bl-test "seed-types: an instance of tag is, transitively, a type"
(begin
(host/blog-seed-types!) ;; type, tag, tag subtype-of type
(host/blog-put! "ocaml" "OCaml" "(p \"lang\")" "published")
(host/blog-relate! "ocaml" "tag" "is-a") ;; ocaml is-a tag
(list (host/blog-is-a? "ocaml" "tag") (host/blog-is-a? "ocaml" "type")))
(list true true))
(host-bl-test "type-valid? is vacuously true with no schemas (gradual)"
(host/blog-type-valid? "ppost" "(p \"anything\")") true)
;; -- Phase 3: tags as posts -- (ocaml is-a tag, from the seed-types test above)
(host-bl-test "is-tag?: a post that is-a tag is a tag; others are not"
(list (host/blog-is-tag? "ocaml") (host/blog-is-tag? "ppost"))
(list true false))
(host-bl-test "instances-of tag includes the tag posts"
(contains? (host/blog-instances-of "tag") "ocaml") true)
(host-bl-test "tag a post: it appears in tags + tagged-with (inverse)"
(begin
(host/blog-relate! "ppost" "ocaml" "tagged") ;; ppost tagged ocaml
(list (contains? (host/blog-tags "ppost") "ocaml")
(contains? (host/blog-tagged-with "ocaml") "ppost")))
(list true true))
(host-bl-test "tagged picker offers only tags (kind=tagged)"
(let ((body (dream-resp-body (host-bl-app (host-bl-req "/particle/relate-options?kind=tagged")))))
(list (contains? body ">OCaml<") (contains? body ">P Article<")))
(list true false))
(host-bl-test "related picker still offers all posts (kind defaults to related)"
(contains? (dream-resp-body (host-bl-app (host-bl-req "/particle/relate-options"))) ">P Doc<")
true)
(host-bl-test "is-a-tag toggle marks a post a tag via /relate kind=is-a"
(begin
(host-bl-wapp (host-bl-send "POST" "/pdoc/relate" "Bearer good"
"application/x-www-form-urlencoded" "other=tag&kind=is-a"))
(host/blog-is-tag? "pdoc"))
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))
(host-bl-test "open create no auth -> 303"
(dream-status (host-bl-oapp (host-bl-send "POST" "/new" nil
"application/x-www-form-urlencoded" "title=Open+Post&sx_content=(p+%22o%22)&status=published")))
303)
(host-bl-test "open-created post renders"
(contains? (dream-resp-body (host-bl-oapp (host-bl-req "/open-post/"))) "<p>o</p>")
true)
(define
host-bl-tests-run!
(fn ()
{:total (+ host-bl-pass host-bl-fail)
:passed host-bl-pass :failed host-bl-fail :fails host-bl-fails}))
Reference in New Issue View Git Blame Copy Permalink