Much work on validating object properties.

src/dog_and_duck/quack/picky/constants.clj

@@ -60,14 +60,14 @@
    :minor #{:info}
    :should #{:info :minor}
    :must #{:info :minor :should}
-   :critical severity})
+   :critical #{:info :minor :should :must}})
 
 (def ^:const validation-fault-context-uri
   "The URI of the context of a validation fault report object shall be this
    literal string."
   "https://simon-brooke.github.io/dog-and-duck/codox/Validation_Faults.html")
 
-(def ^:const verb-types
+(def ^:const activity-types
   "The set of types we will accept as verbs.
    
    There's an [explicit set of allowed verb types]
@@ -77,3 +77,9 @@
     "Offer" "Question" "Reject" "Read" "Remove" "TentativeAccept"
     "TentativeReject" "Travel" "Undo" "Update" "View"})
 
+(def ^:const noun-types
+  "The set of types we will accept as nouns.
+   
+   TODO: incomplete."
+  #{"Image" "Note" "Place"})
+

src/dog_and_duck/quack/picky/objects.clj

@@ -1,16 +1,226 @@
 (ns dog-and-duck.quack.picky.objects
   (:require [clojure.data.json :as json]
+            [dog-and-duck.quack.picky.constants :refer [actor-types noun-types]]
             [dog-and-duck.quack.picky.control-variables :refer [*reify-refs*]]
-            [dog-and-duck.quack.picky.time :refer [date-time-property-or-fault]]
+            [dog-and-duck.quack.picky.time :refer [date-time-property-or-fault
+                                                   xsd-date-time?
+                                                   xsd-duration?]]
             [dog-and-duck.quack.picky.utils :refer [concat-non-empty
+                                                    has-activity-type?
                                                     has-context?
                                                     has-type?
                                                     has-type-or-fault
                                                     make-fault-object
-                                                    nil-if-empty]]
+                                                    nil-if-empty
+                                                    object-or-uri?]]
             [taoensso.timbre :refer [warn]])
   (:import [java.io FileNotFoundException]
-[java.net URI URISyntaxException]))
+           [java.net URI URISyntaxException]))
+
+(def object-expected-properties
+  "Requirements of properties of object, cribbed from
+   https://www.w3.org/TR/activitystreams-vocabulary/#properties
+   
+   Note the following sub-key value types:
+   
+   * `:collection` opposite of `:functional`: if true, value should be a
+      collection (in the Clojure sense), not a single object;
+   * `:functional` if true, value should be a single object; if false, may
+      be a single object or a sequence of objects, but each must pass 
+      validation checks;
+   * `:if-invalid` a sequence of two keywords, first indicating severity,
+      second being a message key;
+   * `:if-missing` a sequence of two keywords, first indicating severity,
+      second being a message key;
+   * `:required` a boolean, or a function of one argument returning a 
+      boolean, in which case the function will be applied to the object
+      having the property;
+   * `:verifier` a function of one argument returning a boolean, which will 
+      be applied to the value or values of the identified property."
+  {:accuracy {:functional false
+              :if-invalid [:must :invalid-number]
+              :verifier number?}
+   :actor {:functional false
+           :if-invalid [:must :invalid-actor]
+           :if-missing [:must :no-actor]
+           :required has-activity-type?
+           :verifier object-or-uri?}
+   :altitude {:functional false
+              :if-invalid [:must :invalid-number]
+              :verifier number?}
+   :anyOf {:collection true
+           :functional false
+           ;; a Question should have a `:oneOf` ot `:anyOf`, but at this layer
+           ;; that's hard to check.
+           :if-invalid [:must :invalid-option]
+           :verifier object-or-uri?}
+   :attachment {:functional false
+                :if-invalid [:must :invalid-attachment]
+                :verifier object-or-uri?}
+   :attributedTo {:functional false
+                  :if-invalid [:must :invalid-attribution]
+                  :verifier object-or-uri?}
+   :audience {:functional false
+              :if-invalid [:must :invalid-audience]
+              :verifier object-or-uri?}
+   :bcc {:functional false
+         :if-invalid [:must :invalid-audience] ;; do we need a separate message for bcc, cc, etc?
+         :verifier object-or-uri?}
+   :cc {:functional false
+        :if-invalid [:must :invalid-audience] ;; do we need a separate message for bcc, cc, etc?
+        :verifier object-or-uri?}
+   :closed {:functional false
+            :if-invalid [:must :invalid-closed]
+            :verifier (fn [pv] (or (object-or-uri? pv)
+                                   (xsd-date-time? pv)
+                                   (#{"true" "false"} pv)))}
+   :content {:functional false
+             :if-invalid [:must :invalid-content]
+             :verifier string?}
+   :context {:functional false
+             :if-invalid [:must :invalid-context]
+             :verifier object-or-uri?}
+   :current {:functional true
+             :if-missing [:minor :paged-collection-no-current]
+             :if-invalid [:must :paged-collection-invalid-current]
+             :required (fn [x] ;; if an object is a collection which has pages,
+                                 ;; it ought to have a `:current` page. But 
+                                 ;; 1. it isn't required to, and
+                                 ;; 2. there's no certain way of telling that it
+                                 ;;    does have pages - although if it has a
+                                 ;;    `:first`, then it is.
+                         (and
+                          (or (has-type? x "Collection")
+                              (has-type? x "OrderedCollection"))
+                          (:first x)))
+             :verifier (fn [pv] (object-or-uri? pv #{"CollectionPage"
+                                                     "OrderedCollectionPage"}))}
+   :duration {:functional false
+              :if-invalid [:must :invalid-duration]
+              :verifier xsd-duration?}
+   :first {:functional true
+           :if-missing [:minor :paged-collection-no-first]
+           :if-invalid [:must :paged-collection-invalid-first]
+           :required (fn [x] ;; if an object is a collection which has pages,
+                                 ;; it ought to have a `:first` page. But 
+                                 ;; 1. it isn't required to, and
+                                 ;; 2. there's no certain way of telling that it
+                                 ;;    does have pages - although if it has a
+                                 ;;    `:last`, then it is.
+                       (and
+                        (or (has-type? x "Collection")
+                            (has-type? x "OrderedCollection"))
+                        (:last x)))
+           :verifier (fn [pv] (object-or-uri? pv #{"CollectionPage"
+                                                   "OrderedCollectionPage"}))}
+   :generator {:functional false
+               :if-invalid [:must :invalid-generator]
+               :verifier object-or-uri?}
+   :icon {:functional false
+          :if-invalid [:must :invalid-icon]
+          ;; an icon is also expected to have a 1:1 aspect ratio, but that's
+          ;; too much detail at this level of verification
+          :verifier (fn [pv] (object-or-uri? pv "Image"))}
+   :id {:functional true
+        :if-missing [:minor :no-id-transient]
+        :if-invalid [:must :invalid-id]
+        :verifier (fn [pv] (try (uri? (URI. pv))
+                                (catch URISyntaxException _ false)))}
+   :image {:functional false
+           :if-invalid [:must :invalid-image]
+           :verifier (fn [pv] (object-or-uri? pv "Image"))}
+   :inReplyTo {:functional false
+               :if-invalid [:must :invalid-in-reply-to]
+               :verifier (fn [pv] (object-or-uri? pv noun-types))}
+   :instrument {:functional false
+                :if-invalid [:must :invalid-instrument]
+                :verifier object-or-uri?}
+   :items {:collection true
+           :functional false
+           :if-invalid [:must :invalid-items]
+           :if-missing [:must :no-items-or-pages]
+           :required (fn [x] (or (has-type? x #{"CollectionPage"
+                                                "OrderedCollectionPage"})
+                                 (and (has-type? x #{"Collection"
+                                                     "OrderedCollection"})
+                                      ;; if it's a collection and has pages,
+                                      ;; it doesn't need items.
+                                      (not (:current x))
+                                      (not (:first x))
+                                      (not (:last x)))))
+           :verifier object-or-uri?}
+   :last {:functional true
+          :if-missing [:minor :paged-collection-no-last]
+          :if-invalid [:must :paged-collection-invalid-last]
+          :required (fn [x] (if (try (uri? (URI. x))
+                                     (catch URISyntaxException _ false))
+                              true
+                                 ;; if an object is a collection which has pages,
+                                 ;; it ought to have a `:last` page. But 
+                                 ;; 1. it isn't required to, and
+                                 ;; 2. there's no certain way of telling that it
+                                 ;;    does have pages - although if it has a
+                                 ;;    `:first`, then it is.
+                              (and
+                               (has-type? x #{"Collection"
+                                              "OrderedCollection"})
+                               (:first x))))
+          :verifier (fn [pv] (object-or-uri? pv #{"CollectionPage"
+                                                  "OrderedCollectionPage"}))}
+   :location {:functional false
+              :if-invalid [:must :invalid-location]
+              :verifier (fn [pv] (object-or-uri? pv #{"Place"}))}
+   :name {:functional false
+             :if-invalid [:must :invalid-name]
+             :verifier string?}
+   :oneOf {:collection true
+           :functional false
+           ;; a Question should have a `:oneOf` ot `:anyOf`, but at this layer
+           ;; that's hard to check.
+           :if-invalid [:must :invalid-option]
+           :verifier object-or-uri?}
+   :origin {:functional false
+            :if-invalid :invalid-origin
+            :verifier object-or-uri?}
+   :next {:functional true
+          :if-invalid [:must :invalid-next-page]
+          :verifier (fn [pv] (object-or-uri? pv #{"CollectionPage"
+                                                  "OrderedCollectionPage"}))}
+   :object {:functional false
+            :if-invalid [:must :invalid-direct-object]
+            :verifier object-or-uri?}
+   :prev {:functional true
+          :if-invalid [:must :invalid-prior-page]
+          :verifier (fn [pv] (object-or-uri? pv #{"CollectionPage"
+                                                  "OrderedCollectionPage"}))}
+   :preview {:functional false
+             :if-invalid [:must :invalid-preview]
+             ;; probably likely to be an Image or Video, but that isn't stated.
+             :verifier object-or-uri?}
+   :replies {:functional true
+             :if-invalid [:must :invalid-replies]
+             :verifier (fn [pv] (object-or-uri? pv #{"Collection"
+                                                     "OrderedCollection"}))}
+   :result {:functional false
+            :if-invalid [:must :invalid-result]
+            :verifier object-or-uri?}
+   :tag {:functional false
+         :if-invalid [:must :invalid-tag]
+         :verifier object-or-uri?}
+   :target {:functional false
+            :if-invalid [:must :invalid-target]
+            :verifier object-or-uri?}
+   :to {:functional false
+        :if-invalid [:must :invalid-to]
+        :verifier (fn [pv] (object-or-uri? pv actor-types))}
+   :type {:functional false
+          :if-missing [:minor :no-type]
+          :if-invalid [:must :invalid-type]
+          ;; strictly, it's an 'anyURI', but realistically these are not checkable.
+          :verifier string?}
+   :url {:functional false
+         :if-invalid [:must :invalid-url-property]
+         :verifier (fn [pv] (object-or-uri? pv "Link"))}})
 
 (defn object-faults
   "Return a list of faults found in object `x`, or `nil` if none are.

src/dog_and_duck/quack/picky/time.clj

@@ -1,11 +1,13 @@
 (ns dog-and-duck.quack.picky.time
   "Time, gentleman, please! Recognising and validating date time values."
   (:require [dog-and-duck.quack.picky.utils :refer [cond-make-fault-object
-                                                    make-fault-object]]
+                                                    make-fault-object
+                                                    truthy?]]
             [scot.weft.i18n.core :refer [get-message]]
             [taoensso.timbre :refer [warn]])
   (:import [java.time LocalDateTime]
-           [java.time.format DateTimeFormatter DateTimeParseException]))
+           [java.time.format DateTimeFormatter DateTimeParseException]
+           [javax.xml.datatype DatatypeFactory]))
 
 ;;;     Copyright (C) Simon Brooke, 2023
 
