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