Tests are failing, but there's a lot of progress here.

project.clj

@@ -15,7 +15,7 @@
                  [org.bouncycastle/bcpkix-jdk18on "1.72"] ;; required by clj-activitypub
                  [clj-http "3.12.3"] ;; required by clj-activitypub
                  [cheshire "5.11.0"] ;; if this is not present, clj-http/client errors with 'json-enabled?'
-                 ]
+                 [com.taoensso/timbre "6.0.4"]]
   :license {:name "GPL-2.0-or-later"
             :url "https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html"}
   :plugins [[lein-cloverage "1.2.2"]

src/dog_and_duck/quack/picky.clj

@@ -32,7 +32,8 @@
               [dog-and-duck.utils.process :refer [get-hostname get-pid]]
               [taoensso.timbre :as timbre
       ;; Optional, just refer what you like:
-               :refer [warn]])
+               :refer [warn]]
+              [clojure.data.json :as json])
     (:import [java.net URI URISyntaxException]))
 
 ;;;     Copyright (C) Simon Brooke, 2022
@@ -141,8 +142,12 @@
          (every? :severity reports)) (remove
                                       #((severity-filters severity) (:severity %))
                                       reports)
-        :else reports)) ;; TODO this actually shouldn't happen and we should
+        :else
-                        ;; error if it does
+        (throw
+         (ex-info
+          "Argument `reports` was not a collection of fault reports"
+          {:arguments {:reports reports
+                       :severity severity}}))))
 
 (def ^:const activitystreams-context-uri
   "The URI of the context of an ActivityStreams object is expected to be this
@@ -210,8 +215,10 @@
   "If object `x` has a `:type` value which is `acceptable`, return `nil`;
    else return a fault object with this `severity` and `token`.
    
-   `acceptable` may be passed as either a string, or as a set of strings."
+   `acceptable` may be passed as either nil, a string, or a set of strings.
+   If `acceptable` is `nil`, no type specific tests will be performed."
   [x acceptable severity token]
+  (when acceptable
     (let [tv (:type x)]
       (when-not
        (cond
@@ -220,9 +227,13 @@
          (and (coll? tv) (string? acceptable)) ((set tv) acceptable)
          (and (coll? tv) (set? acceptable)) (not-empty
                                              (intersection (set tv) acceptable))
-      ;; TODO else should error
+         :else
-      )
+         (throw (ex-info "Type value or `acceptable` argument not as expected."
-      (make-fault-object severity token))))
+                         {:arguments {:x x
+                                      :acceptable acceptable
+                                      :severity severity
+                                      :token token}})))
+        (make-fault-object severity token)))))
 
 (defn object-faults
   "Return a list of faults found in object `x`, or `nil` if none are.
@@ -256,13 +267,15 @@
   "If `u` is not a valid URI, return a fault object with this `severity` and 
    `if-invalid-token`. If it's `nil`, return a fault object with this `severity`
    and `if-missing-token`. Otherwise return nil."
-  [u severity if-missing-token if-invalid-token]
+  ([u severity if-missing-token]
+   (uri-or-fault u severity if-missing-token if-missing-token))
+  ([u severity if-missing-token if-invalid-token]
    (try
      (uri? (URI. u))
      (catch URISyntaxException _
        (make-fault-object severity if-invalid-token))
      (catch NullPointerException _
-      (make-fault-object severity if-missing-token))))
+       (make-fault-object severity if-missing-token)))))
 
 (defn persistent-object-faults
   "Return a list of faults found in persistent object `x`, or `nil` if none are."
@@ -365,37 +378,160 @@
   (list
    (uri-or-fault
     (:href x) :must :no-href-uri :invalid-href-uri)
-   (string-or-fault (:mediaType x) :minor :no-media-type #"\w+\/[-+.\w]+")))
+   (string-or-fault (:mediaType x) :minor :no-media-type #"\w+\/[-+.\w]+")
+   ;; TODO: possibly more here. Audit against the specs
+   ))
 
-(defn object-reference-or-fault
+(defn object-reference-or-faults
   "If this `value` is either 
    
    1. an object of `expected-type`;
-   2. a URI; or
+   2. a URI referencing an object of  `expected-type`; or
-   3. a link object
+   3. a link object referencing an object of  `expected-type`
    
-   then return `nil`; else return a fault object with this `severity` and `token`.
+   and no faults are returned from validating the linked object, then return
+   `nil`; else return a sequence comprising a fault object with this `severity`
+   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.
    
-   **NOTE THAT** TODO if `*reify-refs*` is `true` and `value` is either a URI or
+   **NOTE THAT** if `*reify-refs*` is `false`, referenced objects will not
-   a link, the linked object should be checked and validated as an object of
+   actually be checked."
-   `expected-type`."
   [value expected-type severity token]
-  (cond TODO continue here in the morning))
+  (let [faults (cond
+                 (string? value) (try (let [uri (URI. value)
+                                            object (when *reify-refs*
+                                                     (json/read-str (slurp uri)))]
+                                        (when object
+                                          (object-faults object expected-type)))
+                                      (catch URISyntaxException _
+                                        (make-fault-object severity token)))
+                 (map? value) (if (has-type? value "Link")
+                                (cond
+                                  ;; if we were looking for a link and we've 
+                                  ;; found a link, that's OK.
+                                  (= expected-type "Link") nil
+                                  (and (set? expected-type) (expected-type "Link")) nil
+                                  :else
+                                  (object-reference-or-faults
+                                   (:href value) expected-type severity token))
+                                (object-faults value expected-type))
+                 :else (throw
+                        (ex-info
+                         "Argument `value` was not an object or a link to an object"
+                         {:arguments {:value value}
+                          :expected-type expected-type
+                          :severity severity
+                          :token token})))]
+    (when faults (cons (make-fault-object severity token) faults))))
+
+(defn link-faults
+  "Return a list of faults found in the link `x`, or `nil` if none are found."
+  [x]
+  (object-reference-or-faults x "Link" :critical :expected-link))
+
+(defn coll-object-reference-or-fault
+  "As object-reference-or-fault, except `value` argument may also be a list of
+   objects and/or object references."
+  [value expected-type severity token]
+  (cond
+    (map? value) (object-reference-or-faults value expected-type severity token)
+    (coll? value) (nil-if-empty
+                   (remove nil?
+                           (reduce concat
+                                   (map
+                                    #(object-reference-or-faults
+                                      % expected-type severity token)
+                                    value))))
+    :else (throw
+           (ex-info
+            "Argument `value` was not an object, a link to an object, nor a list of these."
+            {:arguments {:value value}
+             :expected-type expected-type
+             :severity severity
+             :token token}))))
+
+(def ^:const base-activity-required-properties
+  "Properties most activities should have. Values are validating functions, each.
+   
+   See https://www.w3.org/TR/activitystreams-vocabulary/#dfn-activity"
+  {:summary (fn [v] (when-not (string? v)
+                      (list (make-fault-object :should :no-summary))))
+   :actor (fn [v] (object-reference-or-faults v actor-types :must :no-actor))
+   :object (fn [v] (object-reference-or-faults v nil :must :no-object))})
+
+(def ^:const intransitive-activity-required-properties
+  "Properties intransitive activities should have.
+   
+   See https://www.w3.org/TR/activitystreams-vocabulary/#dfn-intransitiveactivity"
+  (dissoc base-activity-required-properties :object))
+
+(def ^:const accept-required-properties
+  "As base-activity-required-properties, except that the type of the object
+   is restricted."
+  (assoc base-activity-required-properties
+         :object
+         (fn [v]
+           (object-reference-or-faults v #{"Invite" "Person"}
+                                      :must
+                                      :bad-accept-target))))
+
+(def ^:const activity-required-properties
+  "Properties activities should have, keyed by activity type. Values are maps 
+   of the format of `base-activity-required-properties`, q.v."
+  {"Accept" accept-required-properties
+   "Add" base-activity-required-properties
+   "Announce" base-activity-required-properties
+   "Arrive" intransitive-activity-required-properties
+   ;; TODO: is `:location` required for arrive?
+   "Block" base-activity-required-properties
+   "Create" base-activity-required-properties
+   "Delete" base-activity-required-properties
+   "Dislike" base-activity-required-properties
+   "Flag" base-activity-required-properties
+   "Follow" base-activity-required-properties
+   ;; TODO: is `:object` required to be an actor?
+   "Ignore" base-activity-required-properties
+   "Invite" (assoc base-activity-required-properties :target
+                   (fn [v]
+                     (coll-object-reference-or-fault v #{"Event" "Group"}
+                                                     :must
+                                                     :bad-accept-target)))
+   ;; TODO: are here other things one could meaningfully be invited to?
+   "Join" base-activity-required-properties
+   "Leave" base-activity-required-properties
+   "Like" base-activity-required-properties
+   "Listen" base-activity-required-properties
+   "Move" base-activity-required-properties
+   "Offer" base-activity-required-properties
+   "Question" intransitive-activity-required-properties
+   "Reject" base-activity-required-properties
+   "Read" base-activity-required-properties
+   "Remove" base-activity-required-properties
+   "TentativeReject" base-activity-required-properties
+   "TentativeAccept" accept-required-properties
+   "Travel" base-activity-required-properties
+   "Undo" base-activity-required-properties
+   "Update" base-activity-required-properties
+   "View" base-activity-required-properties})
 
 (defn activity-type-faults
-  "Some specific activity types have specific requirements which are not
+  "Return a list of faults found in the activity `x`; if `type` is also 
+   specified, it should be a string naming a specific activity type for
+   which checks should be performed.
+   
+   Some specific activity types have specific requirements which are not
    requirements."
   ([x]
    (if (coll? (:type x))
      (map #(activity-type-faults x %) (:type x))
      (activity-type-faults x (:type x))))
-  ([x token]
+  ([x type]
-   (case token
+   (let [checks (activity-required-properties type)]
-     "Link" (link-faults x)
+     (map
-     )))
+      #(apply (checks %) (x %))
+      (keys checks)))))
 
 (defn activity-faults
   [x]
@@ -407,6 +543,4 @@
                     (when-not
                      (has-activity-type? x)
                       (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)))))))
