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
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:
@@ -408,6 +408,16 @@
|
||||
(host/blog-slugs)
|
||||
(host/blog--reach-down anchors)))))
|
||||
|
||||
;; Slice 3 — typed relations: a post is a valid OBJECT (target end) of `kind` iff it's
|
||||
;; in the relation's declared candidate set (the down-closure of kind's declares-anchors
|
||||
;; — the target-type constraint). The SAME set the picker offers, so the picker and
|
||||
;; the relate endpoint agree by construction. A relation with no anchor (`related`)
|
||||
;; accepts any existing post. This is what turns "candidate set" into an enforced
|
||||
;; relation schema: is-a's object must be a type, tagged's must be a tag, etc.
|
||||
(define host/blog--valid-object?
|
||||
(fn (kind other)
|
||||
(contains? (host/blog--candidate-pool kind) other)))
|
||||
|
||||
(define host/blog--relate-candidates
|
||||
(fn (slug q kind)
|
||||
(let ((spec (host/blog--kind-spec kind)))
|
||||
@@ -1006,8 +1016,14 @@
|
||||
(host/blog--page req "Not found"
|
||||
(quasiquote (div (h1 "404") (p (unquote (str "No post: " slug)))))))
|
||||
(begin
|
||||
;; …and `other` must satisfy the relation's TARGET-TYPE CONSTRAINT
|
||||
;; (host/blog--valid-object?): you can only declare `slug is-a <a type>`,
|
||||
;; tag with `<a tag>`, etc. The picker never offers an invalid target, so
|
||||
;; this enforces the same schema against crafted/API requests; an invalid
|
||||
;; relate is a silent no-op (consistent with the other guards here).
|
||||
(when (and other (not (= other "")) (not (= other slug))
|
||||
(host/blog--kind-spec kind) (host/blog-exists? other))
|
||||
(host/blog--kind-spec kind) (host/blog-exists? other)
|
||||
(host/blog--valid-object? kind other))
|
||||
(host/blog-relate! slug other kind))
|
||||
;; AJAX (the picker's sx-post, carries SX-Target): return the re-rendered
|
||||
;; editor for this kind so its sx-swap="outerHTML" replaces #rel-editor-KIND
|
||||
|
||||
Reference in New Issue
Block a user