Validating time (not complete)

project.clj

@@ -8,6 +8,7 @@
           :source-uri "https://github.com/simon-brooke/dog-and-duck/blob/master/{filepath}#L{line}"}
   :description "A playground for hacking ActivityPub stuff."
   :dependencies [[clj-activitypub/activitypub "0.49"]
+                 [clojure.java-time "1.1.0"]
                  [com.taoensso/timbre "6.0.4"]
                  [mvxcvi/clj-pgp "1.1.0"]
                  [org.bouncycastle/bcpkix-jdk18on "1.72"] 

src/dog_and_duck/quack/picky/constants.clj

@@ -22,6 +22,13 @@
    literal string."
   "https://www.w3.org/ns/activitystreams")
 
+(def ^:const xsd-date-time-pattern 
+  "The pattern to which valid 
+   [xsd:dateTime](https://www.w3.org/TR/xmlschema11-2/#dateTime) values conform.
+   
+   TODO: this is failing on some of the published examples, so may be wrong."
+  "yyyy-MM-dd'T'HH:mm:ssX")
+
 (def ^:const actor-types
   "The set of types we will accept as actors.
    

src/dog_and_duck/quack/picky/utils.clj

@@ -1,18 +1,22 @@
 (ns dog-and-duck.quack.picky.utils
   "Utility functions supporting the picky validator"
   (:require [clojure.data.json :as json]
+            [java-time.api :as jt]
             [clojure.set :refer [intersection]]
             [dog-and-duck.quack.picky.constants :refer [activitystreams-context-uri
                                                         actor-types
                                                         context-key severity-filters
                                                         validation-fault-context-uri
-                                                        verb-types]]
+                                                        verb-types
+                                                        xsd-date-time-pattern]]
             [dog-and-duck.quack.picky.control-variables :refer [*reify-refs*]]
             [dog-and-duck.quack.picky.fault-messages :refer [messages]]
             [dog-and-duck.utils.process :refer [get-hostname get-pid]]
             [taoensso.timbre :as log :refer [warn]])
 
-  (:import [java.net URI URISyntaxException]))
+  (:import [java.io FileNotFoundException]
+           [java.net URI URISyntaxException]
+           [java.time.format DateTimeParseException]))
 
 ;;;     Copyright (C) Simon Brooke, 2022
 
@@ -225,6 +229,28 @@
    (when not (and (string? value) (re-matches pattern value))
          (make-fault-object severity token))))
 
+(defn xsd-date-time?
+  "Return `true` if `value` matches the pattern for an 
+   [xsd:dateTime](https://www.w3.org/TR/xmlschema11-2/#dateTime), else `false`"
+  [^String value]
+  (try
+    (if (jt/local-date-time xsd-date-time-pattern value) true false)
+    (catch DateTimeParseException _
+      (log/warn "Not a recognised xsd:dateTime: " 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`. 
+   
+   If `required?` is false and there is no such property, no fault will be
+   returned."
+  [x property severity token required?]
+  (let [value (property x)]
+    (if (and required? (not (x property)))
+      (make-fault-object severity token)
+      (cond-make-fault-object
+       (and value (xsd-date-time? value)) severity token))))
 
 (defn object-faults
   "Return a list of faults found in object `x`, or `nil` if none are.
@@ -232,6 +258,11 @@
    If `expected-type` is also passed, verify that `x` has `expected-type`.
    `expected-type` may be passed as a string or as a set of strings. Detailed
    verification of the particular features of types is not done here."
+  
+  ;; TODO: many more properties which are nor required, nevertheless have required
+  ;; property TYPES as detailed in
+  ;; https://www.w3.org/TR/activitystreams-vocabulary/#properties
+  ;; if these properties are present, these types should be checked.
   ([x]
    (nil-if-empty
     (remove empty?
@@ -244,7 +275,13 @@
              (when-not (:type x)
                (make-fault-object :minor :no-type))
              (when-not (and (map? x) (contains? x :id))
-               (make-fault-object :minor :no-id-transient))))))
+               (make-fault-object :minor :no-id-transient))
+             (date-time-property-or-fault x :endTime :must
+                                          :not-valid-date-time false)
+             (date-time-property-or-fault x :published :must
+                                          :not-valid-date-time false)
+             (date-time-property-or-fault x :startTime :must
+                                          :not-valid-date-time false)))))
   ([x expected-type]
    (concat-non-empty
     (object-faults x)
@@ -252,6 +289,36 @@
       (list
        (has-type-or-fault x expected-type :critical :unexpected-type))))))
 
+(def maybe-reify
+  "If `*reify-refs*` is `true`, return the object at this `target` URI.
+   Returns `nil` if
+   
+   1. `*reify-refs*` is false;
+   2. the object was not found;
+   3. access to the object was not permitted.
+   
+   Consequently, use with care."
+  (memoize
+   (fn [target]
+     (try (let [uri (URI. target)]
+            (when *reify-refs*
+              (json/read-str (slurp uri))))
+          (catch URISyntaxException _
+            (log/warn "Reification target" target "was not a valid URI.")
+            nil)
+          (catch FileNotFoundException _
+            (log/warn "Reification target" target "was not found.")
+            nil)))))
+
+(defn maybe-reify-or-faults
+  "If `*reify-refs*` is `true`, runs basic checks on the object at this 
+   `target` URI, if it is found, or a list containing a fault object with
+   this `severity` and `token` if it is not."
+  [value expected-type severity token]
+  (let [object (maybe-reify value)]
+    (cond object
+          (object-faults object expected-type)
+          *reify-refs* (list (make-fault-object severity token)))))
 
 (defn object-reference-or-faults
   "If this `value` is either 
@@ -272,13 +339,7 @@
    actually be checked."
   [value expected-type severity token]
   (let [faults (cond
-                 (string? value) (try (let [uri (URI. value)
+                 (string? value) (maybe-reify-or-faults value severity token expected-type)
-                                            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