diff --git a/src/dog_and_duck/quack/picky.clj b/src/dog_and_duck/quack/picky.clj index 54dbed2..6b5b832 100644 --- a/src/dog_and_duck/quack/picky.clj +++ b/src/dog_and_duck/quack/picky.clj @@ -29,7 +29,9 @@ ActivityStreams spec." (:require [dog-and-duck.quack.picky.constants :refer [actor-types]] [dog-and-duck.quack.picky.control-variables :refer [*reify-refs*]] - [dog-and-duck.quack.picky.utils :refer [concat-non-empty + [dog-and-duck.quack.picky.utils :refer [any-or-faults + concat-non-empty + cond-make-fault-object has-context? has-activity-type? has-actor-type? has-type? @@ -76,10 +78,9 @@ ([x expected-type] (concat-non-empty (object-faults x) - (list - ;; TODO: should resolve the correct `-faults`function for the - ;; `expected-type` and call that; but that's for later. - (has-type-or-fault x expected-type :critical :unexpected-type))))) + (when expected-type + (list + (has-type-or-fault x expected-type :critical :unexpected-type)))))) (defn uri-or-fault "If `u` is not a valid URI, return a fault object with this `severity` and @@ -154,7 +155,8 @@ and `token`, prepended to the faults returned. As with `has-type-or-fault` (q.v.), `expected-type` may be passed as a - string or as a set of strings. + string, as a set of strings, or `nil` (indicating the type of the + referenced object should not be checked). **NOTE THAT** if `*reify-refs*` is `false`, referenced objects will not actually be checked." @@ -173,6 +175,7 @@ ;; found a link, that's OK. (= expected-type "Link") nil (and (set? expected-type) (expected-type "Link")) nil + (nil? expected-type) nil :else (object-reference-or-faults (:href value) expected-type severity token)) @@ -303,10 +306,79 @@ (defn activity-faults [x] (concat-non-empty (persistent-object-faults x) - (activity-type-faults x) - (list - (when-not - (has-activity-type? x) - (make-fault-object :must :not-activity-type)) - (when-not (string? (:summary x)) (make-fault-object :should :no-summary))))) + (activity-type-faults x) + (list + (when-not + (has-activity-type? x) + (make-fault-object :must :not-activity-type)) + (when-not (string? (:summary x)) (make-fault-object :should :no-summary))))) +(defn- paged-collection-faults + "Return a list of faults found in `x` considered as a paged collection + object of this sub-`type`, or `nil` if none are found." + [x type] + (concat-non-empty + (object-faults x type) + (list (object-reference-or-faults x type :critical :expected-collection) + (cond-make-fault-object (integer? (:totalItems x)) :should :no-total-items) + (object-reference-or-faults (:first x) nil :must :no-first-page) + (object-reference-or-faults (:last x) nil :should :no-last-page)))) + +(defn- simple-collection-faults + "Return a list of faults found in `x` considered as a non-paged collection + object of this sub-`type`, or `nil` if none are found." + [x type] + (concat-non-empty + (object-faults x type) + (cons + (list (object-reference-or-faults x type :critical :expected-collection) + (cond-make-fault-object (integer? (:totalItems x)) :should :no-total-items) + (cond-make-fault-object (coll? (:items x)) :must :no-items-collection)) + (map #(object-reference-or-faults % nil :must :not-object-reference) (:items x))))) + +(defn- collection-page-faults + [x type] + (concat-non-empty + (simple-collection-faults x type) + (list + (object-reference-or-faults (:partOf x) + (apply str (drop-last 4 type)) + :should + :n-part-of) + (object-reference-or-faults (:next x) type :minor :no-next-page) + (object-reference-or-faults (:prev x) type :minor :no-prev-page)))) + +(defn collection-faults + "Return a list of faults found in the collection `x`; if `type` is also + specified, it should be a string naming a specific collection type for + which checks should be performed. + + Every collection *should*(?) have a `totalItems` field (an integer). + + Beyond that, collections are either 'just collections' (in which case + they *should* have an `items` field (a sequence)), or else they're paged + collections, in which case they *must*(?) have a `first` field which is + a collection page or a URI pointing to a collection page, and *should* + have a `last` field which is similar. + + The pages of collections *should* be collection pages; the pages of + ordered collections *should* be ordered collection pages." + ([x] + (collection-faults + x + (first + (remove nil? + (map #(when (has-type? x %) %) + ["Collection" + "OrderedCollection" + "CollectionPage" + "OrderedCollectionPage"]))))) + ([x type] + (case type + ["Collection" "OrderedCollection"] (any-or-faults + (list (simple-collection-faults x type) + (paged-collection-faults x type)) + :must + :no-items) + ["CollectionPage" "OrderedCollectionPage"] (collection-page-faults x type) + (list (make-fault-object :critical :expected-collection))))) diff --git a/src/dog_and_duck/quack/picky/fault_messages.clj b/src/dog_and_duck/quack/picky/fault_messages.clj index 0516158..998936d 100644 --- a/src/dog_and_duck/quack/picky/fault_messages.clj +++ b/src/dog_and_duck/quack/picky/fault_messages.clj @@ -20,7 +20,8 @@ (def messages "Actual fault messages to which fault codes resolve." - {:id-not-https "Publicly facing content SHOULD use HTTPS URIs" + {:expected-collection "A collection was expected, but was not found." + :id-not-https "Publicly facing content SHOULD use HTTPS URIs" :id-not-uri "identifiers must be publicly dereferencable URIs" :no-context "Section 3 of the ActivityPub specification states Implementers SHOULD include the ActivityPub context in their object definitions`." :no-id-persistent "Persistent objects MUST have unique global identifiers." diff --git a/src/dog_and_duck/quack/picky/utils.clj b/src/dog_and_duck/quack/picky/utils.clj index 9bf9c57..fb1a408 100644 --- a/src/dog_and_duck/quack/picky/utils.clj +++ b/src/dog_and_duck/quack/picky/utils.clj @@ -10,7 +10,9 @@ [dog-and-duck.utils.process :refer [get-hostname get-pid]] [taoensso.timbre :as timbre ;; Optional, just refer what you like: - :refer [warn]])) + :refer [warn]]) + + (:import [java.net URI URISyntaxException])) ;;; Copyright (C) Simon Brooke, 2022 @@ -35,7 +37,8 @@ (if (actor-types x) true false)) (defn truthy? - "Return `true` if `x` is truthy, else `false`." + "Return `true` if `x` is truthy, else `false`. There must be some more + idiomatic way to do this?" [x] (if x true false)) @@ -51,6 +54,22 @@ (coll? tv) (truthy? (not-empty (filter #(= % type) tv))) :else (= tv type)))) +(defn object-or-uri? + "Very basic check that `x` is either an object or a URI." + [x] + (try + (cond (string? x) (uri? (URI. x)) + (map? x) (if (and (:type x) (:id x)) true false) + :else false) + (catch URISyntaxException _ false) + (catch NullPointerException _ false))) + +(defmacro link-or-uri? + "Very basic check that `x` is either a link object or a URI." + [x] + `(if (object-or-uri? ~x) (has-type? ~x "Link") false)) + + (defn verb-type? "`true` if `x`, a string, represents a recognised ActivityStreams activity type." @@ -173,3 +192,22 @@ :severity severity :token token}}))) (make-fault-object severity token))))) + +(defn any-or-faults + "Return `nil` if validating one of these options returns `nil`; otherwise + return a list comprising a fault report object with this `severity-if-none` + and this token followed by all the fault reports from validating each + option. + + There are several places - but especially in validating collections - where + there are several different valid configurations, but few or no properties + are always required." + [options severity-if-none token] + (let [faults (remove empty? (reduce concat options))] + (when-not (empty? faults) (cons (make-fault-object severity-if-none token) faults)))) + +(defmacro cond-make-fault-object + "If `v` is `false` or `nil`, return a fault object with this `severity` and `token`, + else return nil." + [v severity token] + `(when-not ~v (make-fault-object ~severity ~token))) diff --git a/src/dog_and_duck/scratch/parser.clj b/src/dog_and_duck/scratch/parser.clj index 81f2832..d7b73d4 100644 --- a/src/dog_and_duck/scratch/parser.clj +++ b/src/dog_and_duck/scratch/parser.clj @@ -1,6 +1,6 @@ (ns dog-and-duck.scratch.parser - (:require [clojure.java.io :refer [file]] - [clojure.string :refer [ends-with?]] + (:require ;; [clojure.java.io :refer [file]] + ;; [clojure.string :refer [ends-with?]] [clojure.walk :refer [keywordize-keys]] [clojure.data.json :as json] [dog-and-duck.quack.quack :as q])) @@ -33,15 +33,15 @@ (cond (map? feed) (list (keywordize-keys feed)) (coll? feed) (map keywordize-keys feed)))))) -(clean (slurp "resources/activitystreams-test-documents/core-ex1-jsonld.json")) +;; (clean (slurp "resources/activitystreams-test-documents/core-ex1-jsonld.json")) -(map - #(when - (ends-with? (str %) ".json") - (let [objects (clean (slurp %))] - (list (str %) - (count objects) - (map :type objects)))) - (file-seq (file "resources/activitystreams-test-documents"))) +;; (map +;; #(when +;; (ends-with? (str %) ".json") +;; (let [objects (clean (slurp %))] +;; (list (str %) +;; (count objects) +;; (map :type objects)))) +;; (file-seq (file "resources/activitystreams-test-documents"))) -(-> "resources/activitystreams-test-documents/simple0020.json" slurp clean first :actor) \ No newline at end of file +;; (-> "resources/activitystreams-test-documents/simple0020.json" slurp clean first :actor) \ No newline at end of file