Commit 5bd1bf7e authored by Christopher Lemmer Webber's avatar Christopher Lemmer Webber

Write out profile if requesting activitystreams json

parent 41d8ae09
......@@ -2,6 +2,7 @@
(require html-writing
net/url
json
web-server/servlet
web-server/servlet-env
web-server/dispatch
......@@ -25,6 +26,16 @@
(ok (xexp->html-bytes sxml)
#:content-type #"text/html"))
(define (json->string json)
(call-with-output-string
(lambda (p)
(write-json json p))))
(define (json->bytes json)
(call-with-output-bytes
(lambda (p)
(write-json json p))))
;;; Some parameters
;;; ===============
......@@ -50,9 +61,32 @@
;; Also serves as the actor page
(define (homepage req)
(render-ok
(generic-base-tmpl
`(p "Hi there! This is " ,(users-name) "'s site."))))
;; A very naive (and incorrect) version of header parsing.
;; A demo kludge for sure ;P
(define headers
(string-split (match (assoc 'accept (request-headers req))
[(cons 'accept str) str]
[#f ""])
","))
(match (request-method req)
[#"GET"
(cond
;; If we get request for json-ld, return that
;; TODO: Accept other json-ld header here, and parse it right
[(member "application/activity+json" headers)
(define profile
`#hasheq((name . ,(users-name))
(inbox . ,(golem-url inbox))
(outbox . ,(golem-url outbox))))
(ok (json->bytes profile)
#:content-type #"application/activity+json")]
;; Return the html page
[else
(render-ok
(generic-base-tmpl
`(p "Hi there! This is " ,(users-name) "'s site.")))])]
[#"POST"
'TODO]))
(define (inbox req)
(render-ok
......
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