Rename project to activity-servist

Slightly less wrong, feels slightly less redundant!

activity-servist.asd

@@ -0,0 +1,84 @@
+(require "asdf")
+
+
+(asdf:defsystem "activity-servist"
+  :version "0.0"
+  :license "AGPLv3"
+  :description "ActitivyPub federated server framework."
+  :author "Jaidyn Ann <jadedctrl@posteo.at>"
+  :homepage "https://hak.xwx.moe/jadedctrl/activity-servist"
+
+  :in-order-to ((test-op (test-op "activitypub/tests")))
+  :depends-on ("activity-servist/signatures"
+               "alexandria" "clack" "dexador"
+               "local-time"  "purl" "str" "webtentacle" "yason")
+  :components ((:file "src/activity-servist")))
+
+
+(asdf:defsystem "activity-servist/activity-vocabulary"
+  :version "0.0"
+  :license "AGPLv3"
+  :description "AP-S subpackage for handling ActivityVocabulary parsing/encoding."
+  :author "Jaidyn Ann <jadedctrl@posteo.at>"
+  :homepage "https://hak.xwx.moe/jadedctrl/activity-servist"
+
+  :in-order-to ((test-op (test-op "activitypub/tests/activity-vocabulary")))
+  :depends-on ("alexandria" "closer-mop" "str" "yason")
+  :components ((:file "src/activity-vocabulary")))
+
+
+(asdf:defsystem "activity-servist/signatures"
+  :version "0.0"
+  :license "AGPLv3"
+  :description "AP-S subpackage for handling HTTP signatures."
+  :author "Jaidyn Ann <jadedctrl@posteo.at>"
+  :homepage "https://hak.xwx.moe/jadedctrl/activity-servist"
+
+  :in-order-to ((test-op (test-op "activitypub/tests/signatures")))
+  :depends-on ("cl-base64" "flexi-streams" "inferior-shell" "ironclad" "str")
+  :components ((:file "src/signatures")))
+
+
+
+;;; Tests
+;;; —————————————————————————————————————
+(asdf:defsystem "activity-servist/tests/activity-vocabulary"
+  :version "0.0"
+  :license "AGPLv3"
+  :author "Jaidyn Ann <jadedctrl@posteo.at>"
+  :description "Tests for the the activity-servist/signatures package."
+
+  :depends-on (:activity-servist/activity-vocabulary :alexandria :lisp-unit2)
+  :components ((:file "t/activity-vocabulary")))
+
+
+(asdf:defsystem "activity-servist/tests/signatures"
+  :version "0.0"
+  :license "AGPLv3"
+  :author "Jaidyn Ann <jadedctrl@posteo.at>"
+  :description "Tests for the the activity-servist/signatures package."
+
+  :depends-on (:activity-servist/signatures :lisp-unit2)
+  :components ((:file "t/signatures")))
+
+
+(asdf:defsystem "activity-servist/tests"
+  :version "0.0"
+  :license "AGPLv3"
+  :author "Jaidyn Ann <jadedctrl@posteo.at>"
+  :description "Tests for all activity-servist subpacakges."
+
+  :depends-on (:activity-servist/tests/activity-vocabulary
+               :activity-servist/tests/signatures
+               :alexandria :lisp-unit2)
+  :components ((:file "t/t")))
+
+;; Following method tweaked from lisp-unit2’s documentation:
+;; https://github.com/AccelerationNet/lisp-unit2/blob/master/README.md#asdf
+(defmacro define-asdf-testing (package)
+  `(defmethod asdf:perform ((o asdf:test-op) (c (eql (asdf:find-system ',package))))
+     (eval (read-from-string (format nil "(~A:run-with-summary)" ',package)))))
+
+(define-asdf-testing activity-servist/tests/activity-vocabulary)
+(define-asdf-testing activity-servist/tests/signatures)
+(define-asdf-testing activity-servist/tests)

activitypub-servist.asd

@@ -1,46 +0,0 @@
-(require "asdf")
-
-
-(asdf:defsystem "activitypub-servist"
-  :version "0.0"
-  :license "AGPLv3"
-  :description "ActitivyPub federated server framework."
-  :author "Jaidyn Ann <jadedctrl@posteo.at>"
-  :homepage "https://hak.xwx.moe/jadedctrl/activitypub-servist"
-
-  :depends-on ("activitypub-servist/signatures"
-               "alexandria" "clack" "dexador"
-               "local-time"  "purl" "str" "webtentacle" "yason")
-  :components ((:file "src/activitypub-servist")))
-
-
-(asdf:defsystem "activitypub-servist/signatures"
-  :version "0.0"
-  :license "AGPLv3"
-  :description "AP-S subpackage for handling HTTP signatures."
-  :author "Jaidyn Ann <jadedctrl@posteo.at>"
-  :homepage "https://hak.xwx.moe/jadedctrl/activitypub-servist"
-
-  :depends-on ("cl-base64" "flexi-streams" "inferior-shell" "ironclad" "str")
-  :components ((:file "src/signatures")))
-
-
-
-;;; Tests
-;;; —————————————————————————————————————
-(asdf:defsystem "activitypub-servist/tests/signatures"
-  :version "0.0"
-  :license "AGPLv3"
-  :author "Jaidyn Ann <jadedctrl@posteo.at>"
-  :description "Tests for the the activitypub-servist/signatures package."
-
-  :depends-on (:activitypub-servist/signatures :lisp-unit2)
-  :components ((:file "t/signatures")))
-
-;; Following method tweaked from lisp-unit2’s documentation:
-;; https://github.com/AccelerationNet/lisp-unit2/blob/master/README.md#asdf
-(defmethod asdf:perform
-    ((o asdf:test-op) (c (eql (asdf:find-system :activitypub-servist/tests/signatures))))
-  (eval (read-from-string
-         "(lisp-unit2:with-summary ()
-            (lisp-unit2:run-tests :package :activitypub-servist/tests/signatures))")))

src/activity-vocabulary.lisp

@@ -15,9 +15,9 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
 
-(defpackage #:activitypub-servist/activity-vocabulary
+(defpackage #:activity-servist/activity-vocabulary
   (:use #:cl)
-  (:nicknames "AP-S/AV" "AV")
+  (:nicknames "AS/AV" "ACTIVITY-VOCABULARY")
   (:shadow #:delete #:ignore #:listen #:read #:remove)
   ;; One should never USE this package, since some class-names shadow
   ;; core Common Lisp symbols! Beware! :P
@@ -58,7 +58,7 @@
    :relationship-object :relationship-relationship :relationship-subject
    :tombstone-former-type :tombstone-deleted))
 
-(in-package #:activitypub-servist/activity-vocabulary)
+(in-package #:activity-servist/activity-vocabulary)
 
 
 
@@ -129,7 +129,7 @@ This returns a function to create a quoted function that should be called for ea
 again and again, by YASON:ENCODE-SLOTS."
   (lambda (slot-key-pair)
     `(let ((key   ',(car slot-key-pair))
-           (value (slot-value obj ',(car slot-key-pair))))
+           (value (ignore-errors (slot-value obj ',(car slot-key-pair)))))
        (cond ((eq key '@context) ; Encoded in YASON:ENCODE-OBJECT using *@context*
               (setq *@context* (merge-@contexts *@context* value)))
              ((eq key 'type)     ; Encode type based on class-name or TYPE slot
@@ -143,17 +143,20 @@ again and again, by YASON:ENCODE-SLOTS."
 
 ;;; Core types
 ;;; ————————————————————————————————————————
+(defclass as-object ()
+  ((@context :initform "https://www.w3.org/ns/activitystreams")
+   (type     :accessor object-type)))
+
 ;; https://www.w3.org/ns/activitystreams#Object
-(defclass-w-accessors object ()
+(defclass-w-accessors object (as-object)
   (
    attachment attributed-to audience bcc bto cc content context
    duration end-time generator icon id image in-reply-to location
    media-type name preview published replies start-time summary
-   tag to type updated url
+   tag to updated url))
-   (@context :initform "https://www.w3.org/ns/activitystreams")))
 
 ;; https://www.w3.org/ns/activitystreams#Link
-(defclass-w-accessors link ()
+(defclass-w-accessors link (as-object)
   (height href hreflang media-type name preview rel width))
 
 ;; https://www.w3.org/ns/activitystreams#Activity
@@ -169,14 +172,17 @@ again and again, by YASON:ENCODE-SLOTS."
   (current first items last total-items))
 
 ;; https://www.w3.org/ns/activitystreams#OrderedCollection
-(defclass ordered-collection (collection) ())
+;; Funnily enough, “orderedItems” is actually a ghost! It’s only *implied*. :-P
+;; https://jam.xwx.moe/notice/AjE1LkpLoBvWmDUmK8
+(defclass-w-accessors ordered-collection (collection)
+  (ordered-items))
 
 ;; https://www.w3.org/ns/activitystreams#CollectionPage
 (defclass-w-accessors collection-page (collection)
   (next part-of prev))
 
 ;; https://www.w3.org/ns/activitystreams#OrderedCollectionPage
-(defclass-w-accessors ordered-collection-page (collection-page)
+(defclass-w-accessors ordered-collection-page (collection-page ordered-collection)
   (start-index))
 
 
@@ -244,11 +250,11 @@ again and again, by YASON:ENCODE-SLOTS."
 
 (defun parse-table (table)
   "Parse a hash-table corresponding to YASON-parsed JSON into an ActivityPub object."
-  (let* ((class (car (find-registered-classes (gethash "type" table))))
+  (let* ((class (car (find-registered-classes (param-case (gethash "type" table)))))
          (obj   (make-instance class)))
     (loop for key being each hash-key of table
           for val being each hash-value of table
-          do (let ((slot-sym (car (find-registered-symbols key)))
+          do (let ((slot-sym (car (find-registered-symbols (param-case key))))
                    (val      (parse-value val)))
                (when slot-sym
                  (setf (slot-value obj slot-sym) val))))
@@ -279,11 +285,11 @@ into one. Otherwise, parse it into an associative list."
 ;;; JSON serialization
 ;;; ————————————————————————————————————————
 ;; Note-worthy: See the above-defined DEFINE-YASON-ENCODE-SLOTS.
-(defmethod yason:encode ((obj object) &optional (stream *standard-output*))
+(defmethod yason:encode ((obj as-object) &optional (stream *standard-output*))
   (yason:with-output (stream)
     (yason:encode-object obj)))
 
-(defmethod yason:encode-object ((obj object))
+(defmethod yason:encode-object ((obj as-object))
   (typecase *@context*
     (null   ; If this is the top-level (non-nested) object, establish a @context.
      (let ((*@context* 'top-level))
@@ -324,15 +330,35 @@ containing both of their elements."
 ;;; Util
 ;;; ————————————————————————————————————————
 (defun camel-case (string)
+  "Convert a STRING to camel-casing. That is, casingLikeThis.
+Wrapper around STR:CAMEL-CASE, working around a bug that a non-alphanumeric
+character at the start of the string gets erroneously (or at least undesireably,
+to us) removed."
+  (keep-nonalphanumeric-prefix string
+                               (str:camel-case string)))
+
+(defun param-case (string)
+  "Convert a STRING to param-casing. That is, casing-like-this.
+Wrapper around STR:PARAM-CASE, working around a bug that a non-alphanumeric
+character at the start of the string gets erroneously (or at least undesireably,
+to us) removed."
+  (keep-nonalphanumeric-prefix string
+                               (str:param-case string)))
+(defun camel-case (str)
   "Convert a STRING to camel-casing.
 Wrapper around STR:CAMEL-CASE, working around a bug that a non-alphanumeric
 character at the start of the string gets erroneously (or at least undesireably,
 to us) removed."
-  (if (not (alphanumericp (aref string 0)))
+  (keep-nonalphanumeric-prefix str (str:camel-case str)))
+
+(defun keep-nonalphanumeric-prefix (str child-str)
+  "This ensures that a CHILD-STR derived from STR has the same nonalphanumeric
+prefix as STR, as some functions like to remove such prefixes."
+  (if (not (alphanumericp (aref str 0)))
       (concatenate 'string
-                   (string (aref string 0))
+                   (string (aref str 0))
-                   (str:camel-case string))
+                   child-str)
-      (str:camel-case string)))
+      child-str))
 
 (defun class-pretty-name (class)
   "Return a CLASS’es name in a “pretty” (sentence-capitalized) string."
@@ -384,5 +410,6 @@ COLLECTION-AGAIN would return:
           (closer-mop:finalize-inheritance class)
           (eval `(define-yason-encode-slots ,class)))
         (mapcar #'find-class
-                '(object link activity collection collection-page
+                '(as-object object link activity collection collection-page
-                  ordered-collection-page place profile relationship tombstone)))
+                  ordered-collection ordered-collection-page place profile
+                  relationship tombstone)))

src/activitypub-servist.lisp

@@ -1,4 +1,4 @@
-;;;; activitypub-servist: An ActivityPub server framework.
+;;;; activity-servist: An ActivityPub server framework.
 
 ;; Copyright © 2023-2024 Jaidyn Levesque <jadedctrl@posteo.at>
 ;;
@@ -15,12 +15,12 @@
 ;; You should have received a copy of the GNU Affero General Public License
 ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
 
-(defpackage #:activitypub-servist
+(defpackage #:activity-servist
-  (:use #:cl #:activitypub-servist/signatures)
+  (:use #:cl #:activity-servist/signatures)
-  (:nicknames "AP-S")
+  (:nicknames "AS")
   (:export :server :start-server))
 
-(in-package #:activitypub-servist)
+(in-package #:activity-servist)
 
 
 (defun users ()
@@ -146,7 +146,7 @@ the plist in the docstring for its WEBTENTACLE:SERVER function."
          ("inbox" . ,(str:concat user-root "/inbox"))
          ("outbox" . ,(str:concat user-root  "/outbox"))
          ("discoverable" . t)
-         ("summary" . "Mi estas simpla roboto, kiu montras ke iomete ekfunkcias activitypub-servist.
+         ("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"

src/signatures.lisp

@@ -1,4 +1,4 @@
-;;;; activitypub-servist/signatures: Handle AP-compatible HTTP signatures.
+;;;; activity-servist/signatures: Handle AP-compatible HTTP signatures.
 
 ;; Copyright © 2023-2024 Jaidyn Levesque <jadedctrl@posteo.at>
 ;;
@@ -15,14 +15,14 @@
 ;; You should have received a copy of the GNU Affero General Public License
 ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
 
-(defpackage #:activitypub-servist/signatures
+(defpackage #:activity-servist/signatures
   (:use #:cl)
-  (:nicknames "AP-S/S")
+  (:nicknames "AS/S")
   (:export :generate-key-pair
            :sign-string :import-pem-key-pair
            :digest-string :string-sha256sum))
 
-(in-package #:activitypub-servist/signatures)
+(in-package #:activity-servist/signatures)
 
 
 ;;; Key creation/parsing

t/activity-vocabulary.lisp

@@ -0,0 +1,93 @@
+;;;; activity-servist/tests/activity-vocabulary: Testing activity-vocabulary.
+
+;; Copyright © 2024 Jaidyn Levesque <jadedctrl@posteo.at>
+;;
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU Affero General Public License
+;; as published by the Free Software Foundation, either version 3 of
+;; the License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU Affero General Public License for more details.
+;;
+;; You should have received a copy of the GNU Affero General Public License
+;; along with this program. If not, see <https://www.gnu.org/licenses/>.
+
+(defpackage :activity-servist/tests/activity-vocabulary
+  (:use :cl :lisp-unit2)
+  (:nicknames "AS/T/AV")
+  (:export :run :run-with-summary))
+
+(in-package :activity-servist/tests/activity-vocabulary)
+
+(defun run ()
+  "Run all ACTIVITY-VOCABULARY tests."
+  (lisp-unit2:run-tests :package :activity-servist/tests/activity-vocabulary))
+
+(defun run-with-summary ()
+  "Run tests with summary for ACTIVITY-VOCABULARY."
+  (lisp-unit2:with-summary()
+    (run)))
+
+
+
+;;; Util
+;;; ————————————————————————————————————————
+(defmacro relative-pathname (path)
+  "Return an absolute path adding the relative PATH to the system’s path."
+  `(asdf:system-relative-pathname :activity-servist/tests/activity-vocabulary ,path))
+
+(defmacro define-json-test (path tags)
+  "Define a lisp-unit2 test for parsing of the given JSON file.
+We compare the original JSON to that of the parsed-then-reserialized JSON,
+ensuring they are semantically equivalent. White-space and key order are ignored."
+  (let ((content (alexandria:read-file-into-string (relative-pathname path))))
+    `(define-test ,(intern (string-upcase (pathname-name path))) (:tags ,tags)
+       (assert-equal
+        (hash-table-sorted-alist
+         (yason:parse ,content))
+        (hash-table-sorted-alist
+         (yason:parse
+          (yason:with-output-to-string* ()
+            (yason:encode-object
+             (as/av:parse ,content)))))))))
+
+(defun sort-alist (alist predicate)
+  "Sort an associative list by its keys."
+  (sort alist
+        (lambda (cell-a cell-b)
+          (apply predicate (list (car cell-a) (car cell-b))))))
+
+(defun ensure-list (item)
+  "Ensure ITEM is either a list or the sole member of a new list."
+  (if (listp item)
+      item
+      (list item)))
+
+(defun hash-table-sorted-alist (table &optional (predicate #'string<))
+  "Return a sorted associative list containing the keys and values of TABLE.
+Any nested hash-tables found as values are also sorted, recursively."
+  (sort-alist
+   (mapcar (lambda (cell)
+             (cons (car cell)
+                   (mapcar (lambda (cell-item)
+                             (if (hash-table-p cell-item)
+                                 (hash-table-sorted-alist cell-item)
+                                 cell-item))
+                           (ensure-list (cdr cell)))))
+           (alexandria:hash-table-alist table))
+   predicate))
+
+
+
+;;; Test definitions
+;;; ————————————————————————————————————————
+;; Define a test for each ActivityVocabulary type’s example JSON.
+;; Examples are taken from the spec:
+;;   https://www.w3.org/TR/activitystreams-vocabulary/
+(mapcar (lambda (file)
+          (eval `(define-json-test ,file '(:core))))
+        (uiop:directory-files
+         (relative-pathname "t/activity-vocabulary/core/")))

t/activity-vocabulary/core/activity.json

@@ -0,0 +1,13 @@
+{
+	"@context": "https://www.w3.org/ns/activitystreams",
+	"type": "Activity",
+	"summary": "Sally did something to a note",
+	"actor": {
+		"type": "Person",
+		"name": "Sally"
+	},
+	"object": {
+		"type": "Note",
+		"name": "A Note"
+	}
+}

t/activity-vocabulary/core/collection-page.json

@@ -0,0 +1,17 @@
+{
+	"@context": "https://www.w3.org/ns/activitystreams",
+	"summary": "Page 1 of Sally's notes",
+	"type": "CollectionPage",
+	"id": "http://example.org/foo?page=1",
+	"partOf": "http://example.org/foo",
+	"items": [
+		{
+			"type": "Note",
+			"name": "A Simple Note"
+		},
+		{
+			"type": "Note",
+			"name": "Another Simple Note"
+		}
+	]
+}

t/activity-vocabulary/core/collection.json

@@ -0,0 +1,16 @@
+{
+	"@context": "https://www.w3.org/ns/activitystreams",
+	"summary": "Sally's notes",
+	"type": "Collection",
+	"totalItems": 2,
+	"items": [
+		{
+			"type": "Note",
+			"name": "A Simple Note"
+		},
+		{
+			"type": "Note",
+			"name": "Another Simple Note"
+		}
+	]
+}

t/activity-vocabulary/core/intransitive-activity.json

@@ -0,0 +1,13 @@
+{
+	"@context": "https://www.w3.org/ns/activitystreams",
+	"type": "Travel",
+	"summary": "Sally went to work",
+	"actor": {
+		"type": "Person",
+		"name": "Sally"
+	},
+	"target": {
+		"type": "Place",
+		"name": "Work"
+	}
+}

t/activity-vocabulary/core/link.json

@@ -0,0 +1,8 @@
+{
+	"@context": "https://www.w3.org/ns/activitystreams",
+	"type": "Link",
+	"href": "http://example.org/abc",
+	"hreflang": "en",
+	"mediaType": "text/html",
+	"name": "An example link"
+}

t/activity-vocabulary/core/object.json

@@ -0,0 +1,6 @@
+{
+	"@context": "https://www.w3.org/ns/activitystreams",
+	"type": "Object",
+	"id": "http://www.test.example/object/1",
+	"name": "A Simple, non-specific object"
+}

t/activity-vocabulary/core/ordered-collection-page.json

@@ -0,0 +1,17 @@
+{
+	"@context": "https://www.w3.org/ns/activitystreams",
+	"summary": "Page 1 of Sally's notes",
+	"type": "OrderedCollectionPage",
+	"id": "http://example.org/foo?page=1",
+	"partOf": "http://example.org/foo",
+	"orderedItems": [
+		{
+			"type": "Note",
+			"name": "A Simple Note"
+		},
+		{
+			"type": "Note",
+			"name": "Another Simple Note"
+		}
+	]
+}

t/activity-vocabulary/core/ordered-collection.json

@@ -0,0 +1,16 @@
+{
+	"@context": "https://www.w3.org/ns/activitystreams",
+	"summary": "Sally's notes",
+	"type": "OrderedCollection",
+	"totalItems": 2,
+	"orderedItems": [
+		{
+			"type": "Note",
+			"name": "A Simple Note"
+		},
+		{
+			"type": "Note",
+			"name": "Another Simple Note"
+		}
+	]
+}

t/signatures.lisp

@@ -1,4 +1,4 @@
-;;;; activitypub-servist/tests/signatures: Testing activitypub-servist/signatures.
+;;;; activity-servist/tests/signatures: Testing activity-servist/signatures.
 
 ;; Copyright © 2024 Jaidyn Levesque <jadedctrl@posteo.at>
 ;;
@@ -15,13 +15,27 @@
 ;; You should have received a copy of the GNU Affero General Public License
 ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
 
-(defpackage :activitypub-servist/tests/signatures
+(defpackage :activity-servist/tests/signatures
-  (:use :cl :lisp-unit2))
+  (:use :cl :lisp-unit2)
+  (:nicknames "AS/T/S")
+  (:export :run :run-with-summary))
 
-(in-package :activitypub-servist/tests/signatures)
+(in-package :activity-servist/tests/signatures)
+
+(defun run ()
+  "Run all SIGNATURES tests."
+  (lisp-unit2:run-tests :package :activity-servist/tests/signatures))
+
+(defun run-with-summary ()
+  "Run tests with summary for SIGNATURES."
+  (lisp-unit2:with-summary()
+    (run)))
 
 
+
+;;; Test definitions
+;;; ————————————————————————————————————————
 (define-test string-sha256sum (:tags '(misc))
   (assert-equal
    "erws/VxJ7XO5xQBqpwHIUwG0P4q1Ek2D4N053+E2Ib8="
-   (ap-s/s::string-sha256sum "This is a testing string~! ♥ ĉu ne?~")))
+   (as/s::string-sha256sum "This is a testing string~! ♥ ĉu ne?~")))