Stopping for now because it's too cold!

`collection-faults` mostly done but currently not working.

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
+    (when expected-type
-              ;; TODO: should resolve the correct `-faults`function for the
+      (list
-              ;; `expected-type` and call that; but that's for later.
+       (has-type-or-fault x expected-type :critical :unexpected-type))))))
-     (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)
+                    (activity-type-faults x)
-                   (list
+                    (list
-                    (when-not
+                     (when-not
-                     (has-activity-type? x)
+                      (has-activity-type? x)
-                      (make-fault-object :must :not-activity-type))
+                       (make-fault-object :must :not-activity-type))
-                    (when-not (string? (:summary x)) (make-fault-object :should :no-summary)))))
+                     (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)))))

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."

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)))

src/dog_and_duck/scratch/parser.clj

@@ -1,6 +1,6 @@
 (ns dog-and-duck.scratch.parser
-  (:require [clojure.java.io :refer [file]]
+  (:require ;; [clojure.java.io :refer [file]]
-            [clojure.string :refer [ends-with?]]
+            ;; [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
+;; (map
- #(when 
+;;  #(when 
-   (ends-with? (str %) ".json") 
+;;    (ends-with? (str %) ".json") 
-    (let [objects (clean (slurp %))]
+;;     (let [objects (clean (slurp %))]
-      (list (str %) 
+;;       (list (str %) 
-            (count objects) 
+;;             (count objects) 
-            (map :type objects))))
+;;             (map :type objects))))
- (file-seq (file "resources/activitystreams-test-documents")))
+;;  (file-seq (file "resources/activitystreams-test-documents")))
 
-(-> "resources/activitystreams-test-documents/simple0020.json" slurp clean first :actor)
+;; (-> "resources/activitystreams-test-documents/simple0020.json" slurp clean first :actor)