001 (ns dog-and-duck.quack.picky.utils
002 "Utility functions supporting the picky validator"
003 (:require [clojure.data.json :as json]
004 [clojure.set :refer [intersection]]
005 [dog-and-duck.quack.picky.constants :refer [activitystreams-context-uri
006 actor-types
007 context-key severity-filters
008 validation-fault-context-uri
009 verb-types]]
010 [dog-and-duck.quack.picky.control-variables :refer [*reify-refs*]]
011 [dog-and-duck.quack.picky.fault-messages :refer [messages]]
012 [dog-and-duck.utils.process :refer [get-hostname get-pid]]
013 [taoensso.timbre :as log :refer [warn]])
014
015 (:import [java.net URI URISyntaxException]))
016
017 ;;; Copyright (C) Simon Brooke, 2022
018
019 ;;; This program is free software; you can redistribute it and/or
020 ;;; modify it under the terms of the GNU General Public License
021 ;;; as published by the Free Software Foundation; either version 2
022 ;;; of the License, or (at your option) any later version.
023
024 ;;; This program is distributed in the hope that it will be useful,
025 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
026 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
027 ;;; GNU General Public License for more details.
028
029 ;;; You should have received a copy of the GNU General Public License
030 ;;; along with this program; if not, write to the Free Software
031 ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
032
033
034 (defn actor-type?
035 "Return `true` if the `x` is a recognised actor type, else `false`."
036 [^String x]
037 (if (actor-types x) true false))
038
039 (defn truthy?
040 "Return `true` if `x` is truthy, else `false`. There must be some more
041 idiomatic way to do this?"
042 [x]
043 (if x true false))
044
045 (defn has-type?
046 "Return `true` if object `x` has type `type`, else `false`.
047
048 The values of `type` fields of ActivityStreams objects may be lists; they
049 are considered to have a type if the type token is a member of the list."
050 [x type]
051 (assert (map? x) (string? type))
052 (let [tv (:type x)]
053 (cond
054 (coll? tv) (truthy? (not-empty (filter #(= % type) tv)))
055 :else (= tv type))))
056
057 (defn object-or-uri?
058 "Very basic check that `x` is either an object or a URI."
059 [x]
060 (try
061 (cond (string? x) (uri? (URI. x))
062 (map? x) (if (and (:type x) (:id x)) true false)
063 :else false)
064 (catch URISyntaxException _ false)
065 (catch NullPointerException _ false)))
066
067 (defmacro link-or-uri?
068 "Very basic check that `x` is either a link object or a URI."
069 [x]
070 `(if (object-or-uri? ~x) (has-type? ~x "Link") false))
071
072
073 (defn verb-type?
074 "`true` if `x`, a string, represents a recognised ActivityStreams activity
075 type."
076 [^String x]
077 (if (verb-types x) true false))
078
079 (defn has-activity-type?
080 "Return `true` if the object `x` has a type which is an activity type, else
081 `false`."
082 [x]
083 (let [tv (:type x)]
084 (cond
085 (coll? tv) (truthy? (not-empty (filter verb-type? tv)))
086 :else (verb-type? tv))))
087
088 (defn has-actor-type?
089 "Return `true` if the object `x` has a type which is an actor type, else
090 `false`."
091 [x]
092 (let [tv (:type x)]
093 (cond
094 (coll? tv) (truthy? (not-empty (filter actor-type? tv)))
095 :else (actor-type? tv))))
096
097 (defn filter-severity
098 "Return a list of reports taken from these `reports` where the severity
099 of the report is greater than this or equal to this `severity`."
100 [reports severity]
101 (cond (nil? reports) nil
102 (and
103 (coll? reports)
104 (every? map? reports)
105 (every? :severity reports)) (remove
106 #((severity-filters severity) (:severity %))
107 reports)
108 :else
109 (throw
110 (ex-info
111 "Argument `reports` was not a collection of fault reports"
112 {:arguments {:reports reports
113 :severity severity}}))))
114
115 (defn context?
116 "Returns `true` iff `x` quacks like an ActivityStreams context, else false.
117
118 A context is either
119 1. the URI (actually an IRI) `activitystreams-context-uri`, or
120 2. a collection comprising that URI and a map."
121 [x]
122 (cond
123 (nil? x) false
124 (string? x) (and (= x activitystreams-context-uri) true)
125 (coll? x) (and (context? (first (remove map? x)))
126 (= (count x) 2)
127 true)
128 :else false))
129
130 (defmacro has-context?
131 "True if `x` is an ActivityStreams object with a valid context, else `false`."
132 [x]
133 `(context? (context-key ~x)))
134
135 (defn make-fault-object
136 "Return a fault object with these `severity`, `fault` and `narrative` values.
137
138 An ActivityPub object MUST have a globally unique ID. Whether this is
139 meaningful depends on whether we persist fault report objects and serve
140 them, which at present I have no plans to do."
141 ;; TODO: should not pass in the narrative; instead should use the :fault value
142 ;; to look up the narrative in a resource file.
143 [severity fault]
144 (assoc {}
145 context-key validation-fault-context-uri
146 :id (str "https://"
147 (get-hostname)
148 "/fault/"
149 (get-pid)
150 ":"
151 (inst-ms (java.util.Date.)))
152 :type "Fault"
153 :severity severity
154 :fault fault
155 :narrative (or (messages fault)
156 (do
157 (warn "No narrative provided for fault token " fault)
158 (str fault)))))
159
160 (defmacro nil-if-empty
161 "if `x` is an empty collection, return `nil`; else return `x`."
162 [x]
163 `(if (and (coll? ~x) (empty? ~x)) nil
164 ~x))
165
166 (defn concat-non-empty
167 "Quick function to replace the pattern (nil-if-empty (remove nil? (concat ...)))
168 which I'm using a lot!"
169 [& lists]
170 (nil-if-empty (remove nil? (apply concat lists))))
171
172 (defn has-type-or-fault
173 "If object `x` has a `:type` value which is `acceptable`, return `nil`;
174 else return a fault object with this `severity` and `token`.
175
176 `acceptable` may be passed as either nil, a string, or a set of strings.
177 If `acceptable` is `nil`, no type specific tests will be performed."
178 [x acceptable severity token]
179 (when acceptable
180 (let [tv (:type x)]
181 (when-not
182 (cond
183 (and (string? tv) (string? acceptable)) (= tv acceptable)
184 (and (string? tv) (set? acceptable)) (acceptable tv)
185 (and (coll? tv) (string? acceptable)) ((set tv) acceptable)
186 (and (coll? tv) (set? acceptable)) (not-empty
187 (intersection (set tv) acceptable))
188 :else
189 (throw (ex-info "Type value or `acceptable` argument not as expected."
190 {:arguments {:x x
191 :acceptable acceptable
192 :severity severity
193 :token token}})))
194 (make-fault-object severity token)))))
195
196 (defn any-or-faults
197 "Return `nil` if validating one of these options returns `nil`; otherwise
198 return a list comprising a fault report object with this `severity-if-none`
199 and this token followed by all the fault reports from validating each
200 option.
201
202 There are several places - but especially in validating collections - where
203 there are several different valid configurations, but few or no properties
204 are always required."
205 [options severity-if-none token]
206 (let [faults (filter empty? options)]
207 (when (empty? faults)
208 ;; i.e. there was at least one option that returned no faults...
209 (cons (make-fault-object severity-if-none token) faults))))
210
211 (defmacro cond-make-fault-object
212 "If `v` is `false` or `nil`, return a fault object with this `severity` and `token`,
213 else return nil."
214 [v severity token]
215 `(when-not ~v (make-fault-object ~severity ~token)))
216
217 (defn string-or-fault
218 "If this `value` is not a string, return a fault object with this `severity`
219 and `token`, else `nil`. If `pattern` is also passed, it is expected to be
220 a Regex, and the fault object will be returned unless `value` matches the
221 `pattern`."
222 ([value severity token]
223 (when-not (string? value) (make-fault-object severity token)))
224 ([value severity token pattern]
225 (when not (and (string? value) (re-matches pattern value))
226 (make-fault-object severity token))))
227
228
229 (defn object-faults
230 "Return a list of faults found in object `x`, or `nil` if none are.
231
232 If `expected-type` is also passed, verify that `x` has `expected-type`.
233 `expected-type` may be passed as a string or as a set of strings. Detailed
234 verification of the particular features of types is not done here."
235 ([x]
236 (nil-if-empty
237 (remove empty?
238 (list
239 (when-not (map? x)
240 (make-fault-object :critical :not-an-object))
241 (when-not
242 (has-context? x)
243 (make-fault-object :should :no-context))
244 (when-not (:type x)
245 (make-fault-object :minor :no-type))
246 (when-not (and (map? x) (contains? x :id))
247 (make-fault-object :minor :no-id-transient))))))
248 ([x expected-type]
249 (concat-non-empty
250 (object-faults x)
251 (when expected-type
252 (list
253 (has-type-or-fault x expected-type :critical :unexpected-type))))))
254
255
256 (defn object-reference-or-faults
257 "If this `value` is either
258
259 1. an object of `expected-type`;
260 2. a URI referencing an object of `expected-type`; or
261 3. a link object referencing an object of `expected-type`
262
263 and no faults are returned from validating the linked object, then return
264 `nil`; else return a sequence comprising a fault object with this `severity`
265 and `token`, prepended to the faults returned.
266
267 As with `has-type-or-fault` (q.v.), `expected-type` may be passed as a
268 string, as a set of strings, or `nil` (indicating the type of the
269 referenced object should not be checked).
270
271 **NOTE THAT** if `*reify-refs*` is `false`, referenced objects will not
272 actually be checked."
273 [value expected-type severity token]
274 (let [faults (cond
275 (string? value) (try (let [uri (URI. value)
276 object (when *reify-refs*
277 (json/read-str (slurp uri)))]
278 (when object
279 (object-faults object expected-type)))
280 (catch URISyntaxException _
281 (make-fault-object severity token)))
282 (map? value) (if (has-type? value "Link")
283 (cond
284 ;; if we were looking for a link and we've
285 ;; found a link, that's OK.
286 (= expected-type "Link") nil
287 (and (set? expected-type) (expected-type "Link")) nil
288 (nil? expected-type) nil
289 :else
290 (object-reference-or-faults
291 (:href value) expected-type severity token))
292 (object-faults value expected-type))
293 :else (throw
294 (ex-info
295 "Argument `value` was not an object or a link to an object"
296 {:arguments {:value value}
297 :expected-type expected-type
298 :severity severity
299 :token token})))]
300 (when faults (cons (make-fault-object severity token) faults))))
301
302 (defn coll-object-reference-or-fault
303 "As object-reference-or-fault, except `value` argument may also be a list of
304 objects and/or object references."
305 [value expected-type severity token]
306 (cond
307 (map? value) (object-reference-or-faults value expected-type severity token)
308 (coll? value) (concat-non-empty
309 (map
310 #(object-reference-or-faults
311 % expected-type severity token)
312 value))
313 :else (throw
314 (ex-info
315 "Argument `value` was not an object, a link to an object, nor a list of these."
316 {:arguments {:value value}
317 :expected-type expected-type
318 :severity severity
319 :token token}))))