Working on completing the English messages dictionary.

Also started work on getting reify working...

.gitignore

@@ -12,4 +12,6 @@ pom.xml.asc
 .lein-failures
 .nrepl-port
 .cpcache/
-.calva
+.calva
+.clj-kondo
+.lsp

README.md

@@ -24,12 +24,13 @@ Nevertheless I think that this is a basis on which a useful validator can be bui
 
 The full range of command-line switches is as follows:
 ```
-    -i, --input SOURCE    standard input   The file or URL to validate
+  -i, --input SOURCE    standard in   The file or URL to validate.
-    -o, --output DEST     standard output  The file to write to, defaults to standard out
+  -o, --output DEST     standard out  The file to write to.
-    -f, --format FORMAT   :edn             The format to output, one of `edn` `csv` `html`
+  -f, --format FORMAT   :edn          The format to output, one of `csv`, `edn`, `json`, `html`.
-    -l, --language LANG   en-GB            The ISO 639-1 code for the language to output
+  -l, --language LANG   en-GB         The ISO 639-1 code for the language to output.
-    -s, --severity LEVEL  :info            The minimum severity of faults to report
+  -s, --severity LEVEL  :info         The minimum severity of faults to report.
-    -h, --help                             Print this message and exit
+  -r, --reify                         If set, reify objects referenced by URIs and check them.
+  -h, --help                          Print this message and exit.
 ```
 
 Note, though, that internationalisation files for languages other than British English have not yet been written, and that one is not complete.

resources/i18n/en-GB.edn

@@ -16,11 +16,40 @@
 
 ;; Actual fault messages to which fault codes resolve: English language version.
 {:by "by"
+ :cli-expected-format "Expected one of `csv`, `edn`, `json`, `html`."
+ :cli-expected-language "Expected a valid ISO 639-1 code, e.g. `en-GB`."
+ :cli-expected-one "Expected one of"
+ :cli-help-format "The format to output, one of `csv`, `edn`, `json`, `html`."
+ :cli-help-help "Print this message and exit."
+ :cli-help-input "The file or URL to validate."
+ :cli-help-language "The ISO 639-1 code for the language to output."
+ :cli-help-output "The file to write to."
+ :cli-help-reify "If set, reify objects referenced by URIs and check them."
+ :cli-help-severity "The minimum severity of faults to report."
  :expected-collection "A collection was expected, but was not found."
  :faults-found "The following faults were found"
  :generated-on "Generated on"
  :id-not-https "Publicly facing content SHOULD use HTTPS URIs"
  :id-not-uri "identifiers must be publicly dereferencable URIs"
+ :invalid-actor "The value of the `actor` property of an activity MUST be an instance of an Actor type"
+ :invalid-attachment "The value of the `attachment` property MUST be an instance of Object or of Link."
+ :invalid-attribution "The value of the `attributedTo` property MUST be an instance of Object or of Link, or a sequence or collection of such."
+ :invalid-audience "The value of the `audience` property MUST be an instance of Object or of Link, or a sequence or collection of such."
+ :invalid-closed "The value of the `closed` property MUST be one of: 1. an Object; 2. an xsd:dateTime; 3. a boolean."
+ :invalid-content "The value of the `content` property MUST be a string, optionally with embedded markup."
+ :invalid-context "The value of the `context` property (NOTE: different from `@context` MUST be an instance of Object or of Link, or a sequence or collection of such.)"
+ :invalid-date-time "The value of a property expected to be an instance of xsd:dateTime could not be parsed."
+ :invalid-deleted "The value of the `deleted` property of a Tombstone object MUST be an xsd:dateTime."
+ :invalid-describes "The value of the `describes` property MUST be an instance of Object."
+ :invalid-direct-object "The value of the `object` property of an Activity or Relationship MUST be an instance of Object or Link, or a sequence or collection of such."
+ :invalid-former-type "The value of the `formerType` property of a Tombstone object must be a string, naming a known Object type."
+ :invalid-duration "The value of the `duration` property MUST be an instance of xsd:duration."
+ :invalid-generator "The value of the `generator` property MUST be an instance of Object or of Link, or a sequence or collection of such."
+ :invalid-href "The value of the `href` property must be an instance of xsd:anyURI."
+ :invalid-image "The value of an `image` property MUST be an instance of the Image type."
+ :invalid-origin "The value of the `origin` property MUST be an Object."
+ :invalid-part-of "The value of the `partOf` property of a CollectionPage MUST be an instance of a Collection or an OrderedCollection."
+ :invalid-prior-page "The value of the `prev` property of a CollectionPage MUST be an instance of a Collection or an OrderedCollection."
  :no-context "Section 3 of the ActivityPub specification states Implementers SHOULD include the ActivityPub context in their object definitions`."
  :no-faults-found "No faults were found."
  :no-id-persistent "Persistent objects MUST have unique global identifiers."

src/dog_and_duck/quack/core.clj

@@ -5,11 +5,14 @@
             [clojure.string :refer [join]]
             [clojure.tools.cli :refer [parse-opts]]
             [clojure.walk :refer [keywordize-keys]]
+            [dog-and-duck.quack.control-variables :refer [*reify-refs*]]
             [dog-and-duck.quack.constants :refer [severity]]
             [dog-and-duck.quack.objects :refer [object-faults]]
-            [dog-and-duck.quack.utils :refer [filter-severity]]
+            [dog-and-duck.quack.utils :refer [filter-severity safe-keyword]]
             [hiccup.core :refer [html]]
-            [scot.weft.i18n.core :refer [get-message *config*]]
+            [scot.weft.i18n.core :refer [*config*
+                                         get-message 
+                                         parse-accept-language-header]]
             [trptr.java-wrapper.locale :as locale])
   (:gen-class))
 
