diff --git a/.gitignore b/.gitignore index 1b1dd65..35710fa 100644 --- a/.gitignore +++ b/.gitignore @@ -12,4 +12,6 @@ pom.xml.asc .lein-failures .nrepl-port .cpcache/ -.calva \ No newline at end of file +.calva +.clj-kondo +.lsp diff --git a/README.md b/README.md index 7d51045..0a048c8 100644 --- a/README.md +++ b/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 - -o, --output DEST standard output The file to write to, defaults to standard out - -f, --format FORMAT :edn The format to output, one of `edn` `csv` `html` - -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 - -h, --help Print this message and exit + -i, --input SOURCE standard in The file or URL to validate. + -o, --output DEST standard out The file to write to. + -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. + -s, --severity LEVEL :info The minimum severity of faults to report. + -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. diff --git a/resources/i18n/en-GB.edn b/resources/i18n/en-GB.edn index 949cf19..9af0cde 100644 --- a/resources/i18n/en-GB.edn +++ b/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." diff --git a/src/dog_and_duck/quack/core.clj b/src/dog_and_duck/quack/core.clj index 090db21..db7937b 100644 --- a/src/dog_and_duck/quack/core.clj +++ b/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" - :default "standard input"] - ["-o" "--output DEST" "The file to write to, defaults to standard out" - :default "standard output"] - ["-f" "--format FORMAT" "The format to output, one of `edn` `csv` `html`" + [["-i" "--input SOURCE" (get-message :cli-help-input) + :default "standard in"] + ["-o" "--output DEST" (get-message :cli-help-output) + :default "standard out"] + ["-f" "--format FORMAT" (get-message :cli-help-format) :default :edn - :parse-fn #(keyword %) - :validate [#(#{:csv :edn :html} %) "Expect one of `edn` `csv` `html`"]] - ["-l" "--language LANG" "The ISO 639-1 code for the language to output" - :default (-> (locale/get-default) locale/to-language-tag)] - ["-s" "--severity LEVEL" "The minimum severity of faults to report" + :parse-fn #(safe-keyword %) + :validate [#(#{:csv :edn :json :html} %) (get-message :cli-expected-format)]] + ["-l" "--language LANG" (get-message :cli-help-language) + :default (-> (locale/get-default) locale/to-language-tag) + :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))))) \ No newline at end of file diff --git a/src/dog_and_duck/quack/objects.clj b/src/dog_and_duck/quack/objects.clj index c4826e4..9dc46ad 100644 --- a/src/dog_and_duck/quack/objects.clj +++ b/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 - re-rfc5646]] + noun-types + 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 - has-activity-type? - has-context? - has-type? - has-type-or-fault - make-fault-object - nil-if-empty - object-or-uri? - truthy? - xsd-non-negative-integer?]] + cond-make-fault-object + fault-list? + has-activity-type? + has-context? + has-type? + has-type-or-fault + make-fault-object + nil-if-empty + object-or-uri? + 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 - be applied to the value or values of the identified property." + * `:validator` either a function of one argument returning a boolean, or + 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 - :if-invalid [:must :invalid-items] - :if-missing [:must :no-items-or-pages] - :required (fn [x] (or (has-type? x "OrderedCollectionPage") - (and (has-type? x "OrderedCollection") + :functional false + :if-invalid [:must :invalid-items] + :if-missing [:must :no-items-or-pages] + :required (fn [x] (or (has-type? x "OrderedCollectionPage") + (and (has-type? x "OrderedCollection") ;; if it's a collection and has pages, ;; it doesn't need items. - (not (:current x)) - (not (:first x)) - (not (:last x))))) - :validator (fn [pv] (and (coll? pv) (every? object-or-uri? pv)))} + (not (:current x)) + (not (:first x)) + (not (:last x))))) + :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 - (apply validator (list val)) - severity token)))) + (let [r (apply validator (list val)) + f (list (make-fault-object 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 - (remove nil? - (list - (check-property-required obj prop clause) - (check-property-valid obj prop clause)))))) + (concat-non-empty + (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 - "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)))) - -(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})))) +;; (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})))) diff --git a/src/dog_and_duck/quack/scratch.clj b/src/dog_and_duck/quack/scratch.clj new file mode 100644 index 0000000..7a6e1d0 --- /dev/null +++ b/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)))) \ No newline at end of file diff --git a/src/dog_and_duck/quack/utils.clj b/src/dog_and_duck/quack/utils.clj index 6d2abf4..29d97db 100644 --- a/src/dog_and_duck/quack/utils.clj +++ b/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-]*" "")))