Document a whole bunch of things, including the pages

parent f0cae5d4
......@@ -18,6 +18,7 @@
;;; Utilities
;;; =========
;; current working directory... used for serving static content
(define-runtime-path cwd ".")
(define (ok body #:content-type [content-type #"application/octet-stream"])
......@@ -118,9 +119,9 @@
;; This is the page for the actor's profile (which is mounted at the
;; root in this demo, but is the same as eg "")
;; We serve content differently depending on whether the request
;; asks for ActivityStreams json-ld (in which case we return the json-ld
;; profile of this actor, which most critically for this demo has the
;; inbox property attached).
;; asks for ActivityStreams json-ld (in which case we return the json
;; representation of this actor, which most critically for this demo
;; has the inbox property attached).
;; Otherwise we return an html render.
(define (actor-profile req)
;; A very naive (and incorrect) version of header parsing.
......@@ -142,6 +143,8 @@
#:content-type #"application/activity+json")]
;; Return the html page
;; Render a collection, but only one item from that collection
;; TODO: move this to the templates section?
(define (preview-collection col-sym col-name col-handler)
(h2 "Most recent post in your "
......@@ -162,38 +165,73 @@
(div ,(preview-collection 'outbox "outbox" get-outbox)
,(preview-collection 'inbox "inbox" get-inbox)))))]))
;; Render the actor's inbox in response to a GET against /inbox
;; Should return a nice html gallery of the content unless requested
;; as json-ld, in which case we'll return an OrderedCollection
;; ActivityStreams object.
;; TODO: Actually implement this :)
(define (get-inbox req)
'(p "Inbox goes here!"))))
;; Process an incoming message in response to a POST to our /inbox
;; Here's how we actually receive federated content!
(define (post-inbox req)
;; Hand off the content to a worker.
(process-federated-message (request-post-data/raw req))
;; We respond asynchronously with an OK response.
;; TODO: This is wrong! According to the spec:
;; > If an Activity is submitted with a value in the id property,
;; > servers MUST ignore this and generate a new id for the
;; > Activity. Servers MUST return a 201 Created HTTP code, and unless
;; > the activity is transient, MUST include the new id in the
;; > Location header.
'(html (title "got it")
(body (p "Got it... processing!")))))
;; Render the actor's outbox in response to a GET against /outbox
;; See get-inbox's documentation, but for our outbox :)
(define (get-outbox req)
'(p "Outbox goes here!"))))
;; Submit a message via the web UI's form.
;; More or less this is the "client composition" part of this demo.
;; We aren't implementing the ActivityPub C2S (client-to-server) API
;; because it doesn't really matter for this demo.
(define (post-note req)
;;; Process form data
(define form-data
(bytes->string/utf-8 (request-post-data/raw req))))
;; Extract the `to' and `content' fields from the form data
;; and error out if they aren't there.
;; TODO: Properly signal user about problem
(match-define (cons _ to)
(assoc 'to form-data))
(match-define (cons _ content)
(assoc 'content form-data))
;; Split up the To address and convert them to url structs.
;; In this demo we keep things simple and split recipients on whitespace
;; from the form data.
(define to-addrs-strs
(string-split to))
(define to-addrs-urls
(map string->url to-addrs-strs))
;;; Now generate note and create structures
;; Now generate Note and Create structures.
;; Every federated message in the fediverse has an object wrapped
;; in an activity (verb'ing a noun).
;; In this demo we're keeping things lean and just assume every
;; message sent across the network is like {Create {Note}}.
;; (Technically every activity sent is supposed to have an actor too;
;; in the future I might explain why in an ocap AP system that isn't
;; strictly necessary...)
(define note
`#hasheq((type . "Note")
(content . ,content)
......@@ -207,7 +245,8 @@
(define create
`#hasheq((type . "Create")
(object . ,(url->string note-url))
;; not strictly necessary, but good to be kept in the loop :)
;; not strictly necessary, but good to be kept in the loop
;; in case someone replies to us :)
(to . ,to-addrs-strs)))
(define create-str
(json->string create))
......@@ -216,13 +255,21 @@
(lambda (p)
(magenc-put! p (magenc-store)))))
;; Now we federate it out.
;; The federate-message function generates separate workers/threads
;; for every recipient so this won't block.
(federate-message (call-with-output-bytes
(lambda (p)
`#hasheq((@id . ,(url->string create-url)))
;; We set things up enough to pass it off for federation, so at this
;; point we should add it to our outbox.
(db-append! 'outbox create-url)
;; Now render a template saying we saved it.
;; TODO: We should redirect.
(render-ok (generic-base-tmpl
`(div (h1 "Saved it!")
......@@ -230,6 +277,11 @@
(a (@ (href ,(golem-url actor-profile)))
"go home") "!"))))))
;; Respond to GETs against /read-only-cas
;; CAS stands for "Content Addressed Storage".
;; If a user makes a request like:
;; GET /read-only-cas?xt=urn:sha256:<hash>
;; we'll see if we have that object and will return it if we do.
(define (read-only-cas req)
(match (assoc 'xt (url-query (request-uri req)))
[#f (not-found)]
......@@ -239,15 +291,15 @@
[(? bytes? out-bytes)
(ok out-bytes)])]))
(define (serve-encrypted-object req enc-hash-str)
(define (decrypt-encrypted-object req enc-hash-str-key)
;;; Templates
;;; =========
;; All templates here use SXML, an s-expressions based xml representation.
;; Quasiquote, the ultimate templating language!
(define (base-tmpl body #:title [title #f])
(define (header-link link-name link-url)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment