host: relations-as-posts slice 3 — typed relations (target-type constraint enforced)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 46s

A relation's declares-anchor IS its target-type constraint: is-a/subtype-of (anchored
by type) require a type object; tagged (anchored by tag) a tag; related (no anchor) any
post. host/blog--valid-object?(kind, other) = other ∈ the relation's candidate pool — the
SAME set the picker offers — and relate-submit now enforces it (invalid target = silent
no-op). The picker never offers an invalid target, so this guards crafted/API requests:
the jump from candidate set to an enforced relation schema. A new typed relation needs
only a relation-post + a '<TargetType> declares <rel>' edge.

host/blog-relate! (direct/seed) stays unvalidated — validation is a handler boundary
(the seed writes 'X is-a relation', and relation isn't under type).

conformance 291/291 (+4: valid-object? accepts types/tags/any, relate-submit creates the
edge for a type object and no-ops for a non-type).

Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
2026-06-30 07:25:49 +00:00
parent 9c148e58dc
commit 90190346aa
3 changed files with 53 additions and 7 deletions

View File

@@ -502,6 +502,31 @@
(contains? kinds "subtype-of") (contains? kinds "tagged")))
(list true true true true))
;; -- relations are TYPED: the target-type constraint is enforced (slice 3) --
;; A valid object of a relation is one in its declared candidate set (the picker's
;; pool). So is-a's object must be a type, tagged's must be a tag, related's any post.
(host-bl-test "valid-object?: is-a accepts a type (article), rejects a plain post (ppost)"
(list (host/blog--valid-object? "is-a" "article") (host/blog--valid-object? "is-a" "ppost"))
(list true false))
(host-bl-test "valid-object?: tagged accepts a tag (ocaml); related accepts any post"
(list (host/blog--valid-object? "tagged" "ocaml") (host/blog--valid-object? "related" "ppost"))
(list true true))
;; the relate ENDPOINT enforces it: is-a to a type relates; is-a to a non-type no-ops.
(host/blog-unrelate! "alpha-post" "article" "is-a")
(host-bl-test "relate-submit: is-a to a type (article) creates the edge"
(begin
(host/blog-relate-submit (host-bl-relreq "alpha-post" "relate"
{:sx-request "true" :sx-target "#rel-editor-is-a"} "article" "is-a"))
(contains? (host/blog-out "alpha-post" "is-a") "article"))
true)
(host/blog-unrelate! "alpha-post" "article" "is-a")
(host-bl-test "relate-submit: is-a to a NON-type (beta-post) is rejected (no edge)"
(begin
(host/blog-relate-submit (host-bl-relreq "alpha-post" "relate"
{:sx-request "true" :sx-target "#rel-editor-is-a"} "beta-post" "is-a"))
(contains? (host/blog-out "alpha-post" "is-a") "beta-post"))
false)
;; -- 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"))