94 lines
4.1 KiB
Racket
94 lines
4.1 KiB
Racket
#lang racket
|
|
|
|
;; static generation rules
|
|
|
|
(require json
|
|
net/url-string
|
|
"compile.rkt")
|
|
|
|
(define (get-pref prefs what)
|
|
(match prefs
|
|
[(list _ ... (list (? (curry symbol=? what)) value) _ ...) value]
|
|
[_ (error "no such pref" prefs what)]))
|
|
|
|
(define ACTOR-CONTEXT
|
|
(list "https://www.w3.org/ns/activitystreams"
|
|
"https://w3id.org/security/v1"
|
|
(hash 'manuallyApprovesFollowers "as:manuallyApprovesFollowers"
|
|
'sensitive "as:sensitive"
|
|
'movedTo "as:movedTo"
|
|
'Hashtag "as:Hashtag"
|
|
'toot "http://joinmastodon.org/ns#"
|
|
'Emoji "toot:Emoji"
|
|
'focalPoint (hash '@container "@list"
|
|
'@id "toot:focalPoint")
|
|
'featured "toot:featured")))
|
|
|
|
(define compile-index-json
|
|
(rule '("db/actorkey.pub" "src/instance.rktd" "src/bio.md") "public/index.json"
|
|
(lambda (in out)
|
|
(define key (port->string (hash-ref in "db/actorkey.pub")))
|
|
(define prefs (read (hash-ref in "src/instance.rktd")))
|
|
(define instance-url (get-pref prefs 'shonks:instance-url))
|
|
(define display-name (get-pref prefs 'shonks:display-name))
|
|
(define name (get-pref prefs 'shonks:name))
|
|
(define bio (port->string (hash-ref in "src/bio.md")))
|
|
(define actor (hash
|
|
'@context ACTOR-CONTEXT
|
|
'Type "Person"
|
|
'id instance-url
|
|
'name display-name
|
|
'preferredUsername name
|
|
'icon (hash 'type "Image"
|
|
'url "something"
|
|
'sensitive #f)
|
|
'image (hash 'type "Image"
|
|
'url "something"
|
|
'sensitive #f)
|
|
'tag (list (hash 'type "Hashtag"
|
|
'href (string-append instance-url "tags/blahaj")
|
|
'name "#blahaj"))
|
|
'manuallyApprovesFollowers #f
|
|
'summary bio
|
|
'attachment (list (hash 'type "PropertyValue"
|
|
'name "pronouns"
|
|
'value "they/them"))
|
|
'url instance-url
|
|
'inbox (string-append instance-url "inbox")
|
|
'sharedInbox (string-append instance-url "inbox")
|
|
'endpoints (hash 'sharedInbox (string-append instance-url "inbox"))
|
|
'outbox (string-append instance-url "outbox")
|
|
'following 'null
|
|
'followers (string-append instance-url "followers")
|
|
'liked 'null
|
|
'publicKey (hash 'id (string-append instance-url "#main-key")
|
|
'type "Key"
|
|
'owner instance-url
|
|
'publicKeyPem key)))
|
|
(write-json actor out))))
|
|
|
|
(define compile-webfinger
|
|
(rule '("src/instance.rktd") "public/webfinger.json"
|
|
(lambda (in out)
|
|
(define prefs (read (hash-ref in "src/instance.rktd")))
|
|
(define instance-url (get-pref prefs 'shonks:instance-url))
|
|
(define host (url-host (string->url instance-url)))
|
|
(define name (get-pref prefs 'shonks:name))
|
|
(define webfinger
|
|
(hash
|
|
'subject (format "acct:~a@~a" name host)
|
|
'links (list (hash
|
|
'rel "self"
|
|
'type "application/activity+json"
|
|
'href instance-url))))
|
|
(write-json webfinger out))))
|
|
|
|
(define compiler-rules
|
|
(set compile-index-json
|
|
compile-webfinger))
|
|
|
|
(define ops (generate-operations compiler-rules))
|
|
(for ([op (in-list ops)])
|
|
(printf "executing ~s\n" op)
|
|
(execute-rule op))
|