host: relate posts — "related posts" on blog × relations (blog 61/61, 230)
Compose two already-migrated domains: a post is a relations-graph node "blog:<slug>", and a "related" link is a symmetric pair of edges (lib/relations). The post page shows a "Related posts" block; the edit page gets an editor to add (by slug) and remove relations. - host/blog-relate!/unrelate!/related: symmetric edges under kind "related"; related slugs = blog children, existence-filtered against ONE kv-keys read. - post page: "Related posts" links block; edit page: related editor (remove buttons + add-by-slug box). - POST /:slug/relate, /:slug/unrelate — guarded browser routes (redirect to login like the other write routes); relate validates the other post exists. - delete cleans up a post's related edges (no dangling links). IO ORDERING (the live 500 that conformance missed): host/blog--related-block/ -editor do durable reads (perform). Performing inside the quasiquote, via unquote, while the page tree renders raised Sx_vm.VmSuspended under http-listen; the in-memory conformance store never performs, so it passed. Fix mirrors host/blog-home: do the reads in the handler's let bindings BEFORE the quasiquote, and check related-existence against a single host/blog-slugs read rather than a perform per candidate inside filter. 9 relate tests (guard, symmetry, render, no-op on missing, unrelate both ways, delete cleanup). Verified live: relate -> Related block both ways; unrelate clears it; posts without relations and the whole site stay 200. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -211,6 +211,44 @@
|
||||
(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)
|
||||
|
||||
;; -- 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))
|
||||
|
||||
Reference in New Issue
Block a user