-                    
-                    )))))

src/dog_and_duck/quack/quack.clj

@@ -13,11 +13,9 @@
    I may have to implement a `*strict*` dynamic variable, so that users can 
    toggle some checks off."
 
-  (:require [dog-and-duck.quack.picky :refer [*reject-severity* actor-faults
+  (:require [dog-and-duck.quack.picky :refer [*reject-severity* activity-faults
-                                              filter-severity 
+                                              actor-faults filter-severity link-faults
-                                              has-context?
+                                              object-faults persistent-object-faults]]))
-                                              object-faults persistent-object-faults]])
-  (:import [java.net URI URISyntaxException]))
 
 ;;;     Copyright (C) Simon Brooke, 2022
 
@@ -90,24 +88,15 @@
 
 (defn activity?
   "`true` iff `x` quacks like an activity, else false." 
-  [x]
+  ([x] (activity? x *reject-severity*))
-  (try
+  ([x severity]
-    (and (object? x)
+   (empty? (filter-severity (activity-faults x) severity))))
-         (has-context? x)
-         (string? (:summary x))
-         (actor-or-uri? (:actor x))
-         (verb-type? (:type x))
-         (or (object? (:object x)) (uri? (URI. (:object x))))
-         true)
-    (catch URISyntaxException _ false)))
 
 (defn link?
   "`true` iff `x` quacks like a link, else false."
-  [x]
+  ([x] (link? x *reject-severity*))
-  (and (object? x)
+  ([x severity]
-       (= (:type x) "Link")
+   (empty? (filter-severity (link-faults x) severity))))
-       (uri? (URI. (:href x)))
-       true))
 
 (defn link-or-uri?
   "`true` iff `x` is either a URI or a link, else false.