Use LitePub for user-class in example server

Now that LitePub has its own classes (rather than
modifying those of Activity-Vocabulary), this is
necessary.

docs/examples/simple-server.lisp

@@ -16,7 +16,8 @@
   (:export :start-server :seed)
   ;; Note that we use a nickname for the ActivityStreams vocab!
   ;; I recommend doing likewise; save yourself some typing!
-  (:local-nicknames (:as :activity-servist/vocab/activity)))
+  (:local-nicknames (:ass :activity-servist/vocab/activity)
+                    (:lp :activity-servist/vocab/litepub)))
 
 (in-package #:activitypub-example)
 
@@ -26,11 +27,12 @@
 (defvar *store* (make-hash-table :test #'equal)
   "Our “object-store” — stores all ActivityPub objects, mapped by their IRI @ID.")
 
-(defvar *config* '(:address "localhost" :protocol "http" :port 8080 :fetch fetch))
+(defvar *config*
+  '(:host "http://localhost:8080" :address "127.0.0.1" :port 8080 :fetch fetch))
 
-(defvar *user-id-format* "~A://~A/users/~A"
+(defvar *user-id-format* "~A/users/~A"
   "The format we use for user’s @IDs/URIs.
-The first parameter is the protocol, the second the host, and the third the username.
+The first parameter is the protocol+host, and the second is the username.
 For example: “https://localhost:8080/users/lena”.")
 
 
@@ -91,15 +93,16 @@ That is, an “acct:username@host.tld” URI."
     (destructuring-bind (user host)
         (str:split "@" sans-preceding-@)
       (format nil *user-id-format*
-              (host-scheme host) host user))))
+              (host-w-scheme host) user))))
 
-(defun host-scheme (hostname)
-  "Helper-function for ACCT-URI->ID. Returns the expected protocol of a hostname.
-If it’s our configured :ADDRESS (in *CONFIG*), then return *CONFIG*’s :PROTOCOL.
+(defun host-w-scheme (hostname)
+  "Helper-function for ACCT-URI->ID. From a hostname, returns “scheme://hostname”.
+If it matches our configured :HOST (in *CONFIG*), simply returns :HOST’s value.
 Otherwise, assume “https”."
-  (if (equal (getf *config* :address) hostname)
-      (getf *config* :protocol)
-      "https"))
+  (let ((our-host (getf *config* :host)))
+    (if (equal (quri:uri-host (quri:uri our-host)) hostname)
+        our-host
+        (format nil "https://~A" hostname))))
 
 
 
@@ -113,7 +116,7 @@ Otherwise, assume “https”."
 
 ;;; Users
 ;;; ————————————————————————————————————————
