;; lib/host/tests/relations.sx — the migrated relations read endpoints,
;; GET /internal/data/get-children and /get-parents, dispatching to lib/relations.
;; Golden tests pin each endpoint to "subsystem call + standard envelope": the
;; host adds the HTTP/JSON shell over relations/children|parents and nothing else
;; (golden derived from the same subsystem call, so result order matches).

(define host-rl-pass 0)
(define host-rl-fail 0)
(define host-rl-fails (list))

(define
  host-rl-test
  (fn
    (name actual expected)
    (if
      (= actual expected)
      (set! host-rl-pass (+ host-rl-pass 1))
      (begin
        (set! host-rl-fail (+ host-rl-fail 1))
        (append! host-rl-fails {:name name :actual actual :expected expected})))))

(define host-rl-req (fn (target) (dream-request "GET" target {} "")))
(define host-rl-app (host/make-app (list host/relations-routes)))
(define host-rl-sym (fn (s) (string->symbol s)))

;; ── seed a known graph ──────────────────────────────────────────────
;; org:1 --member--> list:7, list:8 ; org:1 --owner--> page:9
(relations/load! (list))
(relations/relate (host-rl-sym "org:1") (host-rl-sym "list:7") (host-rl-sym "member"))
(relations/relate (host-rl-sym "org:1") (host-rl-sym "list:8") (host-rl-sym "member"))
(relations/relate (host-rl-sym "org:1") (host-rl-sym "page:9") (host-rl-sym "owner"))

;; ── get-children ────────────────────────────────────────────────────
(define host-rl-kids
  "/internal/data/get-children?parent-type=org&parent-id=1&relation-type=member")
(host-rl-test "children 200" (dream-status (host-rl-app (host-rl-req host-rl-kids))) 200)
(host-rl-test
  "children has list:7"
  (contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-kids))) "list:7")
  true)
(host-rl-test
  "children has list:8"
  (contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-kids))) "list:8")
  true)
(host-rl-test
  "children excludes other-kind page:9"
  (contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-kids))) "page:9")
  false)
(host-rl-test
  "children count via subsystem"
  (len (relations/children (host-rl-sym "org:1") (host-rl-sym "member")))
  2)

;; child-type filter narrows by node prefix.
(host-rl-test
  "children child-type=list keeps both"
  (contains?
    (dream-resp-body (host-rl-app (host-rl-req (str host-rl-kids "&child-type=list"))))
    "list:8")
  true)
(host-rl-test
  "children child-type=page filters all out"
  (contains?
    (dream-resp-body (host-rl-app (host-rl-req (str host-rl-kids "&child-type=page"))))
    "list:7")
  false)

;; ── get-parents ─────────────────────────────────────────────────────
(define host-rl-par
  "/internal/data/get-parents?child-type=list&child-id=7&relation-type=member")
(host-rl-test "parents 200" (dream-status (host-rl-app (host-rl-req host-rl-par))) 200)
(host-rl-test
  "parents has org:1"
  (contains? (dream-resp-body (host-rl-app (host-rl-req host-rl-par))) "org:1")
  true)

;; ── missing required params -> 400 ──────────────────────────────────
(host-rl-test
  "children missing param -> 400"
  (dream-status (host-rl-app (host-rl-req "/internal/data/get-children?parent-type=org")))
  400)
(host-rl-test
  "parents missing param -> 400"
  (dream-status (host-rl-app (host-rl-req "/internal/data/get-parents?child-type=list")))
  400)

;; ── golden: endpoint = subsystem call + envelope ────────────────────
(host-rl-test
  "golden children"
  (dream-resp-body (host-rl-app (host-rl-req host-rl-kids)))
  (str
    "{\"ok\":true,\"data\":"
    (dream-json-encode
      (host/-rel-strings (relations/children (host-rl-sym "org:1") (host-rl-sym "member"))))
    "}"))
(host-rl-test
  "golden parents"
  (dream-resp-body (host-rl-app (host-rl-req host-rl-par)))
  (str
    "{\"ok\":true,\"data\":"
    (dream-json-encode
      (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
    ()
    {:total (+ host-rl-pass host-rl-fail)
     :passed host-rl-pass
     :failed host-rl-fail
     :fails host-rl-fails}))