host: Phase 3 — relations WRITE cut-over (attach/detach-child), 132/132
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 17s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 17s
Migrate the container relations write actions onto lib/relations: POST /internal/actions/attach-child + /detach-child dispatch to relations/relate and relations/unrelate over the same "type:id" node model, behind the auth+ACL pipeline (wrap-errors . require-auth . require-permission), mirroring POST /feed. Closed-loop test: attach -> visible via get-children -> detach -> gone; 401/403/400 guards. Ledger now models the full relations surface (7 endpoints): container reads+writes migrated, typed relate/unrelate/can-relate proxied (registry+cardinality validation not in lib/relations). Off-Quart coverage 45% -> 50%. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -41,11 +41,19 @@
|
||||
"find migrated relations read -> handler"
|
||||
(get (host/ledger-find host/ledger "GET" "/internal/data/get-children") :handler)
|
||||
"host/relations-children")
|
||||
(host-lg-test
|
||||
"find migrated relations write -> handler"
|
||||
(get (host/ledger-find host/ledger "POST" "/internal/actions/attach-child") :handler)
|
||||
"host/relations-attach")
|
||||
(host-lg-test
|
||||
"typed relate still proxied"
|
||||
(get (host/ledger-find host/ledger "POST" "/internal/actions/relate") :status)
|
||||
"proxied")
|
||||
|
||||
;; ── status queries ──────────────────────────────────────────────────
|
||||
(host-lg-test "migrated count" (len (host/ledger-migrated host/ledger)) 4)
|
||||
(host-lg-test "migrated count" (len (host/ledger-migrated host/ledger)) 6)
|
||||
(host-lg-test "native count" (len (host/ledger-native host/ledger)) 1)
|
||||
(host-lg-test "proxied count" (len (host/ledger-proxied host/ledger)) 6)
|
||||
(host-lg-test "proxied count" (len (host/ledger-proxied host/ledger)) 7)
|
||||
|
||||
;; ── served? predicate ───────────────────────────────────────────────
|
||||
(host-lg-test
|
||||
@@ -62,7 +70,7 @@
|
||||
false)
|
||||
|
||||
;; ── domain queries ──────────────────────────────────────────────────
|
||||
(host-lg-test "relations domain count" (len (host/ledger-by-domain host/ledger "relations")) 4)
|
||||
(host-lg-test "relations domain count" (len (host/ledger-by-domain host/ledger "relations")) 7)
|
||||
(host-lg-test "likes domain count" (len (host/ledger-by-domain host/ledger "likes")) 4)
|
||||
(host-lg-test "domains count" (len (host/ledger-domains host/ledger)) 4)
|
||||
(host-lg-test
|
||||
@@ -76,12 +84,12 @@
|
||||
|
||||
;; ── coverage ────────────────────────────────────────────────────────
|
||||
(define host-lg-cov (host/ledger-coverage host/ledger))
|
||||
(host-lg-test "coverage total" (get host-lg-cov :total) 11)
|
||||
(host-lg-test "coverage migrated" (get host-lg-cov :migrated) 4)
|
||||
(host-lg-test "coverage proxied" (get host-lg-cov :proxied) 6)
|
||||
(host-lg-test "coverage total" (get host-lg-cov :total) 14)
|
||||
(host-lg-test "coverage migrated" (get host-lg-cov :migrated) 6)
|
||||
(host-lg-test "coverage proxied" (get host-lg-cov :proxied) 7)
|
||||
(host-lg-test "coverage native" (get host-lg-cov :native) 1)
|
||||
(host-lg-test "coverage served" (get host-lg-cov :served) 5)
|
||||
(host-lg-test "coverage percent" (get host-lg-cov :percent) 45)
|
||||
(host-lg-test "coverage served" (get host-lg-cov :served) 7)
|
||||
(host-lg-test "coverage percent" (get host-lg-cov :percent) 50)
|
||||
|
||||
(define
|
||||
host-lg-tests-run!
|
||||
|
||||
@@ -102,6 +102,74 @@
|
||||
(host/-rel-strings (relations/parents (host-rl-sym "list:7") (host-rl-sym "member"))))
|
||||
"}"))
|
||||
|
||||
;; ── writes: attach-child / detach-child (auth + ACL + closed loop) ──
|
||||
(acl/load!
|
||||
(list
|
||||
(acl-grant "carol" "relate" "relations")
|
||||
(acl-grant "carol" "unrelate" "relations")))
|
||||
;; carol is permitted; dave authenticates but has no grant.
|
||||
(define host-rl-resolve
|
||||
(fn (tok)
|
||||
(cond ((= tok "good") "carol") ((= tok "weak") "dave") (true nil))))
|
||||
(define host-rl-wapp
|
||||
(host/make-app
|
||||
(list host/relations-routes (host/relations-write-routes host-rl-resolve))))
|
||||
(define host-rl-post
|
||||
(fn (action auth body)
|
||||
(dream-request "POST" (str "/internal/actions/" action)
|
||||
(if auth {:authorization auth} {}) body)))
|
||||
(define host-rl-edge
|
||||
"{\"parent-type\":\"org\",\"parent-id\":\"2\",\"child-type\":\"list\",\"child-id\":\"5\",\"relation-type\":\"member\"}")
|
||||
(define host-rl-org2
|
||||
"/internal/data/get-children?parent-type=org&parent-id=2&relation-type=member")
|
||||
|
||||
(relations/load! (list))
|
||||
|
||||
;; auth gate
|
||||
(host-rl-test
|
||||
"attach no auth -> 401"
|
||||
(dream-status (host-rl-wapp (host-rl-post "attach-child" nil "{}")))
|
||||
401)
|
||||
(host-rl-test
|
||||
"attach authed-but-unpermitted -> 403"
|
||||
(dream-status (host-rl-wapp (host-rl-post "attach-child" "Bearer weak" host-rl-edge)))
|
||||
403)
|
||||
(host-rl-test
|
||||
"graph unchanged after 403"
|
||||
(len (relations/children (host-rl-sym "org:2") (host-rl-sym "member")))
|
||||
0)
|
||||
|
||||
;; permitted attach -> 201, and visible through the migrated read
|
||||
(host-rl-test
|
||||
"attach authed+permitted -> 201"
|
||||
(dream-status (host-rl-wapp (host-rl-post "attach-child" "Bearer good" host-rl-edge)))
|
||||
201)
|
||||
(host-rl-test
|
||||
"attached edge visible via get-children"
|
||||
(contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-org2))) "list:5")
|
||||
true)
|
||||
|
||||
;; detach -> 200, and gone from the read
|
||||
(host-rl-test
|
||||
"detach authed+permitted -> 200"
|
||||
(dream-status (host-rl-wapp (host-rl-post "detach-child" "Bearer good" host-rl-edge)))
|
||||
200)
|
||||
(host-rl-test
|
||||
"detached edge gone from get-children"
|
||||
(contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-org2))) "list:5")
|
||||
false)
|
||||
|
||||
;; bad payloads
|
||||
(host-rl-test
|
||||
"attach non-object body -> 400"
|
||||
(dream-status (host-rl-wapp (host-rl-post "attach-child" "Bearer good" "[1,2]")))
|
||||
400)
|
||||
(host-rl-test
|
||||
"attach missing param -> 400"
|
||||
(dream-status
|
||||
(host-rl-wapp (host-rl-post "attach-child" "Bearer good" "{\"parent-type\":\"org\"}")))
|
||||
400)
|
||||
|
||||
(define
|
||||
host-rl-tests-run!
|
||||
(fn
|
||||
|
||||
Reference in New Issue
Block a user