Add FETCH, and Webfinger data from JSON-objects

Now, Webfinger data is generated from JSON-LD
objects in an overridable fashion (methods).

Also defines the callback FETCH, which should be
defined by the user of activity-servist.

activity-servist.asd

@@ -9,7 +9,7 @@
   :homepage "https://hak.xwx.moe/jadedctrl/activity-servist"
 
   :in-order-to ((test-op (test-op "activitypub/tests")))
-  :depends-on (:activity-servist/signatures
+  :depends-on (:activity-servist/vocab/activity :activity-servist/signatures
                :alexandria :clack :dexador
                :local-time  :purl :str :webtentacle :yason)
   :components ((:file "src/activity-servist")))

src/activity-servist.lisp

@@ -17,11 +17,31 @@
 
 (defpackage #:activity-servist
   (:use #:cl #:activity-servist/signatures)
-  (:nicknames "AS")
+  (:nicknames "AS" "ACTIVITYPUB")
-  (:export :server :start-server))
+  (:export
+   ;; Functions
+   :server :start-server
+   ;; Globals
+   *config*))
 
 (in-package #:activity-servist)
 
+
+;;; Globals
+;;; ————————————————————————————————————————
+(defvar *config* '(:address "localhost" :port 8080 :protocol "https")
+  "Configuration for the server, a property-list.
+There are three optional properties:
+• :PROTOCOL, either “https” or “http” (the latter for testing, only!).
+• :ADDRESS, the server’s domain-name/address.
+• :PORT, the server’s port.
+
+There is one required property:
+• :FETCH, a function used as a callback by activity-servist.
+
+:FETCH should be a function of (FETCH URI)
+This function should simply return an object from your storage, queried by a URI.
+The URI parameter is going to be either an @ID or an account-URI of the form “acct:username@hostname”.")
 
 (defun users ()
   "List of the server's usernames."
@@ -38,9 +58,24 @@
     (".well-known/webfinger" . http-webfinger)
     (".well-known/host-meta" . http-host-meta)))
 
+(defvar *privkey*
+  (alexandria:read-file-into-string
+   (asdf:system-relative-pathname :activity-servist #p"enc/privkey.pem")))
+(defvar *pubkey*
+  (alexandria:read-file-into-string
+   (asdf:system-relative-pathname :activity-servist #p"enc/pubkey.pem")))
 
-(defvar *privkey* (alexandria:read-file-into-string #p"../enc/privkey.pem"))
+
-(defvar *pubkey* (alexandria:read-file-into-string #p"../enc/pubkey.pem"))
+
+;;; Callbacks
+;;; ————————————————————————————————————————
+(defun fetch (uri)
+  "Runs the user-defined callback FETCH, as stored in *CONFIG*.
+Returns the ActivityPub object associated with the given URI."
+  (let ((func (getf *config* :fetch)))
+    (if func
+        (funcall func uri)
+        (error "No FETCH function found in ACTIVITY-SERVIST:*CONFIG*."))))
 
 
 
@@ -50,71 +85,50 @@
   `(200 (:content-type "application/xrd+xml; charset=utf-8")
     (,(str:concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>
 <XRD xmlns=\"http://docs.oasis-open.org/ns/xri/xrd-1.0\">
-<link rel=\"lrdd\" type=\"application/xrd+xml\" template=\"https://"
+<link rel=\"lrdd\" type=\"application/xrd+xml\" template=\""
-                  (getf env :domain)
+                  (getf *config* :protocol)
+                  "://"
+                  (getf *config* :address)
                   "/.well-known/webfinger?resource={uri}\"/>
 </XRD>
 "))))
 
 
+
+
 
 ;;; Webfinger response
 ;;; ————————————————————————————————————————
 (defun http-webfinger (env path-items params)
-  (webtentacle:server env (lambda (resource) (resource-info-func resource)) nil))
+  (webtentacle:server env (lambda (resource) (webfinger-resource-info resource))))
 
-(defun resource-userhost (resource)
+(defun webfinger-resource-info (resource)
-  "Given an account URI in webfinger-friendly format, return the corresponding)))
+  "Given a Webfinger RESOURCE, return a property-list of data on the given resource.
-username and host in a list. Whether or not these are valid… that’s your
+Will "
-business!
+  (let ((obj (fetch resource)))
-Ex:  acct:mom@bird.com → '(“mom” “bird.com”)"
+    (and obj (webfinger-info resource obj))))
-  (cond
-    ;; A @bird@mom-style resource
-    ((str:containsp "@" resource)
-     (let* ((sans-acct (if (str:starts-with-p "acct:" resource)
-                           (subseq resource 5)
-                           resource))
-            (sans-@ (if (str:starts-with-p "@" sans-acct)
-                        (subseq sans-acct 1)
-                        sans-acct)))
-       (destructuring-bind (user host)
-           (str:split "@" sans-@)
-         (cons user host))))
-    ;; A URL-style resource
-    ((str:containsp "/u/" resource)
-     (cons
-      (pathname-name resource)
-      (purl:url-host resource)))))
 
-(defun resource-valid-p (resource)
+(defgeneric webfinger-info (resource obj)
-  "Given a webfinger-style “resource”"
+  (:documentation "Returns a property-list of Webfinger data on the given object.
-  (let* ((userhost (resource-userhost resource))
+Override this to provide custom Webfinger data; do what you please, but make sure RESOURCE is set as the :SUBJECT value.
-         (userhost-str (funcall #'str:concat (car userhost) "@" (cdr userhost))))
-   (member userhost-str (userhosts)
-           :test (lambda (a b)
-                   (string-equal (string-downcase a)
-                                 (string-downcase b))))))
 
-(defun resource-info-func (resource)
+For information on the property-list’s format, see the dosctring of WEBTENTACLE:SERVER."))
-  "Given a webfinger RESOURCE, return a property-list of data on the given user…
+
-if they exist, that is.
+;; A default implementation, which provides (likely) all of the information
-This is used by the WEBTENTACLE webfinger server; you can see information on
+;; necessary for most use-cases.
-the plist in the docstring for its WEBTENTACLE:SERVER function."
+(defmethod webfinger-info (resource (obj json-ld:object))
-  (let* ((userhost (resource-userhost resource))
+  (let ((obj-uri (json-ld:@id obj)))
-         (profile (str:concat "https://" (cdr userhost) "/u/" (car userhost))))
+    (list
-    (when (resource-valid-p resource)
+     :subject resource
-      (list
+     :aliases (list obj-uri)
-       :subject (str:concat "acct:" (car userhost) "@" (cdr userhost))
+     :links
-       :aliases `(,profile)
+     ;; Note: Doesn’t provide the os_status subscribe link.
-       :links
+     `((href ,obj-uri
-       `((href ,profile
+             rel "self"
-               rel  "self"
+             type "application/activity+json")
-               type "application/activity+json")
+       (href ,obj-uri
-         (href ,profile
+             rel "self"
-               rel "self"
+             type "application/ld+json; profile=\"https://www.w3.org/ns/activitystreams\"")))))
-               type "application/ld+json; profile=\"https://www.w3.org/ns/activitystreams\"")
-         (template ,(str:concat "https://" (cdr userhost) "/ostatus_subscribe?acct={uri}")
-                   rel "http://ostatus.org/schema/1.0/subscribe"))))))
 
 
 
@@ -130,8 +144,10 @@ the plist in the docstring for its WEBTENTACLE:SERVER function."
 
 (defun user-actor (config username)
   "The JSON of a user's actor."
-  (let* ((user-root (str:concat "https://" (getf config :domain) "/u/" username))
+  (let* ((user-root
-         (yason:*symbol-encoder* 'yason:encode-symbol-as-lowercase))
+           (str:concat (getf *config* :protocol) "://" (getf *config* :address) "/u/" username))
+         (yason:*symbol-encoder*
+           'yason:encode-symbol-as-lowercase))
     (yason:with-output-to-string* ()
       (yason:encode-alist
        `(("@context" . ("https://www.w3.org/ns/activitystreams"
@@ -244,10 +260,10 @@ Mi ne estas knabino!!")
 ;;; Invocation
 ;;; ————————————————————————————————————————
 (defun server (env)
-  "Returns the response data for Clack, given the request data `env`."
+  "Returns the response data for Clack, given the request property-list ENV."
-  (setq *logs* (append *logs* (list env (babel:octets-to-string (alexandria:read-stream-content-into-byte-vector (getf env :raw-body))))))
+  (nconc *logs* (list env (babel:octets-to-string (alexandria:read-stream-content-into-byte-vector (getf env :raw-body)))))
-  (let* ((path (pathname-sans-parameters (getf env :request-uri)))
+  (let* ((path   (pathname-sans-parameters (getf env :request-uri)))
-         (params (pathname-parameters (getf env :request-uri)))
+         (params (pathname-parameters      (getf env :request-uri)))
          (response-function
            (or (assoc-by-path (directories) (pathname-components path))
                '("" . http-404)))
@@ -259,13 +275,13 @@ Mi ne estas knabino!!")
     (or (funcall (cdr response-function) env path-sans-response-root params)
         (funcall 'http-404 env path-sans-response-root params))))
 
-(defun start-server (&optional (config '(:domain "localhost" :port 8080)))
+(defun start-server ()
   "Start the server."
   (clack:clackup (lambda (env)
-                   (server (append env config)))
+                   (server env))
                  :server 'woo
                  :address "0.0.0.0"
-                 :port (getf config :port)))
+                 :port (getf *config* :port)))