simon/dog-and-duck
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Close, but no cigar.

Browse source
This commit is contained in:
Simon Brooke 2023-01-08 21:29:36 +00:00
parent 34847058fc
commit 98e3c7b4e7
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
5 changed files with 107 additions and 36 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

89
src/dog_and_duck/quack/picky/objects.clj
View file

@ -9,6 +9,7 @@
xsd-date-time?
xsd-duration?]]
[dog-and-duck.quack.picky.utils :refer [concat-non-empty
cond-make-fault-object
has-activity-type?
has-context?
has-type?
@ -18,7 +19,7 @@
object-or-uri?
truthy?
xsd-non-negative-integer?]]
[taoensso.timbre :refer [warn]])
[taoensso.timbre :refer [info warn]])
(:import [java.io FileNotFoundException]
[java.net URI URISyntaxException]))
@ -77,7 +78,7 @@
:validator xsd-float?}
:anyOf {:collection true
:functional false
;; a Question should have a `:oneOf` ot `:anyOf`, but at this layer
;; a Question should have a `:oneOf` or `:anyOf`, but at this layer
;; that's hard to check.
:if-invalid [:must :invalid-option]
:validator object-or-uri?}
@ -196,21 +197,21 @@
:functional false
:if-invalid [:must :invalid-items]
:if-missing [:must :no-items-or-pages]
:required (fn [x] (or (has-type? x #{"CollectionPage"
"OrderedCollectionPage"})
(and (has-type? x #{"Collection"
"OrderedCollection"})
:required (fn [x] (or (has-type? x "CollectionPage")
(and (has-type? x "Collection")
;; if it's a collection and has pages,
;; it doesn't need items.
(not (:current x))
(not (:first x))
(not (:last x)))))
:validator object-or-uri?}
:validator (fn [pv] (and (coll? pv) (every? object-or-uri? pv)))}
:last {:functional true
:if-missing [:minor :paged-collection-no-last]
:if-invalid [:must :paged-collection-invalid-last]
:required (fn [x] (if (try (uri? (URI. x))
(catch URISyntaxException _ false))
:required (fn [x] (if (and
(string? x)
(try (uri? (URI. x))
(catch URISyntaxException _ false)))
true
;; if an object is a collection which has pages,
;; it ought to have a `:last` page. But
@ -255,8 +256,21 @@
;; 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")
;; 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)))}
:origin {:functional false
:if-invalid :invalid-origin
:if-invalid [:must :invalid-origin]
:validator object-or-uri?}
:partOf {:functional true
:if-missing [:must :missing-part-of]
@ -341,24 +355,48 @@
:if-invalid [:must :invalid-width]
:validator xsd-non-negative-integer?}})
(defn- check-property [x p]
#(let [c (object-expected-properties x)
r (:required c)
[s m] (:if-missing c)]
(when (and r (r x) (not (x p)))
(make-fault-object s m))))
(defn check-property-required [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)))))
(defn check-property-valid
[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))))
(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))))))
(defn properties-faults
"Return a lost of faults found on properties of the object `x`, or
`nil` if none are."
[x]
(nil-if-empty
(apply
concat-non-empty
(let [props (set (keys x))
required (filter
required (set
(filter
#((object-expected-properties %) :required)
(keys object-expected-properties))]
(keys object-expected-properties)))]
(map
#(check-property x %)
(fn [p] (check-property x p))
(union props required)))))
(defn object-faults
@ -373,7 +411,7 @@
;; https://www.w3.org/TR/activitystreams-vocabulary/#properties
;; if these properties are present, these types should be checked.
([x]
(nil-if-empty
(concat-non-empty
(remove empty?
(list
(when-not (map? x)
@ -384,13 +422,8 @@
(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)))))
(make-fault-object :minor :no-id-transient))))
(properties-faults x)))
([x expected-type]
(concat-non-empty
(object-faults x)

2
src/dog_and_duck/quack/picky/required_properties.clj
View file

@ -1,2 +0,0 @@
(ns dog-and-duck.quack.picky.required-properties)

34
src/dog_and_duck/quack/picky/scratch.clj Normal file
View file

@ -0,0 +1,34 @@
(ns dog-and-duck.quack.picky.scratch
"Development scratchpad"
(:require [clojure.data.json :refer [read-str]]
[clojure.java.io :refer [file]]
[clojure.walk :refer [keywordize-keys]]
[dog-and-duck.quack.picky.objects :refer
[object-faults]]
[dog-and-duck.quack.picky.utils :refer [concat-non-empty]]))
(def r
(remove
nil?
(map
#(try
(let [contents (read-str (slurp %))
faults (cond (map? contents) (object-faults
(keywordize-keys contents))
;; (coll? contents) (apply
;; concat-non-empty
;; (map (fn [obj]
;; (object-faults
;; (keywordize-keys obj)))
;; contents))
)]
(when-not (nil? faults)
[(.getName %) faults]))
(catch Exception any
[(.getName %) (str "Exception "
(.getName (.getClass any))
": "
(.getMessage any))]))
(filter
#(and (.isFile %) (.endsWith (.getName %) ".json"))
(file-seq (file "resources/activitystreams-test-documents"))))))

10
src/dog_and_duck/quack/picky/time.clj
View file

@ -4,7 +4,7 @@
make-fault-object
truthy?]]
[scot.weft.i18n.core :refer [get-message]]
[taoensso.timbre :refer [warn]])
[taoensso.timbre :refer [warn error]])
(:import [java.time LocalDateTime]
[java.time.format DateTimeFormatter DateTimeParseException]
[javax.xml.datatype DatatypeFactory]))
@ -33,6 +33,9 @@
(if (LocalDateTime/from (.parse DateTimeFormatter/ISO_DATE_TIME value)) true false)
(catch DateTimeParseException _
(warn (get-message :bad-date-time) ":" value)
false)
(catch Exception e
(error "Exception thrown while parsing date" value e)
false)))
(defn xsd-duration?
@ -41,9 +44,12 @@
[value]
(truthy?
(and (string? value)
(try (DatatypeFactory/newDuration value)
(try (.newDuration (DatatypeFactory/newInstance) value)
(catch IllegalArgumentException _
(warn (get-message :bad-duration) ":" value)
false)
(catch Exception e
(error "Exception thrown while parsing duration" value e)
false)))))
(defn date-time-property-or-fault

6
src/dog_and_duck/quack/picky/utils.clj
View file

@ -70,7 +70,7 @@
([x]
(try
(cond (string? x) (uri? (URI. x))
(map? x) (if (and (:type x) (:id x)) true false)
(map? x) true
:else false)
(catch URISyntaxException _ false)
(catch NullPointerException _ false)))
@ -228,11 +228,11 @@
;; i.e. there was at least one option that returned no faults...
(cons (make-fault-object severity-if-none token) faults))))
(defmacro cond-make-fault-object
(defn cond-make-fault-object
"If `v` is `false` or `nil`, return a fault object with this `severity` and `token`,
else return nil."
[v severity token]
`(when-not ~v (make-fault-object ~severity ~token)))
(when-not v (make-fault-object severity token)))
(defn string-or-fault
"If this `value` is not a string, return a fault object with this `severity`