Merge sx-pub branch into ocaml-vm

Brings in sx-pub federated publishing protocol (Phases 1-4):
- DB models, IPFS publishing, federation, anchoring
- Live dashboard UI on the plan page
- Dev infrastructure (docker-compose, dev-pub.sh)

Conflicts: sx-browser.js (kept ocaml-vm rebuild), sx-pub.sx (kept sx-pub version with dashboard)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-03-25 16:37:04 +00:00
10 changed files with 1922 additions and 6 deletions

395
sx/sx/handlers/pub-api.sx Normal file
View File

@@ -0,0 +1,395 @@
;; ==========================================================================
;; sx-pub API endpoints — actor, webfinger, collections, publishing, browsing
;;
;; All responses are text/sx. No JSON.
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Actor
;; --------------------------------------------------------------------------
(defhandler pub-actor
:path "/pub/actor"
:method :get
:returns "element"
(&key)
(let ((actor (helper "pub-actor-data")))
(do
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(str
"(SxActor"
"\n :id \"https://" (get actor "domain") "/pub/actor\""
"\n :type \"SxPublisher\""
"\n :name \"" (get actor "display-name") "\""
"\n :summary \"" (get actor "summary") "\""
"\n :inbox \"/pub/inbox\""
"\n :outbox \"/pub/outbox\""
"\n :followers \"/pub/followers\""
"\n :following \"/pub/following\""
"\n :public-key-pem \"" (get actor "public-key-pem") "\")"))))
;; --------------------------------------------------------------------------
;; Webfinger
;; --------------------------------------------------------------------------
(defhandler pub-webfinger
:path "/pub/webfinger"
:method :get
:returns "element"
(&key)
(let ((resource (helper "request-arg" "resource" ""))
(actor (helper "pub-actor-data")))
(let ((expected (str "acct:" (get actor "preferred-username") "@" (get actor "domain"))))
(if (!= resource expected)
(do
(set-response-status 404)
(str "(Error :message \"Resource not found\")"))
(do
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(str
"(SxWebfinger"
"\n :subject \"" expected "\""
"\n :actor \"https://" (get actor "domain") "/pub/actor\""
"\n :type \"SxPublisher\")"))))))
;; --------------------------------------------------------------------------
;; Collections
;; --------------------------------------------------------------------------
(defhandler pub-collections
:path "/pub/collections"
:method :get
:returns "element"
(&key)
(let ((collections (helper "pub-collections-data")))
(do
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(let ((items (map (fn (c)
(str "\n (SxCollection"
" :slug \"" (get c "slug") "\""
" :name \"" (get c "name") "\""
" :description \"" (get c "description") "\""
" :href \"/pub/" (get c "slug") "\")"))
collections)))
(str "(SxCollections" (join "" items) ")")))))
;; --------------------------------------------------------------------------
;; Status
;; --------------------------------------------------------------------------
(defhandler pub-status
:path "/pub/status"
:method :get
:returns "element"
(&key)
(let ((status (helper "pub-status-data")))
(do
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(str
"(SxPubStatus"
"\n :healthy " (get status "healthy")
"\n :db \"" (get status "db") "\""
"\n :ipfs \"" (get status "ipfs") "\""
"\n :actor \"" (get status "actor") "\""
"\n :domain \"" (or (get status "domain") "unknown") "\")"))))
;; ==========================================================================
;; Phase 2: Publishing + Browsing
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Publish
;; --------------------------------------------------------------------------
(defhandler pub-publish
:path "/pub/publish"
:method :post
:csrf false
:returns "element"
(&key)
(let ((collection (helper "request-form" "collection" ""))
(slug (helper "request-form" "slug" ""))
(content (helper "request-form" "content" ""))
(title (helper "request-form" "title" ""))
(summary (helper "request-form" "summary" "")))
(if (or (= collection "") (= slug "") (= content ""))
(do
(set-response-status 400)
(set-response-header "Content-Type" "text/sx; charset=utf-8")
"(Error :message \"Missing collection, slug, or content\")")
(let ((result (helper "pub-publish" collection slug content title summary)))
(if (get result "error")
(do
(set-response-status 500)
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(str "(Error :message \"" (get result "error") "\")"))
(do
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(str
"(Published"
"\n :path \"" (get result "path") "\""
"\n :cid \"" (get result "cid") "\""
"\n :hash \"" (get result "hash") "\""
"\n :size " (get result "size")
"\n :collection \"" (get result "collection") "\""
"\n :slug \"" (get result "slug") "\""
"\n :title \"" (get result "title") "\")")))))))
;; --------------------------------------------------------------------------
;; Browse collection
;; --------------------------------------------------------------------------
(defhandler pub-browse-collection
:path "/pub/browse/<collection_slug>"
:method :get
:returns "element"
(&key collection_slug)
(let ((data (helper "pub-collection-items" collection_slug)))
(if (get data "error")
(do
(set-response-status 404)
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(str "(Error :message \"" (get data "error") "\")"))
(do
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(let ((items (map (fn (d)
(str "\n (SxDocument"
" :slug \"" (get d "slug") "\""
" :title \"" (get d "title") "\""
" :summary \"" (get d "summary") "\""
" :cid \"" (get d "cid") "\""
" :size " (get d "size") ")"))
(get data "items"))))
(str
"(SxCollection"
"\n :slug \"" (get data "collection") "\""
"\n :name \"" (get data "name") "\""
"\n :description \"" (get data "description") "\""
(join "" items) ")"))))))
;; --------------------------------------------------------------------------
;; Resolve document by path
;; --------------------------------------------------------------------------
(defhandler pub-document
:path "/pub/doc/<collection_slug>/<slug>"
:method :get
:returns "element"
(&key collection_slug slug)
(let ((data (helper "pub-resolve-document" collection_slug slug)))
(if (get data "error")
(do
(set-response-status 404)
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(str "(Error :message \"" (get data "error") "\")"))
(do
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(set-response-header "X-IPFS-CID" (get data "cid"))
(get data "content")))))
;; --------------------------------------------------------------------------
;; Direct CID fetch
;; --------------------------------------------------------------------------
(defhandler pub-cid
:path "/pub/cid/<cid>"
:method :get
:returns "element"
(&key cid)
(let ((data (helper "pub-fetch-cid" cid)))
(if (get data "error")
(do
(set-response-status 404)
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(str "(Error :message \"" (get data "error") "\")"))
(do
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(set-response-header "Cache-Control" "public, max-age=31536000, immutable")
(get data "content")))))
;; ==========================================================================
;; Phase 3: Federation — outbox, inbox, follow, followers, following
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Outbox
;; --------------------------------------------------------------------------
(defhandler pub-outbox
:path "/pub/outbox"
:method :get
:returns "element"
(&key)
(let ((page (helper "request-arg" "page" ""))
(data (helper "pub-outbox-data" page)))
(do
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(let ((items (map (fn (a)
(str "\n (" (get a "type")
" :object-type \"" (get a "object-type") "\""
" :published \"" (get a "published") "\""
" :cid \"" (get a "cid") "\")"))
(get data "items"))))
(str
"(SxOutbox"
"\n :total " (get data "total")
"\n :page " (get data "page")
(join "" items) ")")))))
;; --------------------------------------------------------------------------
;; Inbox
;; --------------------------------------------------------------------------
(defhandler pub-inbox
:path "/pub/inbox"
:method :post
:csrf false
:returns "element"
(&key)
(let ((body (helper "pub-request-body")))
(if (= body "")
(do
(set-response-status 400)
(set-response-header "Content-Type" "text/sx; charset=utf-8")
"(Error :message \"Empty body\")")
(let ((result (helper "pub-process-inbox" body)))
(do
(set-response-status 202)
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(str "(Accepted :result " (str result) ")"))))))
;; --------------------------------------------------------------------------
;; Follow a remote server
;; --------------------------------------------------------------------------
(defhandler pub-follow
:path "/pub/follow"
:method :post
:csrf false
:returns "element"
(&key)
(let ((actor-url (helper "request-form" "actor_url" "")))
(if (= actor-url "")
(do
(set-response-status 400)
(set-response-header "Content-Type" "text/sx; charset=utf-8")
"(Error :message \"Missing actor_url\")")
(let ((result (helper "pub-follow-remote" actor-url)))
(do
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(if (get result "error")
(do
(set-response-status 502)
(str "(Error :message \"" (get result "error") "\")"))
(str
"(FollowSent"
"\n :actor-url \"" (get result "actor-url") "\""
"\n :status \"" (get result "status") "\")")))))))
;; --------------------------------------------------------------------------
;; Followers
;; --------------------------------------------------------------------------
(defhandler pub-followers
:path "/pub/followers"
:method :get
:returns "element"
(&key)
(let ((data (helper "pub-followers-data")))
(do
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(let ((items (map (fn (f)
(str "\n (SxFollower"
" :acct \"" (get f "acct") "\""
" :actor-url \"" (get f "actor-url") "\")"))
data)))
(str "(SxFollowers" (join "" items) ")")))))
;; --------------------------------------------------------------------------
;; Following
;; --------------------------------------------------------------------------
(defhandler pub-following
:path "/pub/following"
:method :get
:returns "element"
(&key)
(let ((data (helper "pub-following-data")))
(do
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(let ((items (map (fn (f)
(str "\n (SxFollowing"
" :actor-url \"" (get f "actor-url") "\")"))
data)))
(str "(SxFollowing" (join "" items) ")")))))
;; ==========================================================================
;; Phase 4: Anchoring — Merkle trees, OTS, verification
;; ==========================================================================
;; --------------------------------------------------------------------------
;; Anchor pending activities
;; --------------------------------------------------------------------------
(defhandler pub-anchor
:path "/pub/anchor"
:method :post
:csrf false
:returns "element"
(&key)
(let ((result (helper "pub-anchor-pending")))
(do
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(if (= (get result "status") "nothing-to-anchor")
"(Anchor :status \"nothing-to-anchor\" :count 0)"
(str
"(Anchor"
"\n :status \"" (get result "status") "\""
"\n :count " (get result "count")
"\n :merkle-root \"" (get result "merkle-root") "\""
"\n :tree-cid \"" (get result "tree-cid") "\""
"\n :ots-proof-cid \"" (get result "ots-proof-cid") "\")")))))
;; --------------------------------------------------------------------------
;; Verify a CID's anchor
;; --------------------------------------------------------------------------
(defhandler pub-verify
:path "/pub/verify/<cid>"
:method :get
:returns "element"
(&key cid)
(let ((data (helper "pub-verify-anchor" cid)))
(do
(set-response-header "Content-Type" "text/sx; charset=utf-8")
(if (get data "error")
(do
(set-response-status 404)
(str "(Error :message \"" (get data "error") "\")"))
(str
"(AnchorVerification"
"\n :cid \"" (get data "cid") "\""
"\n :status \"" (get data "status") "\""
"\n :verified " (get data "verified")
"\n :merkle-root \"" (get data "merkle-root") "\""
"\n :tree-cid \"" (get data "tree-cid") "\""
"\n :ots-proof-cid \"" (get data "ots-proof-cid") "\""
"\n :published \"" (get data "published") "\")")))))

