activity-servist.asd

@@ -1,84 +0,0 @@
-(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

@@ -0,0 +1,46 @@
+(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 #:activity-servist/activity-vocabulary
+(defpackage #:activitypub-servist/activity-vocabulary
   (:use #:cl)
-  (:nicknames "AS/AV" "ACTIVITY-VOCABULARY")
+  (:nicknames "AP-S/AV" "AV")
   (: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 #:activity-servist/activity-vocabulary)
+(in-package #:activitypub-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 (ignore-errors (slot-value obj ',(car slot-key-pair)))))
+           (value (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,20 +143,17 @@ 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 (as-object)
+(defclass-w-accessors 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 updated url))
+   tag to type updated url
+   (@context :initform "https://www.w3.org/ns/activitystreams")))
 
 ;; https://www.w3.org/ns/activitystreams#Link
-(defclass-w-accessors link (as-object)
+(defclass-w-accessors link ()
   (height href hreflang media-type name preview rel width))
 
 ;; https://www.w3.org/ns/activitystreams#Activity
@@ -172,17 +169,14 @@ again and again, by YASON:ENCODE-SLOTS."
   (current first items last total-items))
 
 ;; https://www.w3.org/ns/activitystreams#OrderedCollection
-;; Funnily enough, “orderedItems” is actually a ghost! It’s only *implied*. :-P
+(defclass ordered-collection (collection) ())
-;; 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 ordered-collection)
+(defclass-w-accessors ordered-collection-page (collection-page)
   (start-index))
 
 
@@ -250,11 +244,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 (param-case (gethash "type" table)))))
+  (let* ((class (car (find-registered-classes (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 (param-case key))))
+          do (let ((slot-sym (car (find-registered-symbols key)))
                    (val      (parse-value val)))
                (when slot-sym
                  (setf (slot-value obj slot-sym) val))))
@@ -285,11 +279,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 as-object) &optional (stream *standard-output*))
+(defmethod yason:encode ((obj object) &optional (stream *standard-output*))
   (yason:with-output (stream)
     (yason:encode-object obj)))
 
-(defmethod yason:encode-object ((obj as-object))
+(defmethod yason:encode-object ((obj object))
   (typecase *@context*
     (null   ; If this is the top-level (non-nested) object, establish a @context.
      (let ((*@context* 'top-level))
@@ -330,35 +324,15 @@ 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."
-  (keep-nonalphanumeric-prefix str (str:camel-case str)))
+  (if (not (alphanumericp (aref string 0)))
-
-(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 str 0))
+                   (string (aref string 0))
-                   child-str)
+                   (str:camel-case string))
-      child-str))
+      (str:camel-case string)))
 
 (defun class-pretty-name (class)
   "Return a CLASS’es name in a “pretty” (sentence-capitalized) string."
@@ -410,6 +384,5 @@ COLLECTION-AGAIN would return:
           (closer-mop:finalize-inheritance class)
           (eval `(define-yason-encode-slots ,class)))
         (mapcar #'find-class
-                '(as-object object link activity collection collection-page
+                '(object link activity collection collection-page
-                  ordered-collection ordered-collection-page place profile
+                  ordered-collection-page place profile relationship tombstone)))
-                  relationship tombstone)))

src/activitypub-servist.lisp

@@ -1,4 +1,4 @@
-;;;; activity-servist: An ActivityPub server framework.
+;;;; activitypub-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 #:activity-servist
+(defpackage #:activitypub-servist
-  (:use #:cl #:activity-servist/signatures)
+  (:use #:cl #:activitypub-servist/signatures)
-  (:nicknames "AS")
+  (:nicknames "AP-S")
   (:export :server :start-server))
 
-(in-package #:activity-servist)
+(in-package #:activitypub-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 activity-servist.
+         ("summary" . "Mi estas simpla roboto, kiu montras ke iomete ekfunkcias activitypub-servist.
 … ĉu mi rajtas demeti la servistinan kostumon, nun?
 Mi ne estas knabino!!")
          ("icon"

src/signatures.lisp

@@ -1,4 +1,4 @@
-;;;; activity-servist/signatures: Handle AP-compatible HTTP signatures.
+;;;; activitypub-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 #:activity-servist/signatures
+(defpackage #:activitypub-servist/signatures
   (:use #:cl)
-  (:nicknames "AS/S")
+  (:nicknames "AP-S/S")
   (:export :generate-key-pair
            :sign-string :import-pem-key-pair
            :digest-string :string-sha256sum))
 
-(in-package #:activity-servist/signatures)
+(in-package #:activitypub-servist/signatures)
 
 
 ;;; Key creation/parsing

t/activity-vocabulary.lisp

@@ -1,93 +0,0 @@
-;;;; 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

@@ -1,13 +0,0 @@
-{
-	"@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

@@ -1,17 +0,0 @@
-{
-	"@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

@@ -1,16 +0,0 @@
-{
-	"@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

@@ -1,13 +0,0 @@
-{
-	"@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

@@ -1,8 +0,0 @@
-{
-	"@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

@@ -1,6 +0,0 @@
-{
-	"@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

@@ -1,17 +0,0 @@
-{
-	"@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

@@ -1,16 +0,0 @@
-{
-	"@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 @@
-;;;; activity-servist/tests/signatures: Testing activity-servist/signatures.
+;;;; activitypub-servist/tests/signatures: Testing activitypub-servist/signatures.
 
 ;; Copyright © 2024 Jaidyn Levesque <jadedctrl@posteo.at>
 ;;
@@ -15,27 +15,13 @@
 ;; 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/signatures
+(defpackage :activitypub-servist/tests/signatures
-  (:use :cl :lisp-unit2)
+  (:use :cl :lisp-unit2))
-  (:nicknames "AS/T/S")
-  (:export :run :run-with-summary))
 
-(in-package :activity-servist/tests/signatures)
+(in-package :activitypub-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="
-   (as/s::string-sha256sum "This is a testing string~! ♥ ĉu ne?~")))
+   (ap-s/s::string-sha256sum "This is a testing string~! ♥ ĉu ne?~")))