@@ -36,24 +39,28 @@
 
 (def cli-options
   ;; An option with a required argument
-  [["-i" "--input SOURCE" "The file or URL to validate"
+  [["-i" "--input SOURCE" (get-message :cli-help-input)
-    :default "standard input"]
+    :default "standard in"]
-   ["-o" "--output DEST" "The file to write to, defaults to standard out"
+   ["-o" "--output DEST" (get-message :cli-help-output)
-    :default "standard output"]
+    :default "standard out"]
-   ["-f" "--format FORMAT" "The format to output, one of `edn` `csv` `html`"
+   ["-f" "--format FORMAT" (get-message :cli-help-format)
     :default :edn
-    :parse-fn #(keyword %)
+    :parse-fn #(safe-keyword %)
-    :validate [#(#{:csv :edn :html} %) "Expect one of `edn` `csv` `html`"]]
+    :validate [#(#{:csv :edn :json :html} %) (get-message :cli-expected-format)]]
-   ["-l" "--language LANG" "The ISO 639-1 code for the language to output"
+   ["-l" "--language LANG" (get-message :cli-help-language)
-    :default (-> (locale/get-default) locale/to-language-tag)]
+    :default (-> (locale/get-default) locale/to-language-tag)
-   ["-s" "--severity LEVEL" "The minimum severity of faults to report"
+    :validate [#(try (parse-accept-language-header %)
+                     (catch Exception _ false))
+               (get-message :cli-expected-language)]]
+   ["-s" "--severity LEVEL" (get-message :cli-help-severity)
     :default :info
-    :parse-fn #(keyword %)
+    :parse-fn #(safe-keyword %)
     :validate [#(severity %) (join " "
                                    (cons
-                                    "Expected one of"
+                                    (get-message :cli-expected-one)
                                     (map name severity)))]]
-   ["-h" "--help"]])
+   ["-r" "--reify" (get-message :cli-help-reify)]
+   ["-h" "--help" (get-message :cli-help-help)]])
 
 (defn validate
   [source]
@@ -126,7 +133,7 @@
 
 (defn output-html
   [faults options]
-  (let [source-name (if (= (:input options) *in*) "Standard input" (str (:input options)))
+  (let [source-name (if (= (:input options) *in*) "standard in" (str (:input options)))
         title (join " " [(get-message :validation-report-for) source-name])
         cols (set (reduce concat (map keys faults)))
         version (version-string)]
@@ -177,10 +184,10 @@
   [& args]
   (let [opts (parse-opts args cli-options)
         options (assoc (:options opts)
-                       :input (if (= (:input (:options opts)) "standard input")
+                       :input (if (= (:input (:options opts)) "standard in")
                                 *in*
                                 (:input (:options opts)))
-                       :output (if (= (:output (:options opts)) "standard output")
+                       :output (if (= (:output (:options opts)) "standard out")
                                  *out*
                                  (:output (:options opts))))]
     ;;(println options)
@@ -189,7 +196,8 @@
     (when (:errors opts)
       (println (:errors opts)))
     (when-not (or (:help options) (:errors options))
-      (binding [*config* (assoc *config* :default-language (:language options))]
+      (binding [*config* (assoc *config* :default-language (:language options))
+                *reify-refs* (:reify options)]
         (output
          (validate (:input options))
          options)))))

src/dog_and_duck/quack/objects.clj

@@ -2,30 +2,27 @@
   (:require [clojure.data.json :as json]
             [clojure.set :refer [union]]
             [dog-and-duck.quack.constants :refer [actor-types
-                                                        noun-types
+                                                  noun-types
-                                                        re-rfc5646]]
+                                                  re-rfc5646]]
             [dog-and-duck.quack.control-variables :refer [*reify-refs*]]
             [dog-and-duck.quack.time :refer [xsd-date-time?
-                                                   xsd-duration?]]
+                                             xsd-duration?]]
             [dog-and-duck.quack.utils :refer [concat-non-empty
-                                                    cond-make-fault-object
+                                              cond-make-fault-object
-                                                    has-activity-type?
+                                              fault-list?
-                                                    has-context?
+                                              has-activity-type?
-                                                    has-type?
+                                              has-context?
-                                                    has-type-or-fault
+                                              has-type?
-                                                    make-fault-object
+                                              has-type-or-fault
-                                                    nil-if-empty
+                                              make-fault-object
-                                                    object-or-uri?
+                                              nil-if-empty
-                                                    truthy?
+                                              object-or-uri?
-                                                    xsd-non-negative-integer?]]
+                                              truthy?
+                                              xsd-non-negative-integer?]]
             [taoensso.timbre :refer [warn]])
   (:import [java.io FileNotFoundException]
            [java.net URI URISyntaxException]))
 
-(defn- xsd-float?
-  [pv]
-  (or (integer? pv) (float? pv)))
-
 ;;;     Copyright (C) Simon Brooke, 2022
 
 ;;;     This program is free software; you can redistribute it and/or
@@ -42,6 +39,85 @@
 ;;;     along with this program; if not, write to the Free Software
 ;;;     Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 
+(declare object-faults)
+
+(defn- xsd-float?
+  [pv]
+  (or (integer? pv) (float? pv)))
+
+
+(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 _
+            (warn "Reification target" target "was not a valid URI.")
+            nil)
+          (catch FileNotFoundException _
+            (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 
+   
+   1. an object of `expected-type`;
+   2. a URI referencing an object of  `expected-type`; or
+   3. a link object referencing an object of  `expected-type`
+  
+   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, 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."
+  [value expected-type severity token]
+  (let [faults (cond
+                 (string? value) (maybe-reify-or-faults value severity token expected-type)
+                 (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
+                                  (nil? expected-type) 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))))
+
+
 (def object-expected-properties
   "Requirements of properties of object, cribbed from
    https://www.w3.org/TR/activitystreams-vocabulary/#properties
@@ -60,8 +136,9 @@
    * `: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;
-   * `:validator` a function of one argument returning a boolean, which will 
+   * `:validator` either a function of one argument returning a boolean, or
-      be applied to the value or values of the identified property."
+      a function of one argument returning either `nil` or a list of faults,
+      which will be applied to the value or values of the identified property."
   {:accuracy {:functional false
               :if-invalid [:must :invalid-number]
               :validator (fn [pv] (and (xsd-float? pv)
@@ -130,9 +207,6 @@
    :describes {:functional true
                :required (fn [x] (has-type? x "Profile"))
                :if-invalid [:must :invalid-describes]
-               ;; TODO: actually the spec says this MUST be an object and
-               ;; not a URI, which it doesn't say anywhere else, but this seems
-               ;; to make no sense?
                :validator object-or-uri?}
    :duration {:functional false
               :if-invalid [:must :invalid-duration]
@@ -160,11 +234,13 @@
                 :if-invalid [:must :invalid-former-type]
                 :required (fn [x] (has-type? x "Tombstone"))
                 ;; The narrative of the spec says this should be an `Object`,
-                ;; but in all the provided examples it's a string.
+                ;; but in all the provided examples it's a string. Furthermore,
+                ;; it seems it must name a known object type within the context.
                 :validator string?}
    :generator {:functional false
                :if-invalid [:must :invalid-generator]
-               :validator object-or-uri?}
+               :validator #(try (uri? (URI. %))
+                                (catch Exception _ false))}
    :height {:functional false
             :if-invalid [:must :invalid-non-negative]
             :validator xsd-non-negative-integer?}
@@ -255,19 +331,19 @@
            ;; that's hard to check.
            :if-invalid [:must :invalid-option]
            :validator object-or-uri?}
-   
+
    :orderedItems {:collection true
-           :functional false
+                  :functional false
-           :if-invalid [:must :invalid-items]
+                  :if-invalid [:must :invalid-items]
-           :if-missing [:must :no-items-or-pages]
+                  :if-missing [:must :no-items-or-pages]
-           :required (fn [x] (or (has-type? x "OrderedCollectionPage")
+                  :required (fn [x] (or (has-type? x "OrderedCollectionPage")
-                                 (and (has-type? x "OrderedCollection")
+                                        (and (has-type? x "OrderedCollection")
                                       ;; if it's a collection and has pages,
                                       ;; it doesn't need items.
-                                      (not (:current x))
+                                             (not (:current x))
-                                      (not (:first x))
+                                             (not (:first x))
-                                      (not (:last x)))))
+                                             (not (:last x)))))
-           :validator (fn [pv] (and (coll? pv) (every? object-or-uri? pv)))}
+                  :validator (fn [pv] (and (coll? pv) (every? object-or-uri? pv)))}
    :origin {:functional false
             :if-invalid [:must :invalid-origin]
             :validator object-or-uri?}
@@ -354,40 +430,58 @@
            :if-invalid [:must :invalid-width]
            :validator xsd-non-negative-integer?}})
 
-(defn check-property-required [obj prop clause]
+(defn check-property-required
+  "Check whether this `prop` of this `obj` is required with respect to 
+   this `clause`; if it is both required and missing, return a list of
+   one fault; else return `nil`."
+   [obj prop clause]
   (let [required (:required clause)
         [severity token] (:if-missing clause)]
     (when required
       (when
        (and (apply required (list obj)) (not (obj prop)))
-        (make-fault-object severity token)))))
+        (list (make-fault-object severity token))))))
 
 (defn check-property-valid
+  "Check that this `prop` of this `obj` is valid with respect to this `clause`.
+   
+   return `nil` if no faults are found, else a list of faults."
   [obj prop clause]
   ;; (info "obj" obj "prop" prop "clause" clause)
   (let [val (obj prop)
         validator (:validator clause)
         [severity token] (:if-invalid clause)]
     (when (and val validator)
-      (cond-make-fault-object
+      (let [r (apply validator (list val))
-       (apply validator (list val))
+            f (list (make-fault-object severity token))]
-       severity token))))
+        (cond
+          (true? r) nil
+          (nil? r) nil ;; that's OK, too, because it's a return
+                       ;; from an 'or-faults' function which did not
+                       ;; return faults
+          (fault-list? r) (concat f r)
+          (false? r) (list f)
+          :else (doall
+                 (warn "Unexpected return value from validator"
+                       {:return r
+                        :arguments {:object obj
+                                    :property prop
+                                    :clause clause}})
+                 f))))))
 
 (defn check-property [obj prop]
   (assert (map? obj))
   (assert (keyword? prop))
   (let [clause (object-expected-properties prop)]
-    (nil-if-empty
+    (concat-non-empty
-     (remove nil?
+     (check-property-required obj prop clause)
-             (list
+     (check-property-valid obj prop clause))))
-              (check-property-required obj prop clause)
-              (check-property-valid obj prop clause))))))
 
 (defn properties-faults
   "Return a lost of faults found on properties of the object `x`, or
    `nil` if none are."
   [x]
-  (apply 
+  (apply
    concat-non-empty
    (let [props (set (keys x))
          required (set
@@ -430,92 +524,21 @@
       (list
        (has-type-or-fault x expected-type :critical :unexpected-type))))))
 
-(def maybe-reify
+;; (defn coll-object-reference-or-fault
-  "If `*reify-refs*` is `true`, return the object at this `target` URI.
+;;   "As object-reference-or-fault, except `value` argument may also be a list of
-   Returns `nil` if
+;;    objects and/or object references."
-   
+;;   [value expected-type severity token]
-   1. `*reify-refs*` is false;
+;;   (cond
-   2. the object was not found;
+;;     (map? value) (object-reference-or-faults value expected-type severity token)
-   3. access to the object was not permitted.
+;;     (coll? value) (concat-non-empty
-   
+;;                    (map
-   Consequently, use with care."
+;;                     #(object-reference-or-faults
-  (memoize
+;;                       % expected-type severity token)
-   (fn [target]
+;;                     value))
-     (try (let [uri (URI. target)]
+;;     :else (throw
-            (when *reify-refs*
+;;            (ex-info
-              (json/read-str (slurp uri))))
+;;             "Argument `value` was not an object, a link to an object, nor a list of these."
-          (catch URISyntaxException _
+;;             {:arguments {:value value}
-            (warn "Reification target" target "was not a valid URI.")
+;;              :expected-type expected-type
-            nil)
+;;              :severity severity
-          (catch FileNotFoundException _
+;;              :token token}))))
-            (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 
-   
-   1. an object of `expected-type`;
-   2. a URI referencing an object of  `expected-type`; or
-   3. a link object referencing an object of  `expected-type`
-   
-   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, 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."
-  [value expected-type severity token]
-  (let [faults (cond
-                 (string? value) (maybe-reify-or-faults value severity token expected-type)
-                 (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
-                                  (nil? expected-type) 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 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) (concat-non-empty
-                   (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}))))

src/dog_and_duck/quack/scratch.clj

@@ -0,0 +1,16 @@
+(ns dog-and-duck.quack.scratch
+  "Development scratchpad"
+  (:require [dog-and-duck.quack.objects :refer [object-expected-properties]]
+            [dog-and-duck.quack.utils :refer [concat-non-empty]]))
+
+(defn missing-messages
+  [language]
+  (let [tokens (set
+                (reduce
+                 concat-non-empty
+                 (map #(list
+                        (second (:if-invalid %))
+                        (second (:if-missing %)))
+                      (vals object-expected-properties))))
+        found (read-string (slurp (str "resources/i18n/" language ".edn")))]
+    (sort (remove found tokens))))

src/dog_and_duck/quack/utils.clj

@@ -217,6 +217,16 @@
                           (warn "No narrative provided for fault token " fault)
                           (str fault)))))
 
+(defn fault-list? 
+  "Return `true` if `x` is a sequence of fault objects, else `false`."
+  [x]
+  (and
+   (coll? x)
+   (seq x)
+   (every?
+    #(has-type? % "Fault") x)))
+
+
 (defmacro nil-if-empty
   "if `x` is an empty collection, return `nil`; else return `x`."
   [x]
@@ -287,3 +297,8 @@
 ;;   ([value severity token pattern]
 ;;    (when not (and (string? value) (re-matches pattern value))
 ;;          (make-fault-object severity token))))
+
+(defn safe-keyword
+  "Create and return a keyword from `token` without any embedded colons!"
+  [token]
+  (keyword (clojure.string/replace (str token) #"[^a-zA-Z-]*" "")))