From d13c4dd5fe86accef1bc46fdadb5c478aedc64b2 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 2 Jul 2026 16:43:57 +0000 Subject: [PATCH] host P2: all state changes emit canonical activities (LIVE-VERIFIED) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Generalizes emission beyond publish to the full event source. TWO ActivityPub-faithful classes: - CONTENT (host/blog--content-activity): Create on first publish, Update on a subsequent published edit. object-type is DERIVED from the post's is-a (host/blog--post-type), not hardcoded 'article'. - RELATION (host/blog--relation-activity): Add/Remove, carrying :relation + :target (the edge). host/blog--emit! runs any activity through behavior/process (logged + matched). emit-content-change! (create/update) wired into form-submit + edit-submit; emit-relation! (add/remove) wired into relate-submit + unrelate-submit. DEBT #1 FIXED — per-EVENT :id (not the bare CID): content = create:/update:+cid; relation = add:/remove:+src:kind:dst (EDGE-based, because a relation change doesn't shift the CID, so a CID-based id would false-dedup different edges on one object). The activity log is now the DURABLE EVENT SOURCE (string-keyed records under 'activitylog', boot-loaded), surfaced at /activities — what TA will push to peers. LIVE PROOF (blog.rose-ash.com): publish → /activities 'create article '; relate → 'add article p2-events — add welcome related'; unrelate → 'remove …'. blog 217/217 (+4 P2, reframed P0.3 fire tests for Update semantics), full host conformance 614/614. Co-Authored-By: Claude Opus 4.8 --- lib/host/blog.sx | 113 +++++++++++++++++++++++------- lib/host/serve.sh | 4 ++ lib/host/tests/blog.sx | 63 +++++++++++++---- plans/business-logic-fed-flows.md | 26 +++++-- 4 files changed, 165 insertions(+), 41 deletions(-) diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 514c0e7b..a6be0565 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -121,19 +121,33 @@ (if (and fc (not (= fc ""))) fc (let ((tags (host/blog-out slug "tagged"))) (if (> (len tags) 0) (first tags) "urgent")))))) -(define host/blog--publish-activity - (fn (slug) +;; a post's primary type (its first is-a), for the activity :object-type. Default "article". +(define host/blog--post-type + (fn (slug) (let ((ts (host/blog-out slug "is-a"))) (if (empty? ts) "article" (first ts))))) +;; P2: a CONTENT activity (Create on first publish, Update on a subsequent published edit). :id is +;; verb-namespaced (create:/update:) over the CID — per-EVENT identity, so an update never collides +;; with the create (DEBT #1 for content; relation events use an edge-based id below). +(define host/blog--content-activity + (fn (slug verb) (let ((r (host/blog-get slug))) (if (nil? r) nil (let ((cid (host/blog-cid slug))) - {:verb "create" ;; the transition (draft→published = create) - :actor "site" ;; P0: a fixed site actor; per-author later - :object cid ;; content-addressed REFERENCE (the CID) - :object-type "article" - :slug slug ;; the handle the publish-DAG's ctx reads - :category (host/blog--post-category slug) ;; the field the DAG branches on - :delta "published" ;; what changed - :id cid}))))) ;; dedup identity (the object CID) + {:verb verb :actor "site" + :object cid :object-type (host/blog--post-type slug) + :slug slug :category (host/blog--post-category slug) + :delta verb :id (str verb ":" cid)}))))) +;; publishing = a Create content activity (the on-publish behavior binds to verb "create"). +(define host/blog--publish-activity (fn (slug) (host/blog--content-activity slug "create"))) +;; P2: a RELATION activity (Add/Remove). The object is the SUBJECT; the edge (kind→target) is carried +;; explicitly. :id is EDGE-based (DEBT #1) — a relation change doesn't shift the CID, so a CID-based +;; id would false-dedup across different edges on the same object. +(define host/blog--relation-activity + (fn (verb src kind dst) + {:verb verb :actor "site" + :object src :object-type (host/blog--post-type src) + :relation kind :target dst + :delta (str verb " " kind " " dst) + :id (str verb ":" src ":" kind ":" dst)})) ;; MARSHAL the canonical activity → next/'s Erlang proplist shape, for the Erlang runner adapter ;; (RA). The seam activity is canonical; each runner adapter maps it to its substrate. Unused until ;; RA, defined + tested here so the reconcile is complete and RA has its bridge ready. @@ -205,11 +219,21 @@ ;; runs it through behavior/process → the DAG's effects surface on /flows. In-memory logs for P0 ;; (durable-store backing is the follow-up). Every piece is a seam adapter — swap the runner for ;; Erlang (RA) or the transport for fed-sx (TA) and this same wiring federates, unchanged. -(define host/blog--activity-log (list)) ;; every publish activity emitted (the event source) +(define host/blog--activity-log (list)) ;; every activity emitted (the event source) (define host/blog--flow-log (list)) ;; what the flows DID (the driver's effect records) +(define host/blog--activitylog-key "activitylog") +;; P2: the transport LOGS every emitted activity DURABLY — a string-keyed record (verb/object/type/ +;; delta/id, dodging the keyword/persist split), so /activities survives a restart. This is the +;; federated EVENT SOURCE; TA (fed-sx transport) will additionally push these to peers. (define host/blog--transport - {:emit (fn (a) (set! host/blog--activity-log (concat host/blog--activity-log (list a)))) - :deliver (fn () (list))}) ;; nothing inbound yet — P0 is synchronous + {:emit (fn (a) + (begin + (set! host/blog--activity-log + (concat host/blog--activity-log + (list {"verb" (get a :verb) "object" (get a :object) "type" (get a :object-type) + "delta" (get a :delta) "id" (get a :id)}))) + (persist/backend-kv-put host/blog-store host/blog--activitylog-key host/blog--activity-log))) + :deliver (fn () (list))}) ;; nothing inbound yet — synchronous, local ;; P1: the trigger match consults the behavior REGISTRY (built from types' declarations), and each ;; matched binding carries its DERIVED runner (capability selection). Was a hardcoded create+article. (define host/blog--triggers @@ -231,20 +255,35 @@ (fn () (let ((v (persist/backend-kv-get host/blog-store host/blog--flowlog-key))) (when (and v (= (type-of v) "list")) (set! host/blog--flow-log v))))) +;; P2: rebuild the activity log (the event source) from the durable store on boot. +(define host/blog-load-activitylog! + (fn () + (let ((v (persist/backend-kv-get host/blog-store host/blog--activitylog-key))) + (when (and v (= (type-of v) "list")) (set! host/blog--activity-log v))))) (define host/blog--publish-engine (behavior/make-engine {:triggers host/blog--triggers :runner host/flow--exec-runner :transport host/blog--transport :driver host/blog--driver :ctx-of host/blog--publish-ctx})) -;; fire the publish flow for a slug: build the activity, run it through the seam. Returns the trace. -(define host/blog--fire-publish! - (fn (slug) - (let ((a (host/blog--publish-activity slug))) - (if (nil? a) nil (behavior/process host/blog--publish-engine a))))) -;; the draft→published TRANSITION (fire-once): only a non-published → published shift fires the flow. -(define host/blog--maybe-publish! +;; P2: EMIT any activity through the seam — it is LOGGED (the event source, via the transport) and +;; matched against the behavior registry (firing any declared behavior). Returns the trace, or nil. +(define host/blog--emit! (fn (a) (if (nil? a) nil (behavior/process host/blog--publish-engine a)))) +;; a slug's content CHANGE → the right verb: draft→published = Create (first publish); published→ +;; published = Update (a subsequent edit). Draft↔draft emits nothing (unobservable). Fire-once on the +;; create transition; an identical re-edit dedups (same verb:cid id). +(define host/blog--emit-content-change! (fn (slug prev-status new-status) - (if (and (not (= prev-status "published")) (= new-status "published")) - (host/blog--fire-publish! slug) nil))) + (cond + ((and (not (= prev-status "published")) (= new-status "published")) + (host/blog--emit! (host/blog--content-activity slug "create"))) + ((and (= prev-status "published") (= new-status "published")) + (host/blog--emit! (host/blog--content-activity slug "update"))) + (else nil)))) +;; back-compat alias: the publish transition (create). Kept for the write-path call sites + tests. +(define host/blog--maybe-publish! + (fn (slug prev-status new-status) (host/blog--emit-content-change! slug prev-status new-status))) +;; a relation change → an Add/Remove activity (edge referenced, no CID shift). +(define host/blog--emit-relation! + (fn (verb src kind dst) (host/blog--emit! (host/blog--relation-activity verb src kind dst)))) ;; ── render ────────────────────────────────────────────────────────── ;; A post's sx_content is SX element markup -> HTML via render-page (which supplies @@ -2541,7 +2580,9 @@ (host/blog--kind-spec kind) (host/blog--relation-allowed? slug kind) (host/blog-exists? other) (host/blog--valid-object? kind other)) - (host/blog-relate! slug other kind)) + (begin + (host/blog-relate! slug other kind) + (host/blog--emit-relation! "add" slug other kind))) ;; P2: Add activity ;; 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 ;; — the just-related post shows in the current list and the picker refreshes @@ -2560,7 +2601,9 @@ (kind (or (host/field req "kind") "related"))) (begin (when (and other (not (= other "")) (host/blog--kind-spec kind)) - (host/blog-unrelate! slug other kind)) + (begin + (host/blog-unrelate! slug other kind) + (host/blog--emit-relation! "remove" slug other kind))) ;; P2: Remove activity ;; AJAX remove (the editor's sx-post, carries SX-Target): return the ;; re-rendered editor for this kind so its sx-swap="outerHTML" replaces ;; #rel-editor-KIND — the row leaves the current list, the post returns to the @@ -2763,6 +2806,27 @@ (unquote (if (> (len (get e "args")) 0) (str (first (get e "args"))) ""))))) host/blog--flow-log)))))))))) +;; ── /activities — P2: the EVENT SOURCE ─────────────────────────────── +;; Every observable state change emitted as a canonical activity (Create/Update on content, +;; Add/Remove on relations). This is what federates (TA pushes it to peers) and what triggers +;; behaviors. Public read; durable (survives restart). +(define host/blog-activities + (fn (req) + (host/blog--resp req 200 + (host/blog--page req "Activities" + (quasiquote + (div (h1 "Activities") + (p "The event source — every observable state change (content Create/Update, relation Add/Remove).") + (unquote + (if (= (len host/blog--activity-log) 0) + (quote (p (em "No activities yet."))) + (cons (quote ul) + (map (fn (a) + (quasiquote (li (strong (unquote (get a "verb"))) " " + (unquote (str (get a "type") " ")) (code (unquote (str (get a "object")))) + (unquote (str " — " (get a "delta")))))) + host/blog--activity-log)))))))))) + ;; ── routes ────────────────────────────────────────────────────────── ;; Public reads + the create form. /, /posts, /new BEFORE /:slug (catch-all). ;; MUST be mounted LAST in the app so domain routes (/feed, /health) win. @@ -2775,6 +2839,7 @@ (dream-get "/meta" host/blog-meta-index) (dream-get "/workflow-demo" host/blog-workflow-demo) (dream-get "/flows" host/blog-flows) + (dream-get "/activities" host/blog-activities) (dream-get "/:slug/source" host/blog-source) (dream-get "/:slug/relate-options" host/blog-relate-options) (dream-get "/:slug" host/blog-post))) diff --git a/lib/host/serve.sh b/lib/host/serve.sh index ca1a3060..f575c063 100755 --- a/lib/host/serve.sh +++ b/lib/host/serve.sh @@ -155,6 +155,10 @@ EPOCH=1 echo "(epoch $EPOCH)" echo "(eval \"(host/blog-load-flowlog!)\")" EPOCH=$((EPOCH+1)) + # P2: rebuild the activity log (the event source) from the durable store, so /activities survives. + echo "(epoch $EPOCH)" + echo "(eval \"(host/blog-load-activitylog!)\")" + EPOCH=$((EPOCH+1)) # Sessions on the DURABLE store, LAZILY: only a logged-in session (one that # writes a field) persists, so a login survives a restart while anonymous / # crawler traffic leaves no rows. host/session-init! bumps the per-boot epoch diff --git a/lib/host/tests/blog.sx b/lib/host/tests/blog.sx index a53eb1f6..bfe1bced 100644 --- a/lib/host/tests/blog.sx +++ b/lib/host/tests/blog.sx @@ -1174,13 +1174,14 @@ ;; ── P0.1: business-logic fed-flows — the publish-activity contract ── ;; a published post is described as a fed-sx create activity that next/'s trigger machinery ;; consumes; category (drives the flow branch) comes from a field-value, else a tag, else urgent. -(host-bl-test "P0.4: publish-activity is the CANONICAL seam shape (:verb :object=cid :object-type :slug :category :id)" +(host-bl-test "P0.4/P2: publish-activity is the CANONICAL seam shape (:verb :object=cid :object-type :slug :category); :id is per-event (create:cid)" (begin (host/blog-put! "pub1" "Pub One" "(article (h1 \"P\"))" "published") + (host/blog-relate! "pub1" "article" "is-a") (host/blog--set-field-values! "pub1" {"category" "newsletter"}) (let ((a (host/blog--publish-activity "pub1"))) (list (get a :verb) (get a :object-type) (get a :category) (get a :slug) - (= (get a :object) (get a :id)) (not (nil? (get a :id)))))) + (= (get a :id) (str "create:" (get a :object))) (not (= (get a :object) (get a :id)))))) (list "create" "article" "newsletter" "pub1" true true)) (host-bl-test "publish-activity category falls back to a tag, else urgent" (begin @@ -1213,6 +1214,35 @@ (host/blog--maybe-publish! "p04r" "draft" "published") ;; then the transition (map (fn (e) (get e "verb")) host/blog--flow-log)) (list "validate" "digest")) ;; newsletter→digest, not stale→notify +;; ── P2: state-change → activity emission (ALL events, not just publish) ── +(host-bl-test "P2: a relate emits an ADD activity with an EDGE-based id (DEBT #1 — no CID collision)" + (begin + (set! host/blog--activity-log (list)) + (host/blog-put! "p2r" "R" "(article (h1 \"r\"))" "published") + (host/blog--emit-relation! "add" "p2r" "tagged" "urgent") + (let ((a (first host/blog--activity-log))) + (list (get a "verb") (get a "id")))) + (list "add" "add:p2r:tagged:urgent")) +(host-bl-test "P2: an unrelate emits a REMOVE activity (edge id, no CID)" + (begin + (set! host/blog--activity-log (list)) + (host/blog--emit-relation! "remove" "p2r" "tagged" "urgent") + (let ((a (first host/blog--activity-log))) + (list (get a "verb") (get a "id")))) + (list "remove" "remove:p2r:tagged:urgent")) +(host-bl-test "P2: relation :id ≠ content :id — DIFFERENT edges on one object don't collide" + (list (get (host/blog--relation-activity "add" "x" "tagged" "a") :id) + (get (host/blog--relation-activity "add" "x" "tagged" "b") :id)) + (list "add:x:tagged:a" "add:x:tagged:b")) +(host-bl-test "P2: the activity log is DURABLE (round-trips through the store)" + (begin + (set! host/blog--activity-log (list)) + (persist/backend-kv-put host/blog-store host/blog--activitylog-key (list)) + (host/blog--emit-relation! "add" "p2d" "related" "p2e") + (let ((before (len host/blog--activity-log))) + (begin (set! host/blog--activity-log (list)) (host/blog-load-activitylog!) + (list before (len host/blog--activity-log))))) + (list 1 1)) ;; P0.2: the publish WORKFLOW as an execute-fold DAG — branches on category, needs {effect,branch}, ;; binds to the synchronous execute-fold runner (derived, not chosen). (host-bl-test "publish-DAG: category branch (newsletter→digest) via the execute-fold" @@ -1235,27 +1265,34 @@ ;; execute-fold runner + on-publish registry + transport + host driver) → effects land in the flow log. (set! host/blog--flow-log (list)) (set! host/blog--activity-log (list)) -(host-bl-test "P0.3: draft→published fires the publish flow through the seam → effects logged" +(host-bl-test "P0.3: draft→published fires the CREATE flow through the seam → effects logged" (begin (host/blog-put! "p03a" "P" "(article (h1 \"x\"))" "published") (host/blog--set-field-values! "p03a" {"category" "newsletter"}) (host/blog--maybe-publish! "p03a" "draft" "published") - (list (map (fn (e) (get e :verb)) host/blog--flow-log) (len host/blog--activity-log))) - (list (list "validate" "digest") 1)) -(host-bl-test "P0.3: published→published does NOT re-fire (fire-once on the transition)" + (list (map (fn (e) (get e :verb)) host/blog--flow-log) + (get (first host/blog--activity-log) "verb"))) + (list (list "validate" "digest") "create")) +(host-bl-test "P0.3/P2: published→published emits UPDATE (not a re-fired create — no new create effects)" (begin - (host/blog--maybe-publish! "p03a" "published" "published") - (list (map (fn (e) (get e :verb)) host/blog--flow-log) (len host/blog--activity-log))) - (list (list "validate" "digest") 1)) -(host-bl-test "P0.3: a →draft transition does not fire" - (begin (host/blog--maybe-publish! "p03a" "published" "draft") (len host/blog--activity-log)) 1) -(host-bl-test "P0.3: a fresh nil→published (new post) fires, urgent→notify" + (set! host/blog--flow-log (list)) + (set! host/blog--activity-log (list)) + (host/blog--emit-content-change! "p03a" "published" "published") + (list (len host/blog--flow-log) (get (first host/blog--activity-log) "verb"))) + (list 0 "update")) +(host-bl-test "P0.3: a →draft transition emits nothing (unobservable)" (begin + (set! host/blog--activity-log (list)) + (host/blog--emit-content-change! "p03a" "published" "draft") + (len host/blog--activity-log)) 0) +(host-bl-test "P0.3: a fresh nil→published (new post) fires create, urgent→notify" + (begin + (set! host/blog--flow-log (list)) (host/blog-put! "p03b" "U" "(article (h1 \"u\"))" "published") (host/blog--set-field-values! "p03b" {"category" "urgent"}) (host/blog--maybe-publish! "p03b" nil "published") (map (fn (e) (get e "verb")) host/blog--flow-log)) - (list "validate" "digest" "validate" "notify")) + (list "validate" "notify")) ;; P0.3b: the flow log is DURABLE — it round-trips through the blog store (survives a restart). (host-bl-test "P0.3b: the flow log persists + reloads from the store (string-keyed, no split)" (begin diff --git a/plans/business-logic-fed-flows.md b/plans/business-logic-fed-flows.md index e4c667e8..6ef191b0 100644 --- a/plans/business-logic-fed-flows.md +++ b/plans/business-logic-fed-flows.md @@ -217,10 +217,22 @@ without touching the DAG or the wiring. scan ALL posts, not filter by is-type? (article didn't pass is-type? on the durable store though it did in-memory) — the type declaration is authoritative, the is-type? classification isn't reliable enough. -## P2 — state-change → activity emission (ALL events, not just publish) - -- [ ] Wire the host write path: put!/set-comp!/edit-submit → Create/Update; relate!/unrelate!/tag → - Add/Remove. Emit canonical activities into the transport log. Define the delta summary. +## P2 — state-change → activity emission (ALL events) — DONE + LIVE-VERIFIED 2026-07-02 +- [x] TWO event classes emit canonical activities through the seam: CONTENT (host/blog--content- + activity: Create on first publish, Update on a subsequent published edit — object-type DERIVED from + is-a, not hardcoded) and RELATION (host/blog--relation-activity: Add/Remove, carrying :relation + + :target). host/blog--emit! runs any activity through behavior/process (logged + matched); + emit-content-change! (create/update) wired into form-submit + edit-submit; emit-relation! + (add/remove) wired into relate-submit + unrelate-submit. +- [x] DEBT #1 FIXED — per-EVENT :id, not the bare CID. Content = "create:"/"update:"+cid; relation = + "add:"/"remove:"+src:kind:dst (EDGE-based, since a relation change doesn't shift the CID, so a + CID-based id would false-dedup different edges on one object). Verified: different edges → different ids. +- [x] The activity log is the DURABLE EVENT SOURCE (host/blog--activity-log, string-keyed records + persisted under "activitylog", boot-loaded via host/blog-load-activitylog!). Surfaced at /activities. + This is what TA will push to peers. +- LIVE PROOF: on blog.rose-ash.com — publish → /activities "create article "; relate → "add + article p2-events — add welcome related"; unrelate → "remove …". All three classes, durable. + blog 217/217 (+4 P2, reframed P0.3 fire-once tests for Update semantics), full conformance 614/614. ## RA — the ERLANG (durable) RUNNER adapter ← the old "fed-sx spike", now an adapter @@ -291,6 +303,12 @@ covers everything until a DAG's cost/latency/placement forces the substrate. activities), so business logic can change state, which federates, which triggers more flows. ## Progress log (newest first) +- 2026-07-02 — P2 DONE + LIVE-VERIFIED. All observable state changes now emit canonical activities + through the seam: content Create/Update + relation Add/Remove. DEBT #1 fixed (per-event ids; edge- + based for relations). The activity log is the durable event source, surfaced at /activities. Live: + publish→create, relate→add, unrelate→remove all logged. blog 217/217, conformance 614/614. The + event source is now complete + federatable — NEXT: RA-live (persistent kernel) or TA (fed-sx + transport pushes /activities to peers → federation). - 2026-07-02 — P1 DONE + LIVE-VERIFIED. Types DECLARE :behavior (stored on the type-post, gathered into a registry at boot); the trigger match consults the registry; the runner is DERIVED via host/flow--select-runner over the fleet (DEBT #2 fixed — no hardcoded trigger, no runner hint). The