-(defclass user (as:person)
+(defclass user (ass:person lp:object)
   ((inbox
     :accessor user-inbox
     :initform nil
@@ -136,15 +139,13 @@ Otherwise, assume “https”."
 The ID and ENDPOINTS are derived using the parameter USERNAME and the global *USER-ID-FORMAT*."
   (let ((obj (make-instance 'user))
         (uri (format nil *user-id-format*
-                     (getf *config* :protocol)
-                     (getf *config* :address)
-                     username)))
+                     (getf *config* :host) username)))
     (flet ((sub-uri (path)
              (format nil "~A/~A" uri path)))
-      (setf (as:name obj)      username)
+      (setf (ass:name obj)      username)
       (setf (json-ld:@id obj)  uri)
-      (setf (as:inbox obj)     (sub-uri "inbox"))
-      (setf (as:outbox obj)    (sub-uri "outbox"))
-      (setf (as:following obj) (sub-uri "following"))
-      (setf (as:followers obj) (sub-uri "followers")))
+      (setf (ass:inbox obj)     (sub-uri "inbox"))
+      (setf (ass:outbox obj)    (sub-uri "outbox"))
+      (setf (ass:following obj) (sub-uri "following"))
+      (setf (ass:followers obj) (sub-uri "followers")))
    obj))

src/activity-servist.lisp

@@ -29,12 +29,12 @@
 
 ;;; Globals
 ;;; ————————————————————————————————————————
-(defvar *config* '(:address "localhost" :port 8080 :protocol "https")
+(defvar *config* '(:host "http://localhost:8080" :address "127.0.0.1" :port 8080)
   "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.
+• :HOST, the public-facing URI of the server.
+• :ADDRESS, the address the server is exposed on.
+• :PORT, the port the server is exposed on.
 
 There is one required property:
 • :FETCH, a function used as a callback by activity-servist.
@@ -43,20 +43,11 @@ There is one required property:
 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."
-  '("servistchjo"))
-
-(defun userhosts ()
-  "List of the server's usernames + hostname."
-  (mapcar (lambda (username) (str:concat username "@" "etc.xwx.moe"))
-          (users)))
-
 (defun directories ()
   "Alist of the server's paths and their response functions."
-  '(("u/" . http-user-dir)
-    (".well-known/webfinger" . http-webfinger)
-    (".well-known/host-meta" . http-host-meta)))
+  '((".well-known/webfinger" . http-webfinger)
+    (".well-known/host-meta" . http-host-meta)
+    (""                      . http-object)))  ; By default, assume object.
 
 (defvar *privkey*
   (alexandria:read-file-into-string
@@ -86,16 +77,12 @@ Returns the ActivityPub object associated with the given URI."
     (,(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=\""
-                  (getf *config* :protocol)
-                  "://"
-                  (getf *config* :address)
+                  (getf *config* :host)
                   "/.well-known/webfinger?resource={uri}\"/>
 </XRD>
 "))))
 
 
-
-
 
 ;;; Webfinger response
 ;;; ————————————————————————————————————————
@@ -132,55 +119,19 @@ For information on the property-list’s format, see the dosctring of WEBTENTACL
 
 
 
-;;; User info response(s)
+;;; Object requests
 ;;; ————————————————————————————————————————
-(defun http-user-dir (env path-items params)
-  "Respond to requests within the /u/* directory."
-  (let ((user (car path-items)))
-    ;; In case of request for the user's actor.
-    (if (member user (users) :test 'equal)
-        `(200 (:content-type "application/activity+json")
-              (,(user-actor env user))))))
-
-(defun user-actor (config username)
-  "The JSON of a user's actor."
-  (let* ((user-root
-           (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"
-                        "https://w3id.org/security/v1"
-                        "https://litepub.social/litepub/context.jsonld"))
-         ("endpoints" . ,(alexandria:plist-hash-table (list "sharedInbox" "https://etc.xwx.moe/inbox")))
-         ("url" . ,user-root)
-         ("id" . ,user-root)
-         ("type" . "Person")
-         ("preferredUsername" . ,username)
-         ("name" . "Servistiĉo")
-         ("inbox" . ,(str:concat user-root "/inbox"))
-         ("outbox" . ,(str:concat user-root  "/outbox"))
-         ("discoverable" . t)
-         ("summary" . "Mi estas simpla roboto, kiu montras ke iomete ekfunkcias activity-servist.
-… ĉu mi rajtas demeti la servistinan kostumon, nun?
-Mi ne estas knabino!!")
-         ("icon"
-          . ,(alexandria:plist-hash-table
-              (list
-               "type" "Image"
-               "url" "https://xwx.moe/etc/servisticho-profilbildo.jpg")))
-         ("image"
-          . ,(alexandria:plist-hash-table
-              (list
-               "type" "Image"
-               "url" "https://xwx.moe/etc/servisticho-standardo.png")))
-         ("publicKey"
-          . ,(alexandria:plist-hash-table
-              (list
-               "id" (str:concat user-root "#main-key")
-               "owner" user-root
-               "publicKeyPem" *pubkey*))))))))
+(defun http-object (env path-items params)
+  "If an ActivityPub object is requested, serve it (if such an object
+can be found). Uses the callback :FETCH, defined in *CONFIG*."
+  (let* ((uri (reduce (lambda (a b) (format nil "~A/~A" a b))
+                     (append (list (getf *config* :host)) path-items)))
+         (obj (fetch uri)))
+    (if obj
+        (list 200 '(:content-type "application/json")
+              (list (yason:with-output-to-string* () (yason:encode-object obj))))
+        `(400 (:content-type "text/plain")
+          ("Such an object doesn’t exist!")))))