diff --git a/src/dog_and_duck/quack/picky/objects.clj b/src/dog_and_duck/quack/picky/objects.clj index 27a542e..9d4b730 100644 --- a/src/dog_and_duck/quack/picky/objects.clj +++ b/src/dog_and_duck/quack/picky/objects.clj @@ -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 - #((object-expected-properties %) :required) - (keys object-expected-properties))] + required (set + (filter + #((object-expected-properties %) :required) + (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) diff --git a/src/dog_and_duck/quack/picky/required_properties.clj b/src/dog_and_duck/quack/picky/required_properties.clj deleted file mode 100644 index aeedcde..0000000 --- a/src/dog_and_duck/quack/picky/required_properties.clj +++ /dev/null @@ -1,2 +0,0 @@ -(ns dog-and-duck.quack.picky.required-properties) - diff --git a/src/dog_and_duck/quack/picky/scratch.clj b/src/dog_and_duck/quack/picky/scratch.clj new file mode 100644 index 0000000..b2f1e0d --- /dev/null +++ b/src/dog_and_duck/quack/picky/scratch.clj @@ -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")))))) diff --git a/src/dog_and_duck/quack/picky/time.clj b/src/dog_and_duck/quack/picky/time.clj index 4f622ec..00b84fb 100644 --- a/src/dog_and_duck/quack/picky/time.clj +++ b/src/dog_and_duck/quack/picky/time.clj @@ -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 diff --git a/src/dog_and_duck/quack/picky/utils.clj b/src/dog_and_duck/quack/picky/utils.clj index 11f82f7..3d0342b 100644 --- a/src/dog_and_duck/quack/picky/utils.clj +++ b/src/dog_and_duck/quack/picky/utils.clj @@ -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`