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

More refactoring.

Browse source
This commit is contained in:
Simon Brooke 2022-12-25 15:15:33 +00:00
parent a4b0e43a76
commit 09ebdafff5
2 changed files with 55 additions and 53 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

100
src/dog_and_duck/quack/picky.clj
View file

@ -29,7 +29,8 @@
ActivityStreams spec." ActivityStreams spec."
(:require [dog-and-duck.quack.picky.constants :refer [actor-types]] (:require [dog-and-duck.quack.picky.constants :refer [actor-types]]
[dog-and-duck.quack.picky.control-variables :refer [*reify-refs*]] [dog-and-duck.quack.picky.control-variables :refer [*reify-refs*]]
[dog-and-duck.quack.picky.utils :refer [has-context? [dog-and-duck.quack.picky.utils :refer [concat-non-empty
has-context?
has-activity-type? has-activity-type?
has-actor-type? has-type? has-actor-type? has-type?
has-type-or-fault has-type-or-fault
@ -73,14 +74,12 @@
(when-not (and (map? x) (contains? x :id)) (when-not (and (map? x) (contains? x :id))
(make-fault-object :minor :no-id-transient)))))) (make-fault-object :minor :no-id-transient))))))
([x expected-type] ([x expected-type]
(nil-if-empty (concat-non-empty
(remove empty? (object-faults x)
(concat (list
(object-faults x)
(list
;; TODO: should resolve the correct `-faults`function for the ;; TODO: should resolve the correct `-faults`function for the
;; `expected-type` and call that; but that's for later. ;; `expected-type` and call that; but that's for later.
(has-type-or-fault x expected-type :critical :unexpected-type))))))) (has-type-or-fault x expected-type :critical :unexpected-type)))))
(defn uri-or-fault (defn uri-or-fault
"If `u` is not a valid URI, return a fault object with this `severity` and "If `u` is not a valid URI, return a fault object with this `severity` and
@ -100,35 +99,37 @@
(defn persistent-object-faults (defn persistent-object-faults
"Return a list of faults found in persistent object `x`, or `nil` if none are." "Return a list of faults found in persistent object `x`, or `nil` if none are."
[x] ([x]
(nil-if-empty (concat-non-empty
(remove empty? (object-faults x)
(concat (list
(object-faults x) (if (contains? x :id)
(list (try (let [id (URI. (:id x))]
(if (contains? x :id) (when-not (= (.getScheme id) "https")
(try (let [id (URI. (:id x))] (make-fault-object :should :id-not-https)))
(when-not (= (.getScheme id) "https") (catch URISyntaxException _
(make-fault-object :should :id-not-https))) (make-fault-object :must :id-not-uri))
(catch URISyntaxException _ (catch NullPointerException _
(make-fault-object :must :id-not-uri)) (make-fault-object :must :null-id-persistent)))
(catch NullPointerException _ (make-fault-object :must :no-id-persistent)))))
(make-fault-object :must :null-id-persistent))) ([x types severity token]
(make-fault-object :must :no-id-persistent))))))) (concat-non-empty
(persistent-object-faults x)
(list
(has-type-or-fault x types severity token)))))
(defn actor-faults (defn actor-faults
"Return a list of faults found in actor `x`, or `nil` if none are." "Return a list of faults found in actor `x`, or `nil` if none are."
[x] [x]
(nil-if-empty (concat-non-empty
(remove empty? (persistent-object-faults x)
(concat (persistent-object-faults x) (list
(list (when-not (has-actor-type? x)
(when-not (has-actor-type? x) (make-fault-object :must :not-actor-type))
(make-fault-object :must :not-actor-type)) (uri-or-fault
(uri-or-fault (:inbox x) :must :no-inbox :invalid-inbox-uri)
(:inbox x) :must :no-inbox :invalid-inbox-uri) (uri-or-fault
(uri-or-fault (:outbox x) :must :no-outbox :invalid-outbox-uri))))
(:outbox x) :must :no-outbox :invalid-outbox-uri))))))
(defn string-or-fault (defn string-or-fault
"If this `value` is not a string, return a fault object with this `severity` "If this `value` is not a string, return a fault object with this `severity`
@ -191,13 +192,11 @@
[value expected-type severity token] [value expected-type severity token]
(cond (cond
(map? value) (object-reference-or-faults value expected-type severity token) (map? value) (object-reference-or-faults value expected-type severity token)
(coll? value) (nil-if-empty (coll? value) (concat-non-empty
(remove nil? (map
(reduce concat #(object-reference-or-faults
(map % expected-type severity token)
#(object-reference-or-faults value))
% expected-type severity token)
value))))
:else (throw :else (throw
(ex-info (ex-info
"Argument `value` was not an object, a link to an object, nor a list of these." "Argument `value` was not an object, a link to an object, nor a list of these."
@ -211,16 +210,14 @@
`rel` | `mediaType` | `name` | `hreflang` | `height` | `width` | `preview` `rel` | `mediaType` | `name` | `hreflang` | `height` | `width` | `preview`
but I *think* they're all optional." but I *think* they're all optional."
[x] [x]
(nil-if-empty (concat-non-empty
(remove empty? (object-reference-or-faults x "Link" :critical :expected-link)
(concat (list
(object-reference-or-faults x "Link" :critical :expected-link) (uri-or-fault
(list (:href x) :must :no-href-uri :invalid-href-uri)
(uri-or-fault (string-or-fault (:mediaType x) :minor :no-media-type #"\w+\/[-+.\w]+")
(:href x) :must :no-href-uri :invalid-href-uri)
(string-or-fault (:mediaType x) :minor :no-media-type #"\w+\/[-+.\w]+")
;; TODO: possibly more here. Audit against the specs ;; TODO: possibly more here. Audit against the specs
))))) )))
(def ^:const base-activity-required-properties (def ^:const base-activity-required-properties
"Properties most activities should have. Values are validating functions, each. "Properties most activities should have. Values are validating functions, each.
@ -305,12 +302,11 @@
(defn activity-faults (defn activity-faults
[x] [x]
(nil-if-empty (concat-non-empty (persistent-object-faults x)
(remove empty?
(concat (persistent-object-faults x)
(activity-type-faults x) (activity-type-faults x)
(list (list
(when-not (when-not
(has-activity-type? x) (has-activity-type? x)
(make-fault-object :must :not-activity-type)) (make-fault-object :must :not-activity-type))
(when-not (string? (:summary x)) (make-fault-object :should :no-summary))))))) (when-not (string? (:summary x)) (make-fault-object :should :no-summary)))))

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

@ -144,6 +144,12 @@
`(if (and (coll? ~x) (empty? ~x)) nil `(if (and (coll? ~x) (empty? ~x)) nil
~x)) ~x))
(defn concat-non-empty
"Quick function to replace the pattern (nil-if-empty (remove nil? (concat ...)))
which I'm using a lot!"
[& lists]
(nil-if-empty (remove nil? (apply concat lists))))
(defn has-type-or-fault (defn has-type-or-fault
"If object `x` has a `:type` value which is `acceptable`, return `nil`; "If object `x` has a `:type` value which is `acceptable`, return `nil`;
else return a fault object with this `severity` and `token`. else return a fault object with this `severity` and `token`.