coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
b4fbfa56032f05741671ace58f1eccbd8689109d
rose-ash/lib/gitea/activity.sx
giles b4fbfa5603 sx-gitea Phase 6: activity — feed timelines, dashboard, durable notifications (TDD, 520/520) 
lib/gitea/activity.sx: every forge action lands as a feed activity in an
append-only persist log stream. Instrumentation is done IN the runtime —
repo-create!/issue-create!/issue-comment!/pr-create!/pr-review!/pr-merge!
are redefined around their originals, so SX callers and web handlers emit
activity with zero call-site edits (failed mutations emit nothing).

Timelines are lib/feed (APL) queries: global/repo/user, newest-first,
visibility follows repo access (private-repo activity invisible to
non-readers). Follows (user: or repo: targets) drive a dashboard of
followed actors/repos minus one's own actions.

Notifications ride lib/events durable delivery: activities after a
cursor expand to (id recipient body) messages (comment -> author+
participants, review/merge -> PR author, open-issue -> assignees, never
the actor), ev/deliver-messages runs the at-least-once digest flow, and
delivered messages file into per-user kv inboxes; the cursor advance
makes reruns no-ops.

Web: /activity + /:owner/:name/activity pages, user-activity/dashboard/
follow/notifications/notify-run JSON API. gitea/all-routes now hoists
every /api/* route ahead of the wildcard /:owner/:name patterns so later
packs can add API endpoints without being shadowed.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
2026-07-03 14:25:10 +00:00

580 lines
17 KiB
Plaintext
Raw Blame History

; lib/gitea/activity.sx — sx-gitea Phase 6: activity, dashboard, notify.
;
; Every noteworthy forge action lands as a feed activity ({:actor :verb
; :object :at :tags}) in an append-only persist log stream on the forge
; backend. Instrumentation wraps the existing mutation verbs IN the
; runtime (repo-create!/issue-create!/issue-comment!/pr-create!/
; pr-review!/pr-merge! are redefined around their originals), so SX
; callers and web handlers alike emit activity with zero call-site edits.
;
; Timelines are lib/feed queries over that stream (APL-backed filter/
; rank/take); visibility follows repo access — an activity tagged with a
; private repo is invisible to non-readers. The dashboard shows what a
; user follows (users or repos), minus their own actions.
;
; Notifications ride lib/events' durable delivery flows: pending
; activities after a cursor expand to (id recipient body) messages,
; ev/deliver-messages runs them through the at-least-once digest flow
; (idempotent by message id), and delivered messages land in per-user kv
; inboxes; the cursor then advances, so a re-run delivers nothing twice.
;
; Requires: lib/gitea/{repo,access,web,issues,pr}.sx and their stacks,
; lib/apl/runtime.sx + lib/feed/{normalize,stream,api,fanout,dedupe,
; aggregate,rank,acl,mute,page,notify,home,fed}.sx, and
; lib/events/notify.sx over the flow stack.
; ── the activity log ─────────────────────────────────────────────────
(define gitea/activity-stream-name "gitea/activity")
(define
gitea/act!
(fn
(forge actor verb object tags at)
(persist/append
(gitea/forge-db forge)
gitea/activity-stream-name
verb
at
(feed/activity actor verb object at tags))))
(define
gitea/activity-events
(fn
(forge)
(persist/read (gitea/forge-db forge) gitea/activity-stream-name)))
(define
gitea/activity-stream
(fn
(forge)
(feed/stream (map persist/event-data (gitea/activity-events forge)))))
(define
gitea/activity-count
(fn
(forge)
(persist/last-seq (gitea/forge-db forge) gitea/activity-stream-name)))
; ── node helpers ─────────────────────────────────────────────────────
(define gitea/pr-node (fn (owner name n) (str "pr:" owner "/" name "#" n)))
; "issue:alice/proj#3" / "pr:alice/proj#3" => {:owner :name :n} | nil
(define
gitea/parse-numbered-node
(fn
(node)
(let
((colon (index-of node ":")) (hash (index-of node "#")))
(if
(or (< colon 0) (< hash 0))
nil
(let
((p (gitea/split-full (substr node (+ colon 1) (- hash colon 1)))))
{:name (get p :name) :n (parse-int (substr node (+ hash 1))) :owner (get p :owner)})))))
; the repo an activity belongs to, via its tags
(define
gitea/act-repo
(fn
(a)
(first (filter (fn (t) (starts-with? t "repo:")) (get a :tags)))))
(define
gitea/act-visible?
(fn
(forge user a)
(let
((r (gitea/act-repo a)))
(if
(nil? r)
true
(let
((p (gitea/split-full (substr r 5))))
(gitea/can? forge user "read" (get p :owner) (get p :name)))))))
; ── instrumentation: wrap the mutation verbs ─────────────────────────
(define gitea/base-repo-create! gitea/repo-create!)
(define
gitea/repo-create!
(fn
(forge owner name opts)
(let
((res (gitea/base-repo-create! forge owner name opts)))
(begin
(if
(or (get res :error) (get res :conflict))
nil
(gitea/act!
forge
owner
"create-repo"
(gitea/repo-node owner name)
(list (gitea/repo-node owner name))
(get res :created-at)))
res))))
(define gitea/base-issue-create! gitea/issue-create!)
(define
gitea/issue-create!
(fn
(forge owner name author title body opts)
(let
((res (gitea/base-issue-create! forge owner name author title body opts)))
(begin
(if
(get res :error)
nil
(gitea/act!
forge
author
"open-issue"
(gitea/issue-node owner name (get res :number))
(list (gitea/repo-node owner name))
(get res :created-at)))
res))))
(define gitea/base-issue-comment! gitea/issue-comment!)
(define
gitea/issue-comment!
(fn
(forge owner name n author body opts)
(let
((res (gitea/base-issue-comment! forge owner name n author body opts)))
(begin
(if
(get res :error)
nil
(gitea/act!
forge
author
"comment"
(gitea/issue-node owner name n)
(list (gitea/repo-node owner name))
(get res :at)))
res))))
(define gitea/base-pr-create! gitea/pr-create!)
(define
gitea/pr-create!
(fn
(forge owner name author title source target body opts)
(let
((res (gitea/base-pr-create! forge owner name author title source target body opts)))
(begin
(if
(get res :error)
nil
(gitea/act!
forge
author
"open-pr"
(gitea/pr-node owner name (get res :number))
(list (gitea/repo-node owner name))
(get res :created-at)))
res))))
(define gitea/base-pr-review! gitea/pr-review!)
(define
gitea/pr-review!
(fn
(forge owner name n reviewer verdict body opts)
(let
((res (gitea/base-pr-review! forge owner name n reviewer verdict body opts)))
(begin
(if
(get res :error)
nil
(gitea/act!
forge
reviewer
"review"
(gitea/pr-node owner name n)
(list (gitea/repo-node owner name))
(get res :at)))
res))))
(define gitea/base-pr-merge! gitea/pr-merge!)
(define
gitea/pr-merge!
(fn
(forge owner name n merger opts)
(let
((res (gitea/base-pr-merge! forge owner name n merger opts)))
(begin
(if
(get res :error)
nil
(gitea/act!
forge
merger
"merge-pr"
(gitea/pr-node owner name n)
(list (gitea/repo-node owner name))
(or (get (or opts {}) :time) 0)))
res))))
; ── timelines ────────────────────────────────────────────────────────
(define
gitea/timeline
(fn
(forge user n)
(feed/items
(feed/take
(feed/recent
(feed/filter
(gitea/activity-stream forge)
(fn (a) (gitea/act-visible? forge user a))))
n))))
(define
gitea/repo-timeline
(fn
(forge owner name n)
(let
((node (gitea/repo-node owner name)))
(feed/items
(feed/take
(feed/recent
(feed/filter
(gitea/activity-stream forge)
(fn (a) (contains? (get a :tags) node))))
n)))))
(define
gitea/user-timeline
(fn
(forge viewer user n)
(feed/items
(feed/take
(feed/recent
(feed/filter
(feed/by-actor (gitea/activity-stream forge) user)
(fn (a) (gitea/act-visible? forge viewer a))))
n))))
; ── follows + dashboard ──────────────────────────────────────────────
(define
gitea/follow-key
(fn (user target) (str "gitea/follow/" user "/" target)))
(define
gitea/follow-target-valid?
(fn
(forge target)
(cond
((not (string? target)) false)
((starts-with? target "user:")
(gitea/owner-exists? forge (substr target 5)))
((starts-with? target "repo:")
(let
((p (gitea/split-full (substr target 5))))
(gitea/repo-exists? forge (get p :owner) (get p :name))))
(else false))))
(define
gitea/follow!
(fn
(forge user target)
(cond
((not (gitea/owner-exists? forge user)) {:error "no-such-user"})
((not (gitea/follow-target-valid? forge target)) {:error "no-such-target"})
(else
(persist/kv-put
(gitea/forge-db forge)
(gitea/follow-key user target)
{:target target})))))
(define
gitea/unfollow!
(fn
(forge user target)
(let
((k (gitea/follow-key user target)))
(if
(persist/kv-has? (gitea/forge-db forge) k)
(begin (persist/kv-delete (gitea/forge-db forge) k) true)
false))))
(define
gitea/follows
(fn (forge user) (gitea/names-under forge (str "gitea/follow/" user "/"))))
; what the people/repos a user follows have been doing (own actions
; excluded, private repos only where the VIEWER can read)
(define
gitea/dashboard
(fn
(forge user n)
(let
((follows (gitea/follows forge user)))
(feed/items
(feed/take
(feed/recent
(feed/filter
(gitea/activity-stream forge)
(fn
(a)
(and
(not (= (get a :actor) user))
(gitea/act-visible? forge user a)
(or
(contains? follows (str "user:" (get a :actor)))
(let
((r (gitea/act-repo a)))
(and (not (nil? r)) (contains? follows r))))))))
n)))))
; ── notifications over lib/events durable delivery ───────────────────
; who should hear about an activity (never its own actor)
(define
gitea/notify-recipients
(fn
(forge a)
(let
((verb (get a :verb))
(node (gitea/parse-numbered-node (or (get a :object) ""))))
(let
((raw (cond ((nil? node) (list)) ((= verb "comment") (let ((rec (gitea/issue-get forge (get node :owner) (get node :name) (get node :n)))) (if (nil? rec) (list) (concat (list (get rec :author)) (concat (get rec :assignees) (map (fn (c) (get c :author)) (get rec :comments))))))) ((= verb "open-issue") (let ((rec (gitea/issue-get forge (get node :owner) (get node :name) (get node :n)))) (if (nil? rec) (list) (get rec :assignees)))) ((or (= verb "review") (= verb "merge-pr")) (let ((rec (gitea/pr-get forge (get node :owner) (get node :name) (get node :n)))) (if (nil? rec) (list) (list (get rec :author))))) (else (list)))))
(artdag/sort-strings
(relations-dedup
(filter
(fn
(u)
(and
(not (= u (get a :actor)))
(gitea/owner-exists? forge u)))
raw)))))))
(define gitea/notify-cursor-key "gitea/notify-cursor")
(define
gitea/notify-body
(fn (a) (str (get a :actor) " " (get a :verb) " " (get a :object))))
; messages for every activity after the cursor: (id recipient body),
; id = <pad8 seq>:<recipient> so inbox keys sort chronologically
(define
gitea/pending-notifications
(fn
(forge)
(let
((db (gitea/forge-db forge)))
(let
((cursor (persist/kv-get-or db gitea/notify-cursor-key 0)))
(let
((events (persist/read-from db gitea/activity-stream-name (+ cursor 1))))
{:messages (reduce (fn (acc e) (let ((a (persist/event-data e))) (concat acc (map (fn (u) (list (str (gitea/pad8 (persist/event-seq e)) ":" u) u (gitea/notify-body a))) (gitea/notify-recipients forge a))))) (list) events) :last-seq (reduce (fn (acc e) (persist/event-seq e)) cursor events)})))))
(define gitea/inbox-key (fn (user id) (str "gitea/inbox/" user "/" id)))
; deliver pending notifications through the durable digest flow and file
; the delivered ones into per-user inboxes; the cursor advance makes a
; re-run a no-op. => (("delivered"|"failed" id n-or-reason) ...)
(define
gitea/notify!
(fn
(forge)
(let
((p (gitea/pending-notifications forge)))
(let
((msgs (get p :messages)))
(let
((by-id (reduce (fn (acc m) (assoc acc (first m) m)) {} msgs)))
(let
((outcomes (if (empty? msgs) (list) (ev/deliver-messages msgs ev-notify-ok-transport 3 500))))
(begin
(for-each
(fn
(o)
(if
(= (first o) "delivered")
(let
((m (get by-id (nth o 1))))
(if
(nil? m)
nil
(persist/kv-put
(gitea/forge-db forge)
(gitea/inbox-key (nth m 1) (first m))
{:id (first m) :body (nth m 2)})))
nil))
outcomes)
(persist/kv-put
(gitea/forge-db forge)
gitea/notify-cursor-key
(get p :last-seq))
outcomes)))))))
(define
gitea/inbox
(fn
(forge user)
(map
(fn
(id)
(persist/kv-get (gitea/forge-db forge) (gitea/inbox-key user id)))
(gitea/names-under forge (str "gitea/inbox/" user "/")))))
(define gitea/inbox-count (fn (forge user) (len (gitea/inbox forge user))))
; ── web ──────────────────────────────────────────────────────────────
(define
gitea/w-act-item
(fn
(a)
(str
"<li class=\""
(get a :verb)
"\">"
(dream-escape (get a :actor))
" "
(get a :verb)
" "
(dream-escape (or (get a :object) ""))
"</li>")))
(define
gitea/w-activity-page
(fn
(forge req)
(gitea/w-page
"activity"
(str
"<h1>Activity</h1><ul>"
(join
""
(map
gitea/w-act-item
(gitea/timeline forge (gitea/w-user forge req) 50)))
"</ul>"))))
(define
gitea/w-repo-activity-page
(fn
(forge req)
(let
((owner (dream-param req "owner")) (name (dream-param req "name")))
(if
(not (gitea/w-readable? forge req owner name))
(dream-not-found)
(gitea/w-page
(str owner "/" name " activity")
(str
"<h1>Activity</h1><ul>"
(join
""
(map
gitea/w-act-item
(gitea/repo-timeline forge owner name 50)))
"</ul>"))))))
(define
gitea/w-api-user-activity
(fn
(forge req)
(let
((user (dream-param req "user")))
(if
(not (gitea/owner-exists? forge user))
(dream-not-found)
(dream-json-value
(gitea/user-timeline forge (gitea/w-user forge req) user 50))))))
(define
gitea/w-api-dashboard
(fn
(forge req)
(let
((user (gitea/w-user forge req)))
(if
(nil? user)
(gitea/w-unauthorized)
(dream-json-value (gitea/dashboard forge user 50))))))
(define
gitea/w-api-follow
(fn
(forge req)
(let
((user (gitea/w-user forge req)))
(if
(nil? user)
(gitea/w-unauthorized)
(let
((res (gitea/follow! forge user (get (dream-json-body req) :target))))
(if
(get res :error)
(gitea/w-json-status 400 {:error (get res :error)})
(dream-json-value (gitea/follows forge user))))))))
(define
gitea/w-api-unfollow
(fn
(forge req)
(let
((user (gitea/w-user forge req)))
(if
(nil? user)
(gitea/w-unauthorized)
(if
(gitea/unfollow! forge user (or (dream-param req "**") ""))
(dream-json-value (gitea/follows forge user))
(dream-not-found))))))
(define
gitea/w-api-notifications
(fn
(forge req)
(let
((user (gitea/w-user forge req)))
(if
(nil? user)
(gitea/w-unauthorized)
(dream-json-value
(map (fn (r) (get r :body)) (gitea/inbox forge user)))))))
(define
gitea/w-api-notify-run
(fn
(forge req)
(let
((user (gitea/w-user forge req)))
(if (nil? user) (gitea/w-unauthorized) (dream-json-value {:outcomes (len (gitea/notify! forge))})))))
(define
gitea/activity-routes
(fn
(forge)
(list
(dream-get "/activity" (fn (req) (gitea/w-activity-page forge req)))
(dream-get
"/:owner/:name/activity"
(fn (req) (gitea/w-repo-activity-page forge req)))
(dream-get
"/api/users/:user/activity"
(fn (req) (gitea/w-api-user-activity forge req)))
(dream-get
"/api/dashboard"
(fn (req) (gitea/w-api-dashboard forge req)))
(dream-post "/api/follow" (fn (req) (gitea/w-api-follow forge req)))
(dream-delete
"/api/follow/**"
(fn (req) (gitea/w-api-unfollow forge req)))
(dream-get
"/api/notifications"
(fn (req) (gitea/w-api-notifications forge req)))
(dream-post
"/api/notify/run"
(fn (req) (gitea/w-api-notify-run forge req))))))
(set!
gitea/route-packs
(append gitea/route-packs (list gitea/activity-routes)))
Reference in New Issue View Git Blame Copy Permalink