Refactoring; internationalisation. Many tests failing.
This commit is contained in:
parent
e3f5078e9b
commit
d26300f8c4
12 changed files with 263 additions and 215 deletions
|
|
@ -1,22 +1,16 @@
|
|||
(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]]
|
||||
(:require [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
|
||||
xsd-date-time-pattern]]
|
||||
[dog-and-duck.quack.picky.control-variables :refer [*reify-refs*]]
|
||||
[dog-and-duck.quack.picky.fault-messages :refer [messages]]
|
||||
verb-types]]
|
||||
[dog-and-duck.utils.process :refer [get-hostname get-pid]]
|
||||
[scot.weft.i18n.core :refer [get-message]]
|
||||
[taoensso.timbre :as log :refer [warn]])
|
||||
|
||||
(:import [java.io FileNotFoundException]
|
||||
[java.net URI URISyntaxException]
|
||||
[java.time.format DateTimeParseException]))
|
||||
(:import [java.net URI URISyntaxException]))
|
||||
|
||||
;;; Copyright (C) Simon Brooke, 2022
|
||||
|
||||
|
|
@ -156,7 +150,7 @@
|
|||
:type "Fault"
|
||||
:severity severity
|
||||
:fault fault
|
||||
:narrative (or (messages fault)
|
||||
:narrative (or (get-message fault)
|
||||
(do
|
||||
(warn "No narrative provided for fault token " fault)
|
||||
(str fault)))))
|
||||
|
|
@ -230,154 +224,4 @@
|
|||
(when-not (string? value) (make-fault-object severity token)))
|
||||
([value severity token pattern]
|
||||
(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.
|
||||
|
||||
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?
|
||||
(list
|
||||
(when-not (map? x)
|
||||
(make-fault-object :critical :not-an-object))
|
||||
(when-not
|
||||
(has-context? x)
|
||||
(make-fault-object :should :no-context))
|
||||
(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))
|
||||
(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)
|
||||
(when expected-type
|
||||
(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
|
||||
|
||||
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}))))
|
||||
(make-fault-object severity token))))
|
||||
Loading…
Add table
Add a link
Reference in a new issue