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>
This commit is contained in:
113
lib/host/blog.sx
113
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)))
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user