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>
This commit is contained in:
579
lib/gitea/activity.sx
Normal file
579
lib/gitea/activity.sx
Normal file
@@ -0,0 +1,579 @@
|
||||
; 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)))
|
||||
@@ -23,6 +23,7 @@ VERBOSE="${1:-}"
|
||||
ISSUES_EXTRAS="lib/relations/schema.sx;lib/relations/engine.sx;lib/relations/api.sx;lib/smalltalk/tokenizer.sx;lib/smalltalk/parser.sx;lib/guest/reflective/class-chain.sx;lib/smalltalk/runtime.sx;lib/guest/reflective/env.sx;lib/smalltalk/eval.sx;lib/content/block.sx;lib/content/doc.sx;lib/content/render.sx;lib/content/api.sx;lib/content/meta.sx;lib/content/text.sx;lib/content/section.sx;lib/content/table.sx;lib/content/markdown.sx;lib/content/md-import.sx;lib/gitea/issues.sx"
|
||||
|
||||
PR_EXTRAS="$ISSUES_EXTRAS;lib/guest/lex.sx;lib/guest/reflective/quoting.sx;lib/scheme/parser.sx;lib/scheme/eval.sx;lib/scheme/runtime.sx;lib/flow/spec.sx;lib/flow/store.sx;lib/flow/remote.sx;lib/flow/host.sx;lib/flow/api.sx;lib/gitea/pr.sx"
|
||||
ACT_EXTRAS="$PR_EXTRAS;lib/apl/runtime.sx;lib/feed/normalize.sx;lib/feed/stream.sx;lib/feed/api.sx;lib/feed/fanout.sx;lib/feed/dedupe.sx;lib/feed/aggregate.sx;lib/feed/rank.sx;lib/feed/acl.sx;lib/feed/mute.sx;lib/feed/page.sx;lib/feed/notify.sx;lib/feed/home.sx;lib/feed/fed.sx;lib/events/notify.sx;lib/gitea/activity.sx"
|
||||
|
||||
SUITES=(
|
||||
"repo|gitea-repo-pass|gitea-repo-fail|gitea-repo-fails|"
|
||||
@@ -30,6 +31,7 @@ SUITES=(
|
||||
"wire|gitea-wire-pass|gitea-wire-fail|gitea-wire-fails|"
|
||||
"issues|gitea-issues-pass|gitea-issues-fail|gitea-issues-fails|$ISSUES_EXTRAS"
|
||||
"pr|gitea-pr-pass|gitea-pr-fail|gitea-pr-fails|$PR_EXTRAS"
|
||||
"activity|gitea-act-pass|gitea-act-fail|gitea-act-fails|$ACT_EXTRAS"
|
||||
)
|
||||
|
||||
OUT_JSON="lib/gitea/scoreboard.json"
|
||||
|
||||
@@ -4,9 +4,10 @@
|
||||
"access": {"pass": 103, "fail": 0},
|
||||
"wire": {"pass": 78, "fail": 0},
|
||||
"issues": {"pass": 88, "fail": 0},
|
||||
"pr": {"pass": 100, "fail": 0}
|
||||
"pr": {"pass": 100, "fail": 0},
|
||||
"activity": {"pass": 60, "fail": 0}
|
||||
},
|
||||
"total_pass": 460,
|
||||
"total_pass": 520,
|
||||
"total_fail": 0,
|
||||
"total": 460
|
||||
"total": 520
|
||||
}
|
||||
|
||||
@@ -9,4 +9,5 @@ _Generated by `lib/gitea/conformance.sh`_
|
||||
| wire | 78 | 0 | 78 |
|
||||
| issues | 88 | 0 | 88 |
|
||||
| pr | 100 | 0 | 100 |
|
||||
| **Total** | **460** | **0** | **460** |
|
||||
| activity | 60 | 0 | 60 |
|
||||
| **Total** | **520** | **0** | **520** |
|
||||
|
||||
432
lib/gitea/tests/activity.sx
Normal file
432
lib/gitea/tests/activity.sx
Normal file
@@ -0,0 +1,432 @@
|
||||
; lib/gitea/tests/activity.sx — Phase 6: instrumented activity log, feed
|
||||
; timelines with visibility, follows + dashboard, durable notifications
|
||||
; into per-user inboxes, and the activity web routes.
|
||||
|
||||
(st-bootstrap-classes!)
|
||||
(content/bootstrap!)
|
||||
(content-bootstrap-markdown!)
|
||||
(content-bootstrap-table!)
|
||||
|
||||
(define gitea-act-pass 0)
|
||||
(define gitea-act-fail 0)
|
||||
(define gitea-act-fails (list))
|
||||
|
||||
(define
|
||||
gitea-act-test
|
||||
(fn
|
||||
(name actual expected)
|
||||
(if
|
||||
(= actual expected)
|
||||
(set! gitea-act-pass (+ gitea-act-pass 1))
|
||||
(begin
|
||||
(set! gitea-act-fail (+ gitea-act-fail 1))
|
||||
(set! gitea-act-fails (append gitea-act-fails (list {:name name :expected (inspect expected) :actual (inspect actual)})))))))
|
||||
|
||||
; ── setup + instrumented history ─────────────────────────────────────
|
||||
; activity ledger (seq/at/actor/verb):
|
||||
; 1 @5 alice create-repo repo:alice/proj (public)
|
||||
; 2 @6 alice create-repo repo:alice/sec (private)
|
||||
; 3 @10 alice open-issue issue:alice/proj#1
|
||||
; 4 @11 bob comment issue:alice/proj#1
|
||||
; 5 @12 bob open-pr pr:alice/proj#2
|
||||
; 6 @13 carol review pr:alice/proj#2
|
||||
; 7 @14 alice merge-pr pr:alice/proj#2
|
||||
; 8 @20 alice open-issue issue:alice/sec#1 (private)
|
||||
; 9 @21 alice open-issue issue:alice/proj#3 (assignee bob)
|
||||
|
||||
(define ga-db (persist/mem-backend))
|
||||
(define ga-forge (gitea/forge ga-db))
|
||||
(gitea/user-create! ga-forge "alice")
|
||||
(gitea/user-create! ga-forge "bob")
|
||||
(gitea/user-create! ga-forge "carol")
|
||||
(gitea/user-create! ga-forge "eve")
|
||||
(gitea/token-create! ga-forge "alice" "tok-a")
|
||||
(gitea/token-create! ga-forge "bob" "tok-b")
|
||||
(gitea/token-create! ga-forge "carol" "tok-c")
|
||||
|
||||
(gitea/repo-create! ga-forge "alice" "proj" {:created-at 5})
|
||||
(gitea/repo-create! ga-forge "alice" "sec" {:created-at 6 :visibility "private"})
|
||||
(gitea/collab-add! ga-forge "alice" "sec" "bob" "read")
|
||||
|
||||
(define ga-g (gitea/repo-git ga-forge "alice" "proj"))
|
||||
(git/add! ga-g "README.md" "base\n")
|
||||
(git/commit! ga-g {:message "c1" :time 1 :author "alice"})
|
||||
(git/branch! ga-g "feat")
|
||||
(git/checkout! ga-g "feat")
|
||||
(git/add! ga-g "f.txt" "feature\n")
|
||||
(git/commit! ga-g {:message "c2" :time 2 :author "bob"})
|
||||
(git/checkout! ga-g "main")
|
||||
|
||||
(gitea/issue-create!
|
||||
ga-forge
|
||||
"alice"
|
||||
"proj"
|
||||
"alice"
|
||||
"First issue"
|
||||
"body"
|
||||
{:created-at 10})
|
||||
(gitea/issue-comment!
|
||||
ga-forge
|
||||
"alice"
|
||||
"proj"
|
||||
1
|
||||
"bob"
|
||||
"a comment"
|
||||
{:at 11})
|
||||
(gitea/pr-create!
|
||||
ga-forge
|
||||
"alice"
|
||||
"proj"
|
||||
"bob"
|
||||
"Feature"
|
||||
"feat"
|
||||
"main"
|
||||
""
|
||||
{:created-at 12})
|
||||
(gitea/pr-review!
|
||||
ga-forge
|
||||
"alice"
|
||||
"proj"
|
||||
2
|
||||
"carol"
|
||||
"approve"
|
||||
"lgtm"
|
||||
{:at 13})
|
||||
(gitea/pr-merge! ga-forge "alice" "proj" 2 "alice" {:time 14})
|
||||
(gitea/issue-create!
|
||||
ga-forge
|
||||
"alice"
|
||||
"sec"
|
||||
"alice"
|
||||
"Secret issue"
|
||||
""
|
||||
{:created-at 20})
|
||||
(gitea/issue-create!
|
||||
ga-forge
|
||||
"alice"
|
||||
"proj"
|
||||
"alice"
|
||||
"Assigned issue"
|
||||
""
|
||||
{:assignees (list "bob") :created-at 21})
|
||||
|
||||
(gitea-act-test "activity count" (gitea/activity-count ga-forge) 9)
|
||||
|
||||
; failed mutations emit nothing
|
||||
(gitea/issue-create! ga-forge "alice" "none" "alice" "x" "" {})
|
||||
(gitea/pr-review!
|
||||
ga-forge
|
||||
"alice"
|
||||
"proj"
|
||||
2
|
||||
"bob"
|
||||
"approve"
|
||||
""
|
||||
{})
|
||||
(gitea-act-test
|
||||
"errors emit no activity"
|
||||
(gitea/activity-count ga-forge)
|
||||
9)
|
||||
|
||||
; ── timelines ────────────────────────────────────────────────────────
|
||||
|
||||
(gitea-act-test
|
||||
"anon timeline hides private"
|
||||
(len (gitea/timeline ga-forge nil 50))
|
||||
7)
|
||||
(gitea-act-test
|
||||
"owner timeline sees all"
|
||||
(len (gitea/timeline ga-forge "alice" 50))
|
||||
9)
|
||||
(gitea-act-test
|
||||
"timeline newest first"
|
||||
(get (first (gitea/timeline ga-forge nil 50)) :verb)
|
||||
"open-issue")
|
||||
(gitea-act-test
|
||||
"timeline take"
|
||||
(len (gitea/timeline ga-forge "alice" 2))
|
||||
2)
|
||||
|
||||
(gitea-act-test
|
||||
"repo timeline proj"
|
||||
(len (gitea/repo-timeline ga-forge "alice" "proj" 50))
|
||||
7)
|
||||
(gitea-act-test
|
||||
"repo timeline sec"
|
||||
(len (gitea/repo-timeline ga-forge "alice" "sec" 50))
|
||||
2)
|
||||
(gitea-act-test
|
||||
"repo timeline order"
|
||||
(get (first (gitea/repo-timeline ga-forge "alice" "proj" 50)) :at)
|
||||
21)
|
||||
|
||||
(gitea-act-test
|
||||
"user timeline bob"
|
||||
(len (gitea/user-timeline ga-forge nil "bob" 50))
|
||||
2)
|
||||
(gitea-act-test
|
||||
"user timeline bob order"
|
||||
(get (first (gitea/user-timeline ga-forge nil "bob" 50)) :verb)
|
||||
"open-pr")
|
||||
(gitea-act-test
|
||||
"user timeline alice anon"
|
||||
(len (gitea/user-timeline ga-forge nil "alice" 50))
|
||||
4)
|
||||
(gitea-act-test
|
||||
"user timeline alice as collab"
|
||||
(len (gitea/user-timeline ga-forge "bob" "alice" 50))
|
||||
6)
|
||||
|
||||
; ── follows + dashboard ──────────────────────────────────────────────
|
||||
|
||||
(gitea/follow! ga-forge "carol" "user:alice")
|
||||
(gitea-act-test
|
||||
"follows list"
|
||||
(gitea/follows ga-forge "carol")
|
||||
(list "user:alice"))
|
||||
(gitea-act-test
|
||||
"follow unknown follower"
|
||||
(get (gitea/follow! ga-forge "zeb" "user:alice") :error)
|
||||
"no-such-user")
|
||||
(gitea-act-test
|
||||
"follow unknown user target"
|
||||
(get (gitea/follow! ga-forge "carol" "user:zeb") :error)
|
||||
"no-such-target")
|
||||
(gitea-act-test
|
||||
"follow unknown repo target"
|
||||
(get (gitea/follow! ga-forge "carol" "repo:alice/none") :error)
|
||||
"no-such-target")
|
||||
(gitea-act-test
|
||||
"follow malformed target"
|
||||
(get (gitea/follow! ga-forge "carol" "alice") :error)
|
||||
"no-such-target")
|
||||
|
||||
(gitea-act-test
|
||||
"dashboard follows a user"
|
||||
(len (gitea/dashboard ga-forge "carol" 50))
|
||||
4)
|
||||
(gitea-act-test
|
||||
"dashboard first actor"
|
||||
(get (first (gitea/dashboard ga-forge "carol" 50)) :actor)
|
||||
"alice")
|
||||
|
||||
(gitea/follow! ga-forge "bob" "repo:alice/proj")
|
||||
(gitea-act-test
|
||||
"dashboard follows a repo, excludes own actions"
|
||||
(len (gitea/dashboard ga-forge "bob" 50))
|
||||
5)
|
||||
|
||||
(gitea-act-test
|
||||
"unfollow"
|
||||
(gitea/unfollow! ga-forge "carol" "user:alice")
|
||||
true)
|
||||
(gitea-act-test
|
||||
"dashboard after unfollow"
|
||||
(len (gitea/dashboard ga-forge "carol" 50))
|
||||
0)
|
||||
(gitea-act-test
|
||||
"unfollow twice"
|
||||
(gitea/unfollow! ga-forge "carol" "user:alice")
|
||||
false)
|
||||
|
||||
; ── notifications ────────────────────────────────────────────────────
|
||||
|
||||
(gitea-act-test
|
||||
"recipients of a comment"
|
||||
(gitea/notify-recipients
|
||||
ga-forge
|
||||
(feed/activity
|
||||
"bob"
|
||||
"comment"
|
||||
"issue:alice/proj#1"
|
||||
11
|
||||
(list "repo:alice/proj")))
|
||||
(list "alice"))
|
||||
(gitea-act-test
|
||||
"recipients of a review"
|
||||
(gitea/notify-recipients
|
||||
ga-forge
|
||||
(feed/activity
|
||||
"carol"
|
||||
"review"
|
||||
"pr:alice/proj#2"
|
||||
13
|
||||
(list "repo:alice/proj")))
|
||||
(list "bob"))
|
||||
(gitea-act-test
|
||||
"recipients exclude the actor"
|
||||
(gitea/notify-recipients
|
||||
ga-forge
|
||||
(feed/activity
|
||||
"alice"
|
||||
"comment"
|
||||
"issue:alice/proj#1"
|
||||
30
|
||||
(list "repo:alice/proj")))
|
||||
(list "bob"))
|
||||
|
||||
(define ga-pend (gitea/pending-notifications ga-forge))
|
||||
(gitea-act-test
|
||||
"pending message count"
|
||||
(len (get ga-pend :messages))
|
||||
4)
|
||||
(gitea-act-test "pending last seq" (get ga-pend :last-seq) 9)
|
||||
|
||||
(define ga-out1 (gitea/notify! ga-forge))
|
||||
(gitea-act-test
|
||||
"notify delivers all"
|
||||
(len (filter (fn (o) (= (first o) "delivered")) ga-out1))
|
||||
4)
|
||||
(gitea-act-test "inbox alice" (gitea/inbox-count ga-forge "alice") 1)
|
||||
(gitea-act-test
|
||||
"inbox alice body"
|
||||
(get (first (gitea/inbox ga-forge "alice")) :body)
|
||||
"bob comment issue:alice/proj#1")
|
||||
(gitea-act-test "inbox bob" (gitea/inbox-count ga-forge "bob") 3)
|
||||
|
||||
(gitea-act-test "notify rerun is a no-op" (gitea/notify! ga-forge) (list))
|
||||
(gitea-act-test
|
||||
"inboxes stable after rerun"
|
||||
(gitea/inbox-count ga-forge "bob")
|
||||
3)
|
||||
|
||||
; a fresh comment (carol) notifies the author and the other commenter
|
||||
(gitea/issue-comment!
|
||||
ga-forge
|
||||
"alice"
|
||||
"proj"
|
||||
1
|
||||
"carol"
|
||||
"me too"
|
||||
{:at 30})
|
||||
(define ga-out2 (gitea/notify! ga-forge))
|
||||
(gitea-act-test "incremental delivery" (len ga-out2) 2)
|
||||
(gitea-act-test
|
||||
"inbox alice grows"
|
||||
(gitea/inbox-count ga-forge "alice")
|
||||
2)
|
||||
(gitea-act-test
|
||||
"inbox bob grows"
|
||||
(gitea/inbox-count ga-forge "bob")
|
||||
4)
|
||||
|
||||
; ── web ──────────────────────────────────────────────────────────────
|
||||
|
||||
(define ga-app (gitea/app ga-forge))
|
||||
(define ga-hdr (fn (tok) (if (nil? tok) {} {:authorization (str "Bearer " tok)})))
|
||||
(define
|
||||
ga-get
|
||||
(fn (target tok) (ga-app (dream-request "GET" target (ga-hdr tok) ""))))
|
||||
(define
|
||||
ga-post
|
||||
(fn
|
||||
(target tok body)
|
||||
(ga-app (dream-request "POST" target (ga-hdr tok) body))))
|
||||
(define
|
||||
ga-del
|
||||
(fn
|
||||
(target tok)
|
||||
(ga-app (dream-request "DELETE" target (ga-hdr tok) ""))))
|
||||
|
||||
(gitea-act-test
|
||||
"activity page 200"
|
||||
(dream-status (ga-get "/activity" nil))
|
||||
200)
|
||||
(gitea-act-test
|
||||
"activity page shows merges"
|
||||
(contains? (dream-resp-body (ga-get "/activity" nil)) "merge-pr")
|
||||
true)
|
||||
(gitea-act-test
|
||||
"activity page hides private from anon"
|
||||
(contains? (dream-resp-body (ga-get "/activity" nil)) "alice/sec")
|
||||
false)
|
||||
(gitea-act-test
|
||||
"activity page shows private to owner"
|
||||
(contains? (dream-resp-body (ga-get "/activity" "tok-a")) "alice/sec")
|
||||
true)
|
||||
|
||||
(gitea-act-test
|
||||
"repo activity page 200"
|
||||
(dream-status (ga-get "/alice/proj/activity" nil))
|
||||
200)
|
||||
(gitea-act-test
|
||||
"repo activity shows pr open"
|
||||
(contains? (dream-resp-body (ga-get "/alice/proj/activity" nil)) "open-pr")
|
||||
true)
|
||||
(gitea-act-test
|
||||
"private repo activity anon 404"
|
||||
(dream-status (ga-get "/alice/sec/activity" nil))
|
||||
404)
|
||||
(gitea-act-test
|
||||
"private repo activity collab 200"
|
||||
(dream-status (ga-get "/alice/sec/activity" "tok-b"))
|
||||
200)
|
||||
|
||||
(gitea-act-test
|
||||
"api user activity len"
|
||||
(len
|
||||
(dream-json-parse
|
||||
(dream-resp-body (ga-get "/api/users/bob/activity" nil))))
|
||||
2)
|
||||
(gitea-act-test
|
||||
"api user activity unknown 404"
|
||||
(dream-status (ga-get "/api/users/zeb/activity" nil))
|
||||
404)
|
||||
|
||||
(gitea-act-test
|
||||
"api dashboard anon 401"
|
||||
(dream-status (ga-get "/api/dashboard" nil))
|
||||
401)
|
||||
(gitea-act-test
|
||||
"api dashboard bob"
|
||||
(len
|
||||
(dream-json-parse (dream-resp-body (ga-get "/api/dashboard" "tok-b"))))
|
||||
6)
|
||||
|
||||
(gitea-act-test
|
||||
"api follow anon 401"
|
||||
(dream-status (ga-post "/api/follow" nil (dream-json-encode {:target "user:bob"})))
|
||||
401)
|
||||
(gitea-act-test
|
||||
"api follow 200"
|
||||
(dream-status
|
||||
(ga-post "/api/follow" "tok-c" (dream-json-encode {:target "user:bob"})))
|
||||
200)
|
||||
(gitea-act-test
|
||||
"api follow recorded"
|
||||
(gitea/follows ga-forge "carol")
|
||||
(list "user:bob"))
|
||||
(gitea-act-test
|
||||
"api follow bad target 400"
|
||||
(dream-status
|
||||
(ga-post "/api/follow" "tok-c" (dream-json-encode {:target "nope"})))
|
||||
400)
|
||||
(gitea-act-test
|
||||
"api unfollow 200"
|
||||
(dream-status (ga-del "/api/follow/user:bob" "tok-c"))
|
||||
200)
|
||||
(gitea-act-test
|
||||
"api unfollow missing 404"
|
||||
(dream-status (ga-del "/api/follow/user:bob" "tok-c"))
|
||||
404)
|
||||
|
||||
(gitea-act-test
|
||||
"api notifications anon 401"
|
||||
(dream-status (ga-get "/api/notifications" nil))
|
||||
401)
|
||||
(gitea-act-test
|
||||
"api notifications bodies"
|
||||
(contains?
|
||||
(dream-json-parse
|
||||
(dream-resp-body (ga-get "/api/notifications" "tok-a")))
|
||||
"bob comment issue:alice/proj#1")
|
||||
true)
|
||||
|
||||
(gitea-act-test
|
||||
"api notify run anon 401"
|
||||
(dream-status (ga-post "/api/notify/run" nil "{}"))
|
||||
401)
|
||||
(gitea-act-test
|
||||
"api notify run 200"
|
||||
(dream-status (ga-post "/api/notify/run" "tok-a" "{}"))
|
||||
200)
|
||||
@@ -11,8 +11,10 @@
|
||||
; needs the owner (or org admin), delete and collaborator management need
|
||||
; "admin". 401 = no credentials, 403 = authenticated but not allowed.
|
||||
;
|
||||
; Later modules (wire, issues, ...) extend the app by appending a routes
|
||||
; pack to gitea/route-packs at load time; gitea/app serves them all.
|
||||
; Later modules (wire, issues, pr, activity, ...) extend the app by
|
||||
; appending a routes pack to gitea/route-packs at load time; gitea/app
|
||||
; serves them all, with every /api/* route hoisted ahead of the wildcard
|
||||
; /:owner/:name patterns so a pack can never be shadowed.
|
||||
;
|
||||
; Requires: lib/gitea/{repo,access}.sx, lib/dream/{types,router,middleware,
|
||||
; error,html,json,auth,api}.sx
|
||||
@@ -458,8 +460,6 @@
|
||||
(else (dream-not-found)))))))
|
||||
|
||||
; ── routes ───────────────────────────────────────────────────────────
|
||||
; /api/* is listed first so an owner segment can never shadow it (owner
|
||||
; names matching router words are rejected by gitea/valid-name? anyway).
|
||||
|
||||
(define
|
||||
gitea/routes
|
||||
@@ -500,16 +500,21 @@
|
||||
"/:owner/:name/raw/:ref/**"
|
||||
(fn (req) (gitea/w-raw forge req))))))
|
||||
|
||||
; extension point: wire/issues/... append their packs at load time
|
||||
; extension point: wire/issues/pr/activity/... append their packs at load
|
||||
(define gitea/route-packs (list gitea/routes))
|
||||
|
||||
; every /api/* route (from any pack) dispatches before the wildcard
|
||||
; /:owner/:name patterns, so later packs can add API endpoints freely
|
||||
(define
|
||||
gitea/all-routes
|
||||
(fn
|
||||
(forge)
|
||||
(reduce
|
||||
(fn (acc pack) (concat acc (pack forge)))
|
||||
(list)
|
||||
gitea/route-packs)))
|
||||
(let
|
||||
((rs (reduce (fn (acc pack) (concat acc (pack forge))) (list) gitea/route-packs)))
|
||||
(concat
|
||||
(filter (fn (r) (starts-with? (dream-route-path r) "/api/")) rs)
|
||||
(filter
|
||||
(fn (r) (not (starts-with? (dream-route-path r) "/api/")))
|
||||
rs)))))
|
||||
|
||||
(define gitea/app (fn (forge) (dream-make-app (gitea/all-routes forge))))
|
||||
|
||||
Reference in New Issue
Block a user