giles
b4fbfa5603
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>
521 lines
16 KiB
Plaintext
521 lines
16 KiB
Plaintext
; lib/gitea/web.sx — sx-gitea Phases 1+2: browse views over dream, gated
|
|
; by access control.
|
|
;
|
|
; Pure request -> response handlers: repo list, repo home, tree/blob/raw
|
|
; browse at any ref (branch, tag, or cid), commit log, single-commit diff,
|
|
; plus a JSON API for repo create/list/delete and collaborator management.
|
|
;
|
|
; Gating: every repo route requires "read" (a miss is a 404 — private
|
|
; repos are indistinguishable from absent ones); mutations require the
|
|
; caller to authenticate (bearer token) and hold the right role: create
|
|
; needs the owner (or org admin), delete and collaborator management need
|
|
; "admin". 401 = no credentials, 403 = authenticated but not allowed.
|
|
;
|
|
; 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
|
|
|
|
; ── html scaffolding ─────────────────────────────────────────────────
|
|
|
|
(define
|
|
gitea/w-page
|
|
(fn
|
|
(title body)
|
|
(dream-html
|
|
(str
|
|
"<!doctype html><html><head><title>"
|
|
(dream-escape title)
|
|
"</title></head><body>"
|
|
body
|
|
"</body></html>"))))
|
|
|
|
(define
|
|
gitea/w-repo-link
|
|
(fn
|
|
(full)
|
|
(str "<li><a href=\"/" full "\">" (dream-escape full) "</a></li>")))
|
|
|
|
; ── auth helpers ─────────────────────────────────────────────────────
|
|
|
|
(define
|
|
gitea/w-user
|
|
(fn
|
|
(forge req)
|
|
(let
|
|
((tok (dream-bearer-token req)))
|
|
(if (nil? tok) nil (gitea/token-user forge tok)))))
|
|
|
|
(define
|
|
gitea/w-json-status
|
|
(fn (status v) (dream-response status {:content-type "application/json"} (dream-json-encode v))))
|
|
|
|
(define
|
|
gitea/w-unauthorized
|
|
(fn () (gitea/w-json-status 401 {:error "unauthorized"})))
|
|
(define
|
|
gitea/w-forbidden
|
|
(fn () (gitea/w-json-status 403 {:error "forbidden"})))
|
|
|
|
; can the requester read this repo? (false covers missing repos too)
|
|
(define
|
|
gitea/w-readable?
|
|
(fn
|
|
(forge req owner name)
|
|
(gitea/can? forge (gitea/w-user forge req) "read" owner name)))
|
|
|
|
; ── pages ────────────────────────────────────────────────────────────
|
|
|
|
(define
|
|
gitea/w-index
|
|
(fn
|
|
(forge req)
|
|
(gitea/w-page
|
|
"repositories"
|
|
(str
|
|
"<h1>Repositories</h1><ul>"
|
|
(join
|
|
""
|
|
(map
|
|
gitea/w-repo-link
|
|
(gitea/visible-repos forge (gitea/w-user forge req))))
|
|
"</ul>"))))
|
|
|
|
(define
|
|
gitea/w-branch-item
|
|
(fn
|
|
(owner name b)
|
|
(str
|
|
"<li><a href=\"/"
|
|
owner
|
|
"/"
|
|
name
|
|
"/tree/"
|
|
b
|
|
"\">"
|
|
(dream-escape b)
|
|
"</a></li>")))
|
|
|
|
(define
|
|
gitea/w-repo-home
|
|
(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)
|
|
(let
|
|
((rec (gitea/repo-get forge owner name))
|
|
(branches (git/branches (gitea/repo-git forge owner name))))
|
|
(gitea/w-page
|
|
(str owner "/" name)
|
|
(str
|
|
"<h1>"
|
|
(dream-escape (str owner "/" name))
|
|
"</h1>"
|
|
"<p>"
|
|
(dream-escape (or (get rec :description) ""))
|
|
"</p>"
|
|
"<p>visibility: "
|
|
(dream-escape (get rec :visibility))
|
|
"</p>"
|
|
(if
|
|
(empty? branches)
|
|
"<p>empty repository</p>"
|
|
(str
|
|
"<h2>Branches</h2><ul>"
|
|
(join
|
|
""
|
|
(map
|
|
(fn (b) (gitea/w-branch-item owner name b))
|
|
branches))
|
|
"</ul>")))))))))
|
|
|
|
(define
|
|
gitea/w-branches
|
|
(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 " branches")
|
|
(str
|
|
"<h1>Branches</h1><ul>"
|
|
(join
|
|
""
|
|
(map
|
|
(fn (b) (gitea/w-branch-item owner name b))
|
|
(git/branches (gitea/repo-git forge owner name))))
|
|
"</ul>"))))))
|
|
|
|
; resolve the owner/name/ref/** of a browse request down to a tree entry;
|
|
; nil on any miss (unreadable repo, bad ref, bad path)
|
|
(define
|
|
gitea/w-entry
|
|
(fn
|
|
(forge req)
|
|
(let
|
|
((owner (dream-param req "owner"))
|
|
(name (dream-param req "name"))
|
|
(ref (dream-param req "ref"))
|
|
(path (or (dream-param req "**") "")))
|
|
(if
|
|
(not (gitea/w-readable? forge req owner name))
|
|
nil
|
|
(let
|
|
((grepo (gitea/repo-git forge owner name)))
|
|
(let
|
|
((cid (gitea/resolve-ref grepo ref)))
|
|
(if
|
|
(nil? cid)
|
|
nil
|
|
(let
|
|
((entry (gitea/tree-at grepo cid path)))
|
|
(if (nil? entry) nil {:name name :path path :grepo grepo :entry entry :owner owner :ref ref})))))))))
|
|
|
|
(define
|
|
gitea/w-entry-item
|
|
(fn
|
|
(hit n kind)
|
|
(let
|
|
((base (if (equal? kind "tree") "tree" "blob")))
|
|
(let
|
|
((sub (if (equal? (get hit :path) "") n (str (get hit :path) "/" n))))
|
|
(str
|
|
"<li class=\""
|
|
kind
|
|
"\"><a href=\"/"
|
|
(get hit :owner)
|
|
"/"
|
|
(get hit :name)
|
|
"/"
|
|
base
|
|
"/"
|
|
(get hit :ref)
|
|
"/"
|
|
sub
|
|
"\">"
|
|
(dream-escape n)
|
|
"</a></li>")))))
|
|
|
|
(define
|
|
gitea/w-tree
|
|
(fn
|
|
(forge req)
|
|
(let
|
|
((hit (gitea/w-entry forge req)))
|
|
(if
|
|
(or (nil? hit) (not (equal? (get (get hit :entry) :kind) "tree")))
|
|
(dream-not-found)
|
|
(let
|
|
((tree (git/read (get hit :grepo) (get (get hit :entry) :cid))))
|
|
(gitea/w-page
|
|
(str (get hit :owner) "/" (get hit :name) ": /" (get hit :path))
|
|
(str
|
|
"<h1>"
|
|
(dream-escape (str (get hit :owner) "/" (get hit :name)))
|
|
"</h1>"
|
|
"<h2>/"
|
|
(dream-escape (get hit :path))
|
|
"</h2>"
|
|
"<ul>"
|
|
(join
|
|
""
|
|
(map
|
|
(fn
|
|
(n)
|
|
(gitea/w-entry-item
|
|
hit
|
|
n
|
|
(git/entry-kind (git/tree-entry-for tree n))))
|
|
(git/tree-names tree)))
|
|
"</ul>")))))))
|
|
|
|
(define
|
|
gitea/w-blob
|
|
(fn
|
|
(forge req)
|
|
(let
|
|
((hit (gitea/w-entry forge req)))
|
|
(if
|
|
(or (nil? hit) (not (equal? (get (get hit :entry) :kind) "blob")))
|
|
(dream-not-found)
|
|
(let
|
|
((data (git/blob-data (git/read (get hit :grepo) (get (get hit :entry) :cid)))))
|
|
(gitea/w-page
|
|
(str (get hit :owner) "/" (get hit :name) ": " (get hit :path))
|
|
(str
|
|
"<h1>"
|
|
(dream-escape (get hit :path))
|
|
"</h1>"
|
|
"<pre>"
|
|
(dream-escape data)
|
|
"</pre>")))))))
|
|
|
|
(define
|
|
gitea/w-raw
|
|
(fn
|
|
(forge req)
|
|
(let
|
|
((hit (gitea/w-entry forge req)))
|
|
(if
|
|
(or (nil? hit) (not (equal? (get (get hit :entry) :kind) "blob")))
|
|
(dream-not-found)
|
|
(dream-text
|
|
(git/blob-data
|
|
(git/read (get hit :grepo) (get (get hit :entry) :cid))))))))
|
|
|
|
(define
|
|
gitea/w-commit-item
|
|
(fn
|
|
(grepo owner name c)
|
|
(let
|
|
((obj (git/read grepo c)))
|
|
(str
|
|
"<li><a href=\"/"
|
|
owner
|
|
"/"
|
|
name
|
|
"/commit/"
|
|
c
|
|
"\">"
|
|
(dream-escape (or (git/commit-message obj) ""))
|
|
"</a> <code>"
|
|
c
|
|
"</code></li>"))))
|
|
|
|
(define
|
|
gitea/w-commits
|
|
(fn
|
|
(forge req)
|
|
(let
|
|
((owner (dream-param req "owner"))
|
|
(name (dream-param req "name"))
|
|
(ref (dream-param req "ref")))
|
|
(if
|
|
(not (gitea/w-readable? forge req owner name))
|
|
(dream-not-found)
|
|
(let
|
|
((grepo (gitea/repo-git forge owner name)))
|
|
(let
|
|
((cid (gitea/resolve-ref grepo ref)))
|
|
(if
|
|
(nil? cid)
|
|
(dream-not-found)
|
|
(gitea/w-page
|
|
(str owner "/" name " commits")
|
|
(str
|
|
"<h1>Commits</h1><ol>"
|
|
(join
|
|
""
|
|
(map
|
|
(fn (c) (gitea/w-commit-item grepo owner name c))
|
|
(git/log grepo cid)))
|
|
"</ol>")))))))))
|
|
|
|
; single commit: message/author/parents, plus the diff against the first
|
|
; parent (root commits list their files instead)
|
|
(define
|
|
gitea/w-commit
|
|
(fn
|
|
(forge req)
|
|
(let
|
|
((owner (dream-param req "owner"))
|
|
(name (dream-param req "name"))
|
|
(cidp (dream-param req "cid")))
|
|
(if
|
|
(not (gitea/w-readable? forge req owner name))
|
|
(dream-not-found)
|
|
(let
|
|
((grepo (gitea/repo-git forge owner name)))
|
|
(let
|
|
((obj (git/read grepo cidp)))
|
|
(if
|
|
(or (nil? obj) (not (git/commit? obj)))
|
|
(dream-not-found)
|
|
(let
|
|
((parents (git/commit-parents obj)))
|
|
(let
|
|
((detail (if (empty? parents) (str "<h3>Files</h3><ul>" (join "" (map (fn (p) (str "<li>" (dream-escape p) "</li>")) (artdag/sort-strings (keys (git/tree-flatten grepo (git/commit-tree obj)))))) "</ul>") (str "<pre>" (dream-escape (git/commit-diff-unified grepo (first parents) cidp)) "</pre>"))))
|
|
(gitea/w-page
|
|
(str "commit " cidp)
|
|
(str
|
|
"<h1>"
|
|
(dream-escape (or (git/commit-message obj) ""))
|
|
"</h1>"
|
|
"<p>author: "
|
|
(dream-escape (or (git/commit-author obj) ""))
|
|
"</p>"
|
|
"<p>cid: <code>"
|
|
cidp
|
|
"</code></p>"
|
|
detail)))))))))))
|
|
|
|
; ── json api ─────────────────────────────────────────────────────────
|
|
|
|
(define
|
|
gitea/w-api-repos
|
|
(fn
|
|
(forge req)
|
|
(dream-json-value (gitea/visible-repos forge (gitea/w-user forge req)))))
|
|
|
|
(define
|
|
gitea/w-api-repo-create
|
|
(fn
|
|
(forge req)
|
|
(let
|
|
((user (gitea/w-user forge req)))
|
|
(if
|
|
(nil? user)
|
|
(gitea/w-unauthorized)
|
|
(let
|
|
((body (dream-json-body req)))
|
|
(let
|
|
((owner (get body :owner)))
|
|
(cond
|
|
((not (gitea/owner-exists? forge owner))
|
|
(gitea/w-json-status 400 {:error "no-such-owner"}))
|
|
((not (gitea/create-allowed? forge user owner))
|
|
(gitea/w-forbidden))
|
|
(else
|
|
(let
|
|
((res (gitea/repo-create! forge owner (get body :name) {:description (or (get body :description) "") :created-at (or (get body :created-at) 0) :visibility (or (get body :visibility) "public")})))
|
|
(cond
|
|
((get res :conflict)
|
|
(gitea/w-json-status 409 {:error "exists"}))
|
|
((get res :error)
|
|
(gitea/w-json-status 400 {:error (get res :error)}))
|
|
(else (gitea/w-json-status 201 {:name (get res :name) :owner (get res :owner) :visibility (get res :visibility)}))))))))))))
|
|
|
|
(define
|
|
gitea/w-api-repo-delete
|
|
(fn
|
|
(forge req)
|
|
(let
|
|
((owner (dream-param req "owner")) (name (dream-param req "name")))
|
|
(let
|
|
((user (gitea/w-user forge req)))
|
|
(cond
|
|
((not (gitea/can? forge user "read" owner name))
|
|
(dream-not-found))
|
|
((nil? user) (gitea/w-unauthorized))
|
|
((not (gitea/can? forge user "admin" owner name))
|
|
(gitea/w-forbidden))
|
|
(else
|
|
(begin
|
|
(gitea/repo-delete! forge owner name)
|
|
(dream-json-value {:deleted true}))))))))
|
|
|
|
(define
|
|
gitea/w-api-collab-put
|
|
(fn
|
|
(forge req)
|
|
(let
|
|
((owner (dream-param req "owner"))
|
|
(name (dream-param req "name"))
|
|
(cuser (dream-param req "user")))
|
|
(let
|
|
((user (gitea/w-user forge req)))
|
|
(cond
|
|
((not (gitea/can? forge user "read" owner name))
|
|
(dream-not-found))
|
|
((nil? user) (gitea/w-unauthorized))
|
|
((not (gitea/can? forge user "admin" owner name))
|
|
(gitea/w-forbidden))
|
|
(else
|
|
(let
|
|
((role (or (get (dream-json-body req) :role) "read")))
|
|
(let
|
|
((res (gitea/collab-add! forge owner name cuser role)))
|
|
(if
|
|
(get res :error)
|
|
(gitea/w-json-status 400 {:error (get res :error)})
|
|
(dream-json-value {:role role :user cuser}))))))))))
|
|
|
|
(define
|
|
gitea/w-api-collab-delete
|
|
(fn
|
|
(forge req)
|
|
(let
|
|
((owner (dream-param req "owner"))
|
|
(name (dream-param req "name"))
|
|
(cuser (dream-param req "user")))
|
|
(let
|
|
((user (gitea/w-user forge req)))
|
|
(cond
|
|
((not (gitea/can? forge user "read" owner name))
|
|
(dream-not-found))
|
|
((nil? user) (gitea/w-unauthorized))
|
|
((not (gitea/can? forge user "admin" owner name))
|
|
(gitea/w-forbidden))
|
|
((gitea/collab-remove! forge owner name cuser)
|
|
(dream-json-value {:deleted true}))
|
|
(else (dream-not-found)))))))
|
|
|
|
; ── routes ───────────────────────────────────────────────────────────
|
|
|
|
(define
|
|
gitea/routes
|
|
(fn
|
|
(forge)
|
|
(list
|
|
(dream-get "/" (fn (req) (gitea/w-index forge req)))
|
|
(dream-get "/api/repos" (fn (req) (gitea/w-api-repos forge req)))
|
|
(dream-post
|
|
"/api/repos"
|
|
(fn (req) (gitea/w-api-repo-create forge req)))
|
|
(dream-delete
|
|
"/api/repos/:owner/:name"
|
|
(fn (req) (gitea/w-api-repo-delete forge req)))
|
|
(dream-put
|
|
"/api/repos/:owner/:name/collab/:user"
|
|
(fn (req) (gitea/w-api-collab-put forge req)))
|
|
(dream-delete
|
|
"/api/repos/:owner/:name/collab/:user"
|
|
(fn (req) (gitea/w-api-collab-delete forge req)))
|
|
(dream-get "/:owner/:name" (fn (req) (gitea/w-repo-home forge req)))
|
|
(dream-get
|
|
"/:owner/:name/branches"
|
|
(fn (req) (gitea/w-branches forge req)))
|
|
(dream-get
|
|
"/:owner/:name/commits/:ref"
|
|
(fn (req) (gitea/w-commits forge req)))
|
|
(dream-get
|
|
"/:owner/:name/commit/:cid"
|
|
(fn (req) (gitea/w-commit forge req)))
|
|
(dream-get
|
|
"/:owner/:name/tree/:ref/**"
|
|
(fn (req) (gitea/w-tree forge req)))
|
|
(dream-get
|
|
"/:owner/:name/blob/:ref/**"
|
|
(fn (req) (gitea/w-blob forge req)))
|
|
(dream-get
|
|
"/:owner/:name/raw/:ref/**"
|
|
(fn (req) (gitea/w-raw forge req))))))
|
|
|
|
; 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)
|
|
(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))))
|