@@ -33,6 +35,17 @@
       (warn (get-message :bad-date-time) ":" value)
       false)))
 
+(defn xsd-duration?
+  "Return `true` if `value` matches the pattern for an 
+   [xsd:duration](https://www.w3.org/TR/xmlschema11-2/#duration), else `false`"
+  [value]
+  (truthy?
+   (and (string? value)
+        (try (DatatypeFactory/newDuration value)
+             (catch IllegalArgumentException _
+               (warn (get-message :bad-duration) ":" value)
+               false)))))
+
 (defn date-time-property-or-fault
   "If the value of this `property` of object `x` is a valid xsd:dateTime 
    value, return a fault object with this `token` and `severity`. 

src/dog_and_duck/quack/picky/utils.clj

@@ -5,7 +5,7 @@
                                                         actor-types
                                                         context-key severity-filters
                                                         validation-fault-context-uri
-                                                        verb-types]]
+                                                        activity-types]]
             [dog-and-duck.utils.process :refer [get-hostname get-pid]]
             [scot.weft.i18n.core :refer [get-message]]
             [taoensso.timbre :as log :refer [warn]])
@@ -41,26 +41,39 @@
   (if x true false))
 
 (defn has-type?
-  "Return `true` if object `x` has type `type`, else `false`.
+  "Return `true` if object `x` has a type in `acceptable`, else `false`.
    
-   The values of `type` fields of ActivityStreams objects may be lists; they
+   The values of `:type` fields of ActivityStreams objects may be lists; they
-   are considered to have a type if the type token is a member of the list."
+   are considered to have a type if a member of the list is in `acceptable`.
-  [x type]
+   
-  (assert (map? x) (string? type))
+   `acceptable` may be passed as a string, in which case there is only one
+   acceptable value, or as a set of strings, in which case any member of the
+   set is acceptable."
+  [x acceptable]
+  (assert (map? x) (or (string? acceptable) (set? acceptable)))
   (let [tv (:type x)]
-    (cond
+    (truthy?
-      (coll? tv) (truthy? (not-empty (filter #(= % type) tv)))
+     (cond
-      :else (= tv type))))
+       (and (string? acceptable) (coll? tv)) (not-empty (filter #(= % acceptable) tv))
+       (and (set? acceptable) (coll? tv)) (not-empty (filter #(acceptable %) tv))
+       (string? acceptable) (= tv acceptable)
+       (set? acceptable) (acceptable tv)))))
 
 (defn object-or-uri?
   "Very basic check that `x` is either an object or a URI."
-  [x]
+  ([x]
-  (try
+   (try
-    (cond (string? x) (uri? (URI. x))
+     (cond (string? x) (uri? (URI. x))
-          (map? x) (if (and (:type x) (:id x)) true false)
+           (map? x) (if (and (:type x) (:id x)) true false)
-          :else false)
+           :else false)
-    (catch URISyntaxException _ false)
+     (catch URISyntaxException _ false)
-    (catch NullPointerException _ false)))
+     (catch NullPointerException _ false)))
+  ([x type]
+   (if (object-or-uri? x)
+     (if (map? x)
+       (has-type? x type)
+       true)
+     false)))
 
 (defmacro link-or-uri?
   "Very basic check that `x` is either a link object or a URI."
@@ -68,11 +81,11 @@
   `(if (object-or-uri? ~x) (has-type? ~x "Link") false))
 
 
-(defn verb-type?
+(defn activity-type?
   "`true` if `x`, a string, represents a recognised ActivityStreams activity
    type."
   [^String x]
-  (if (verb-types x) true false))
+  (if (activity-types x) true false))
 
 (defn has-activity-type?
   "Return `true` if the object `x` has a type which is an activity type, else 
@@ -80,8 +93,8 @@
   [x]
   (let [tv (:type x)]
     (cond
-      (coll? tv) (truthy? (not-empty (filter verb-type? tv)))
+      (coll? tv) (truthy? (not-empty (filter activity-type? tv)))
-      :else (verb-type? tv))))
+      :else (activity-type? tv))))
 
 (defn has-actor-type?
   "Return `true` if the object `x` has a type which is an actor type, else 

test/dog_and_duck/quack/quack_test.clj

@@ -3,7 +3,7 @@
             [dog-and-duck.quack.picky.constants :refer [activitystreams-context-uri
                                                         context-key]]
             [dog-and-duck.quack.picky.utils :refer [actor-type? context?
-                                                    verb-type?]]
+                                                    activity-type?]]
             [dog-and-duck.quack.quack :refer [actor? 
                                               object? ordered-collection-page?
                                               persistent-object?]]
@@ -85,16 +85,16 @@
 (deftest verb-type-test
   (testing "identification of verb types"
     (let [expected false
-          actual (verb-type? nil)]
+          actual (activity-type? nil)]
       (is (= actual expected) "nil is not a verb"))
     (let [expected false
-          actual (verb-type? "Quack")]
+          actual (activity-type? "Quack")]
       (is (= actual expected) "Quack is not a verb"))
     (let [expected true
-          actual (verb-type? "Create")]
+          actual (activity-type? "Create")]
       (is (= actual expected) "Create is a verb"))
     (let [expected true
-          actual (verb-type? "Reject")]
+          actual (activity-type? "Reject")]
       (is (= actual expected) "Reject is a verb"))))
 
 (deftest context-test