View File

@@ -244,14 +244,131 @@
(~docs/section :title "Implementation Phases" :id "phases"
(div :class "space-y-4"
(div :class "rounded border border-emerald-200 bg-emerald-50 p-4"
(h4 :class "font-semibold text-emerald-800" "Phase 1: Foundation")
(h4 :class "font-semibold text-emerald-800" "Phase 1: Foundation")
(p :class "text-emerald-700 text-sm" "DB schema, async IPFS client, actor endpoint, webfinger, " (code "/pub/actor") " returns SX actor document."))
(div :class "rounded border border-sky-200 bg-sky-50 p-4"
(h4 :class "font-semibold text-sky-800" "Phase 2: Publishing")
(h4 :class "font-semibold text-sky-800" "Phase 2: Publishing")
(p :class "text-sky-700 text-sm" "Pin to IPFS, path→CID index, collection browsing. Publish the actual SX spec files as the first content."))
(div :class "rounded border border-violet-200 bg-violet-50 p-4"
(h4 :class "font-semibold text-violet-800" "Phase 3: Federation")
(h4 :class "font-semibold text-violet-800" "Phase 3: Federation")
(p :class "text-violet-700 text-sm" "Inbox/outbox, follow/accept, HTTP signature verification, activity delivery, content mirroring."))
(div :class "rounded border border-amber-200 bg-amber-50 p-4"
(h4 :class "font-semibold text-amber-800" "Phase 4: Anchoring")
(p :class "text-amber-700 text-sm" "Merkle trees, OpenTimestamps, Bitcoin proof, provenance UI."))))))
(h4 :class "font-semibold text-amber-800" "Phase 4: Anchoring")
(p :class "text-amber-700 text-sm" "Merkle trees, OpenTimestamps, Bitcoin proof, provenance verification."))))
;; -----------------------------------------------------------------------
;; Live Dashboard
;; -----------------------------------------------------------------------
(~docs/section :title "Live Dashboard" :id "dashboard"
(p "Live data from the sx-pub API — server-rendered from the same endpoints.")
;; --- Status ---
(~docs/subsection :title "Server Status"
(let ((status (helper "pub-status-data")))
(div :class "grid grid-cols-2 sm:grid-cols-4 gap-3"
(div :class "rounded border border-stone-200 p-3 text-center"
(p :class "text-xs text-stone-400 uppercase" "DB")
(p :class "font-semibold text-sm" (get status "db")))
(div :class "rounded border border-stone-200 p-3 text-center"
(p :class "text-xs text-stone-400 uppercase" "IPFS")
(p :class "font-semibold text-sm" (get status "ipfs")))
(div :class "rounded border border-stone-200 p-3 text-center"
(p :class "text-xs text-stone-400 uppercase" "Actor")
(p :class "font-semibold text-sm" (get status "actor")))
(div :class "rounded border border-stone-200 p-3 text-center"
(p :class "text-xs text-stone-400 uppercase" "Domain")
(p :class "font-semibold text-sm" (or (get status "domain") "—"))))))
;; --- Actor ---
(~docs/subsection :title "Actor Identity"
(let ((actor (helper "pub-actor-data")))
(div :class "rounded border border-stone-200 bg-stone-50 p-4 space-y-2"
(div :class "flex items-center gap-3"
(div :class "w-10 h-10 rounded-full bg-violet-100 flex items-center justify-center text-violet-700 font-bold" "sx")
(div
(p :class "font-semibold" (get actor "display-name"))
(p :class "text-sm text-stone-500" (str "@" (get actor "preferred-username") "@" (get actor "domain")))))
(p :class "text-sm text-stone-600" (get actor "summary"))
(details :class "text-xs"
(summary :class "text-stone-400 cursor-pointer" "Public key")
(pre :class "mt-2 bg-stone-100 rounded p-2 text-xs overflow-x-auto" (get actor "public-key-pem"))))))
;; --- Collections ---
(~docs/subsection :title "Collections"
(let ((collections (helper "pub-collections-data")))
(div :class "grid gap-3"
(map (fn (c)
(div :class "rounded border border-stone-200 p-4 hover:border-violet-300 transition-colors"
(div :class "flex items-center justify-between"
(div
(h4 :class "font-semibold text-stone-800" (get c "name"))
(p :class "text-sm text-stone-500" (get c "description")))
(span :class "text-xs font-mono text-violet-600 bg-violet-50 px-2 py-1 rounded"
(str "/pub/" (get c "slug"))))))
collections))))
;; --- Published Documents ---
(~docs/subsection :title "Published Documents"
(let ((specs (helper "pub-collection-items" "core-specs")))
(when (not (get specs "error"))
(div :class "space-y-2"
(h4 :class "text-sm font-semibold text-stone-500 uppercase tracking-wide"
(get specs "name"))
(map (fn (d)
(when (!= (get d "slug") "")
(div :class "rounded border border-stone-200 p-3 flex items-center justify-between"
(div
(p :class "font-medium text-stone-800" (get d "title"))
(p :class "text-xs text-stone-400" (get d "summary")))
(div :class "text-right"
(p :class "text-xs font-mono text-emerald-600 truncate max-w-48" (get d "cid"))
(p :class "text-xs text-stone-400" (str (get d "size") " bytes"))))))
(get specs "items"))))))
;; --- Outbox ---
(~docs/subsection :title "Recent Activity"
(let ((outbox (helper "pub-outbox-data" "")))
(if (= (get outbox "total") 0)
(p :class "text-sm text-stone-400 italic" "No activities yet.")
(div :class "space-y-2"
(p :class "text-xs text-stone-400" (str (get outbox "total") " total activities"))
(map (fn (a)
(when (!= (get a "type") "")
(div :class "rounded border border-stone-200 p-3 flex items-center gap-3"
(span :class "text-xs font-semibold text-white bg-violet-500 px-2 py-0.5 rounded"
(get a "type"))
(span :class "text-xs text-stone-500" (get a "published"))
(when (!= (get a "cid") "")
(span :class "text-xs font-mono text-emerald-600 truncate max-w-48"
(get a "cid"))))))
(get outbox "items"))))))
;; --- Followers ---
(~docs/subsection :title "Followers"
(let ((followers (helper "pub-followers-data")))
(if (empty? followers)
(p :class "text-sm text-stone-400 italic" "No followers yet.")
(div :class "space-y-2"
(map (fn (f)
(when (!= (get f "acct") "")
(div :class "rounded border border-stone-200 p-3 flex items-center gap-2"
(div :class "w-8 h-8 rounded-full bg-sky-100 flex items-center justify-center text-sky-700 text-xs font-bold" "F")
(p :class "text-sm font-mono text-stone-600 truncate" (get f "acct")))))
followers))))
;; --- API Endpoints ---
(~docs/subsection :title "Try the API"
(p :class "text-sm text-stone-600 mb-2" "All endpoints return " (code "text/sx") ". Try them directly:")
(div :class "grid grid-cols-2 sm:grid-cols-3 gap-2"
(map (fn (endpoint)
(a :href (get endpoint "href")
:class "block rounded border border-stone-200 p-2 text-center hover:border-violet-300 hover:bg-violet-50 transition-colors text-xs font-mono text-stone-600"
(get endpoint "label")))
(list
{"label" "GET /pub/actor" "href" "/pub/actor"}
{"label" "GET /pub/status" "href" "/pub/status"}
{"label" "GET /pub/collections" "href" "/pub/collections"}
{"label" "GET /pub/outbox" "href" "/pub/outbox"}
{"label" "GET /pub/followers" "href" "/pub/followers"}
{"label" "GET /pub/following" "href" "/pub/following"}))))))))