host P2: all state changes emit canonical activities (LIVE-VERIFIED)

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 <cid>'; 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 <noreply@anthropic.com>
2026-07-02 16:43:57 +00:00
parent 9d29295820
commit d13c4dd5fe
4 changed files with 165 additions and 41 deletions
--- 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)))
--- 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
--- 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