; 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, ...) extend the app by appending a routes ; pack to gitea/route-packs at load time; gitea/app serves them all. ; ; 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 "" (dream-escape title) "" body "")))) (define gitea/w-repo-link (fn (full) (str "
  • " (dream-escape full) "
    • "))) ; ── 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 "

    Repositories

    ")))) (define gitea/w-branch-item (fn (owner name b) (str "
  • " (dream-escape b) "
    • "))) (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 "

    " (dream-escape (str owner "/" name)) "

    " "

    " (dream-escape (or (get rec :description) "")) "

    " "

    visibility: " (dream-escape (get rec :visibility)) "

    " (if (empty? branches) "

    empty repository

    " (str "

    Branches

    "))))))))) (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 "

    Branches

    ")))))) ; 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 "
  • " (dream-escape n) "
    • "))))) (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 "

    " (dream-escape (str (get hit :owner) "/" (get hit :name))) "

    " "

    /" (dream-escape (get hit :path)) "

    " ""))))))) (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 "

    " (dream-escape (get hit :path)) "

    " "
    "
              (dream-escape data)
              "
    "))))))) (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 "
  • " (dream-escape (or (git/commit-message obj) "")) " " c "
    • ")))) (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 "

    Commits

      " (join "" (map (fn (c) (gitea/w-commit-item grepo owner name c)) (git/log grepo cid))) "
    "))))))))) ; 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 "

    Files

    ") (str "
    " (dream-escape (git/commit-diff-unified grepo (first parents) cidp)) "
    ")))) (gitea/w-page (str "commit " cidp) (str "

    " (dream-escape (or (git/commit-message obj) "")) "

    " "

    author: " (dream-escape (or (git/commit-author obj) "")) "

    " "

    cid: " cidp "

    " 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 ─────────────────────────────────────────────────────────── ; /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 (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/... append their packs at load time (define gitea/route-packs (list gitea/routes)) (define gitea/all-routes (fn (forge) (reduce (fn (acc pack) (concat acc (pack forge))) (list) gitea/route-packs))) (define gitea/app (fn (forge) (dream-make-app (gitea/all-routes forge))))