diff --git a/activity-servist.asd b/activity-servist.asd index cf0a34e..09fc1b2 100644 --- a/activity-servist.asd +++ b/activity-servist.asd @@ -10,8 +10,9 @@ :in-order-to ((test-op (test-op "activitypub/tests"))) :depends-on (:activity-servist/vocab/activity :activity-servist/signatures - :alexandria :clack :cl-date-time-parser :dexador :local-time - :purl :str :webtentacle :yason) + :activity-servist/util + :alexandria :clack :cl-date-time-parser :local-time :purl + :str :webtentacle :yason) :components ((:file "src/activity-servist"))) @@ -54,7 +55,8 @@ :author "Jaidyn Ann " :homepage "https://hak.xwx.moe/jadedctrl/activity-servist" - :depends-on (:alexandria :closer-mop :dexador :str :yason) + :depends-on (:activity-servist/util + :alexandria :closer-mop :quri :str :yason) :components ((:file "src/json-ld"))) @@ -69,6 +71,16 @@ :components ((:file "src/signatures"))) +(asdf:defsystem "activity-servist/util" + :version "0.0" + :license "AGPLv3" + :description "A-S subpackage for utility functions." + :author "Jaidyn Ann " + :homepage "https://hak.xwx.moe/jadedctrl/activity-servist" + + :depends-on (:drakma :flexi-streams) + :components ((:file "src/util"))) + ;;; Tests ;;; ————————————————————————————————————— diff --git a/src/activity-servist.lisp b/src/activity-servist.lisp index e517988..1daf8d3 100644 --- a/src/activity-servist.lisp +++ b/src/activity-servist.lisp @@ -1,6 +1,6 @@ ;;;; activity-servist: An ActivityPub server framework. -;; Copyright © 2023-2024 Jaidyn Levesque +;; Copyright © 2023-2025 Jaidyn Levesque ;; ;; This program is free software: you can redistribute it and/or ;; modify it under the terms of the GNU Affero General Public License @@ -118,10 +118,13 @@ this is solely used to store fetched foreign objects.")) ;; — The Mountain Goats, “Foreign Object” (2015) (defun fetch (obj-uri) - "Fetch & parse an ActivityPub object from a foreign server; returning the object" - (let ((json - (dexador:get obj-uri :headers '(("Accept" . "application/activity+json"))))) - (json-ld:parse json))) + "Fetch & parse an ActivityPub object from a foreign server; returning the object. +Will throw a FETCH-ERROR if the HTTP request fails." + (handler-case + (json-ld:parse (as/u:http-get obj-uri)) + (as/u:http-get-error (err) + (error 'fetch-error :status (slot-value err 'as/u:status) + :body (slot-value err 'as/u:body))))) (defun fetch-and-store (obj-uri) "Fetch & parses an ActivityPub object from a foreign server; then try to pass it @@ -139,6 +142,10 @@ Returns the object if it was retrieved or fetched; nil otherwise." (or (retrieve obj-uri) (fetch-and-store obj-uri))) +(define-condition fetch-error (error) + ((status :initarg :status) + (body :initarg :body)) + (:documentation "Thrown when we fail to fetch a resource, and get a non-2XX HTTP status code.")) ;;; Signature HTTP-header parsing @@ -481,8 +488,7 @@ the overloaded RECEIVE method." (defun send-note (inbox from to text) (let* ((json (note-json from to text)) (headers (note-headers inbox from to json))) - (dexador:post inbox :content json - :headers headers))) + nil)) diff --git a/src/json-ld.lisp b/src/json-ld.lisp index 2260693..286e45c 100644 --- a/src/json-ld.lisp +++ b/src/json-ld.lisp @@ -1,6 +1,6 @@ ;;;; json-λd: (Aspiring) parser and encoder for JSON-LD data -;; Copyright © 2024 Jaidyn Ann +;; Copyright © 2024-2025 Jaidyn Ann ;; ;; This program is free software: you can redistribute it and/or ;; modify it under the terms of the GNU Affero General Public License @@ -455,8 +455,7 @@ yet been parsed into CTX." (defun parse-remote-context (ctx uri) "Parse a remote JSON-LD context at URI, adding its terms to the CTX hash-table." - (let* ((headers '(("Accept" . "application/json,application/ld+json"))) - (str (caching-http-get uri :headers headers)) + (let* ((str (caching-http-get uri)) (parsed (yason:parse str))) (parse-context (gethash "@context" parsed) ctx))) @@ -641,7 +640,7 @@ defined in the context.")) ;;; Utility ;;; ———————————————————————————————————————— -(defun caching-http-get (uri &key headers) +(defun caching-http-get (uri &key (accept "application/json,application/ld+json")) "Makes a GET request to URI, returning the resultant string. Each resultant string is cached in the *HTTP-CACHE* global variable; if the same URI is requested more than once, the cached version will subsequently be @@ -656,7 +655,7 @@ the directories *HTTP-CACHE-DIRS*, its contents will be returned instead." (when cached-filepath (alexandria:read-file-into-string cached-filepath)))) (setf (gethash uri *http-cache*) ; If not cached, download & cache it. - (http-get uri :headers headers)))) + (as/u:http-get uri :accept accept)))) (defun find-file (file-leaf dirs) "Search for a file of the given name FILE-LEAF within directories DIRS. @@ -667,10 +666,6 @@ Returns the first found matching file." (unless (not (cdr dirs)) (get-file-from-dirs file-leaf (cdr dirs))))) -(defun http-get (uri &key headers) - "Makes a GET request to URI, returning the resultant string." - (dexador:get uri :headers headers :force-string 't)) - (defun uri-sans-scheme (uri) "Returns a URI string without its scheme." (str:replace-all diff --git a/src/util.lisp b/src/util.lisp new file mode 100644 index 0000000..2995019 --- /dev/null +++ b/src/util.lisp @@ -0,0 +1,55 @@ +;;;; util: General utilities used in several parts of activity-servist. + +;; Copyright © 2025 Jaidyn Ann +;; +;; 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 . + +(defpackage #:activity-servist/util + (:use #:cl) + (:nicknames "AS/U") + (:export + ;; Functions + #:http-get + ;; Symbols + #:http-request-error #:http-get-error + ;; Slots/Accessors + :body :status)) + +(in-package #:activity-servist/util) + +(defun http-get (uri &key (accept "application/activity+json,application/ld+json")) + "Perform a GET request, returning two values: The response-body’s string, and the status code. +:ACCEPT, defaulting to ActivityPub-related types, corresponds to the “Accept” header. + +If a non-2XX status-code is returned, the HTTP-GET-ERROR condition will be signaled." + (multiple-value-bind (body status) + (drakma:http-request uri :accept accept :force-binary t) + (let ((body-str (ignore-errors (when body (flexi-streams:octets-to-string body))))) + (when (or (< status 200) (>= status 300)) + (signal 'http-get-error :status status :body body-str)) + (values body-str status)))) + +(define-condition http-request-error (condition) + ((status :initarg :status) + (body :initarg :body)) + (:documentation "Signaled when a HTTP request returns a non-2XX status code.")) + +(define-condition http-get-error (http-request-error) + () + (:report (lambda (condition stream) (declare (ignore condition)) + (format stream "Received non-2XX status (~A) in response to GET request. Response body:~%~A~&" + (slot-value condition 'status) + (slot-value condition 'body)))) + (:documentation "Signaled when an HTTP GET request returns a non-2XX status code.")) +