host: typed relations — Phase 1.5, durable edge store + boot replay
lib/relations holds the graph in memory only (a Datalog cache), so related/tags/ types were wiped on every restart while the posts (durable KV) survived — fatal for a model where tags and types ARE relations. Make the host the durable source of truth. - every physical edge is also a KV row "edge:<src>|<kind>|<dst>" in the blog store (host/blog--add-edge!/--del-edge! wrap relations/relate+unrelate with kv-put/kv-delete). '|' is safe: slugs are [a-z0-9-], kinds are registry names. - host/blog-load-edges! rebuilds the in-memory graph from edge:* keys; serve.sh calls it on boot right after pointing the store at the durable backend. - lib/relations stays an in-memory cache; the durable KV is the source of truth (same shape as the blog pointing at the durable backend). 3 tests: KV row written on relate, replay rebuilds the graph after an in-memory wipe (restart sim), unrelate deletes the row. 247/247. Verified live: related welcome<->hello, force-recreated the container (wipes the in-memory graph), the relation + its rendered block survived the restart. Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
This commit is contained in:
@@ -109,23 +109,59 @@
|
|||||||
(define host/blog--kind-symmetric?
|
(define host/blog--kind-symmetric?
|
||||||
(fn (kind) (let ((s (host/blog--kind-spec kind))) (and s (get s :symmetric)))))
|
(fn (kind) (let ((s (host/blog--kind-spec kind))) (and s (get s :symmetric)))))
|
||||||
|
|
||||||
;; ── edges (parameterised by kind) ───────────────────────────────────
|
;; ── edges (parameterised by kind, DURABLE) ──────────────────────────
|
||||||
|
;; lib/relations holds the graph in memory (a Datalog cache that re-saturates per
|
||||||
|
;; query); it does NOT survive a restart. So the host owns the durable source of
|
||||||
|
;; truth: every physical edge is also a KV row "edge:<src>|<kind>|<dst>" in the
|
||||||
|
;; blog store, replayed into the in-memory graph on boot (host/blog-load-edges!).
|
||||||
|
;; '|' is a safe delimiter — slugs are [a-z0-9-], kinds are registry names.
|
||||||
|
(define host/blog--edge-key (fn (src kind dst) (str "edge:" src "|" kind "|" dst)))
|
||||||
|
|
||||||
|
(define host/blog--add-edge!
|
||||||
|
(fn (src dst kind)
|
||||||
|
(begin
|
||||||
|
(relations/relate (host/blog--node src) (host/blog--node dst) (string->symbol kind))
|
||||||
|
(persist/backend-kv-put host/blog-store (host/blog--edge-key src kind dst) 1))))
|
||||||
|
(define host/blog--del-edge!
|
||||||
|
(fn (src dst kind)
|
||||||
|
(begin
|
||||||
|
(relations/unrelate (host/blog--node src) (host/blog--node dst) (string->symbol kind))
|
||||||
|
(persist/backend-kv-delete host/blog-store (host/blog--edge-key src kind dst)))))
|
||||||
|
|
||||||
;; A symmetric kind writes both directions, so children alone read it from either
|
;; A symmetric kind writes both directions, so children alone read it from either
|
||||||
;; side; a directed kind writes one edge (the inverse is host/blog-in).
|
;; side; a directed kind writes one edge (the inverse is host/blog-in).
|
||||||
(define host/blog-relate!
|
(define host/blog-relate!
|
||||||
(fn (a b kind)
|
(fn (a b kind)
|
||||||
(let ((k (string->symbol kind)))
|
(begin
|
||||||
(begin
|
(host/blog--add-edge! a b kind)
|
||||||
(relations/relate (host/blog--node a) (host/blog--node b) k)
|
(when (host/blog--kind-symmetric? kind) (host/blog--add-edge! b a kind)))))
|
||||||
(when (host/blog--kind-symmetric? kind)
|
|
||||||
(relations/relate (host/blog--node b) (host/blog--node a) k))))))
|
|
||||||
(define host/blog-unrelate!
|
(define host/blog-unrelate!
|
||||||
(fn (a b kind)
|
(fn (a b kind)
|
||||||
(let ((k (string->symbol kind)))
|
(begin
|
||||||
(begin
|
(host/blog--del-edge! a b kind)
|
||||||
(relations/unrelate (host/blog--node a) (host/blog--node b) k)
|
(when (host/blog--kind-symmetric? kind) (host/blog--del-edge! b a kind)))))
|
||||||
(when (host/blog--kind-symmetric? kind)
|
|
||||||
(relations/unrelate (host/blog--node b) (host/blog--node a) k))))))
|
;; rebuild the in-memory graph from the durable edge store — called on boot, after
|
||||||
|
;; the store is pointed at the durable backend. Each "edge:<src>|<kind>|<dst>" key
|
||||||
|
;; is re-applied directly (both directions of a symmetric kind are stored, so no
|
||||||
|
;; symmetry re-derivation is needed here).
|
||||||
|
(define host/blog-load-edges!
|
||||||
|
(fn ()
|
||||||
|
(for-each
|
||||||
|
(fn (key)
|
||||||
|
(let ((body (substr key 5))) ;; drop "edge:"
|
||||||
|
(let ((p1 (index-of body "|")))
|
||||||
|
(when (>= p1 0)
|
||||||
|
(let ((src (substr body 0 p1))
|
||||||
|
(tail (substr body (+ p1 1))))
|
||||||
|
(let ((p2 (index-of tail "|")))
|
||||||
|
(when (>= p2 0)
|
||||||
|
(relations/relate
|
||||||
|
(host/blog--node src)
|
||||||
|
(host/blog--node (substr tail (+ p2 1)))
|
||||||
|
(string->symbol (substr tail 0 p2))))))))))
|
||||||
|
(filter (fn (k) (starts-with? k "edge:"))
|
||||||
|
(persist/backend-kv-keys host/blog-store)))))
|
||||||
|
|
||||||
;; nodes -> existing blog slugs: strip "blog:", drop non-blog and deleted targets.
|
;; nodes -> existing blog slugs: strip "blog:", drop non-blog and deleted targets.
|
||||||
;; Existence is one kv-keys read (host/blog-slugs), NOT a perform per candidate —
|
;; Existence is one kv-keys read (host/blog-slugs), NOT a perform per candidate —
|
||||||
|
|||||||
@@ -105,6 +105,12 @@ EPOCH=1
|
|||||||
echo "(epoch $EPOCH)"
|
echo "(epoch $EPOCH)"
|
||||||
echo "(eval \"(host/blog-use-store! (persist/durable-backend))\")"
|
echo "(eval \"(host/blog-use-store! (persist/durable-backend))\")"
|
||||||
EPOCH=$((EPOCH+1))
|
EPOCH=$((EPOCH+1))
|
||||||
|
# Rebuild the relations graph from the durable edge store. lib/relations holds
|
||||||
|
# the graph in memory only, so without this, related/tags/types vanish on every
|
||||||
|
# restart even though the posts persist.
|
||||||
|
echo "(epoch $EPOCH)"
|
||||||
|
echo "(eval \"(host/blog-load-edges!)\")"
|
||||||
|
EPOCH=$((EPOCH+1))
|
||||||
# Session signing secret + admin login credentials, then grant the admin
|
# Session signing secret + admin login credentials, then grant the admin
|
||||||
# principal "edit" on "blog" so a logged-in session passes the ACL gate on the
|
# principal "edit" on "blog" so a logged-in session passes the ACL gate on the
|
||||||
# write routes. Sessions stay IN-MEMORY (default store) — logins reset on
|
# write routes. Sessions stay IN-MEMORY (default store) — logins reset on
|
||||||
|
|||||||
@@ -314,6 +314,24 @@
|
|||||||
"application/x-www-form-urlencoded" "other=beta-post"))
|
"application/x-www-form-urlencoded" "other=beta-post"))
|
||||||
(contains? (host/blog-out "alpha-post" "related") "beta-post"))
|
(contains? (host/blog-out "alpha-post" "related") "beta-post"))
|
||||||
true)
|
true)
|
||||||
|
(host-bl-test "edges are durable: KV row written on relate"
|
||||||
|
(begin
|
||||||
|
(host/blog-relate! "alpha-post" "gamma-post" "tagged")
|
||||||
|
(persist/backend-kv-has? host/blog-store (host/blog--edge-key "alpha-post" "tagged" "gamma-post")))
|
||||||
|
true)
|
||||||
|
(host-bl-test "replay rebuilds the graph after an in-memory wipe (restart sim)"
|
||||||
|
(begin
|
||||||
|
(relations/load! (list)) ;; simulate a fresh process
|
||||||
|
(host/blog-load-edges!) ;; replay from the durable store
|
||||||
|
(list (contains? (host/blog-out "alpha-post" "tagged") "gamma-post")
|
||||||
|
(contains? (host/blog-out "alpha-post" "related") "beta-post")
|
||||||
|
(contains? (host/blog-out "beta-post" "related") "alpha-post")))
|
||||||
|
(list true true true))
|
||||||
|
(host-bl-test "unrelate deletes the durable KV row"
|
||||||
|
(begin
|
||||||
|
(host/blog-unrelate! "alpha-post" "gamma-post" "tagged")
|
||||||
|
(persist/backend-kv-has? host/blog-store (host/blog--edge-key "alpha-post" "tagged" "gamma-post")))
|
||||||
|
false)
|
||||||
|
|
||||||
;; -- experimental unguarded create-only route (POST /new, no auth) --
|
;; -- 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)))
|
(define host-bl-oapp (host/make-app (list host/blog-open-create-routes host/blog-routes)))
|
||||||
|
|||||||
Reference in New Issue
Block a user