simon/quack
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Working on completing the English messages dictionary.

Browse source 
Also started work on getting reify working...
This commit is contained in:
Simon Brooke 2023-01-10 16:53:42 +00:00
parent 6fb60dfe50
commit a185edb9da
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
7 changed files with 254 additions and 160 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -13,3 +13,5 @@ pom.xml.asc
.nrepl-port
.cpcache/
.calva
.clj-kondo
.lsp

13
README.md
View file

@ -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.

29
resources/i18n/en-GB.edn
View file

@ -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."

46
src/dog_and_duck/quack/core.clj
View file

@ -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)))))

287
src/dog_and_duck/quack/objects.clj
View file

@ -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?}
@ -257,17 +333,17 @@
: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,34 +430,52 @@
: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
@ -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}))))

16
src/dog_and_duck/quack/scratch.clj Normal file
View file

@ -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))))

15
src/dog_and_duck/quack/utils.clj
View file

@ -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-]*" "")))