docs/examples/simple-server.lisp

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

src/activity-servist.lisp

@@ -29,12 +29,12 @@
 
 ;;; Globals
 ;;; ————————————————————————————————————————
-(defvar *config* '(:host "http://localhost:8080" :address "127.0.0.1" :port 8080)
+(defvar *config* '(:address "localhost" :port 8080 :protocol "https")
   "Configuration for the server, a property-list.
 There are three optional properties:
-• :HOST, the public-facing URI of the server.
+• :PROTOCOL, either “https” or “http” (the latter for testing, only!).
-• :ADDRESS, the address the server is exposed on.
+• :ADDRESS, the server’s domain-name/address.
-• :PORT, the port the server is exposed on.
+• :PORT, the server’s port.
 
 There is one required property:
 • :FETCH, a function used as a callback by activity-servist.
@@ -43,11 +43,20 @@ 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."
-  '((".well-known/webfinger" . http-webfinger)
+  '(("u/" . http-user-dir)
-    (".well-known/host-meta" . http-host-meta)
+    (".well-known/webfinger" . http-webfinger)
-    (""                      . http-object)))  ; By default, assume object.
+    (".well-known/host-meta" . http-host-meta)))
 
 (defvar *privkey*
   (alexandria:read-file-into-string
@@ -77,12 +86,16 @@ 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* :host)
+                  (getf *config* :protocol)
+                  "://"
+                  (getf *config* :address)
                   "/.well-known/webfinger?resource={uri}\"/>
 </XRD>
 "))))
 
 
+
+
 
 ;;; Webfinger response
 ;;; ————————————————————————————————————————
@@ -119,19 +132,55 @@ For information on the property-list’s format, see the dosctring of WEBTENTACL
 
 
 
-;;; Object requests
+;;; User info response(s)
 ;;; ————————————————————————————————————————
-(defun http-object (env path-items params)
+(defun http-user-dir (env path-items params)
-  "If an ActivityPub object is requested, serve it (if such an object
+  "Respond to requests within the /u/* directory."
-can be found). Uses the callback :FETCH, defined in *CONFIG*."
+  (let ((user (car path-items)))
-  (let* ((uri (reduce (lambda (a b) (format nil "~A/~A" a b))
+    ;; In case of request for the user's actor.
-                     (append (list (getf *config* :host)) path-items)))
+    (if (member user (users) :test 'equal)
-         (obj (fetch uri)))
+        `(200 (:content-type "application/activity+json")
-    (if obj
+              (,(user-actor env user))))))
-        (list 200 '(:content-type "application/json")
+
-              (list (yason:with-output-to-string* () (yason:encode-object obj))))
+(defun user-actor (config username)
-        `(400 (:content-type "text/plain")
+  "The JSON of a user's actor."
-          ("Such an object doesn’t exist!")))))
+  (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*))))))))