(ns dog-and-duck.quack.picky.utils "Utility functions supporting the picky validator" (:require [clojure.data.json :as json] [clojure.set :refer [intersection]] [dog-and-duck.quack.picky.constants :refer [activitystreams-context-uri actor-types context-key severity-filters validation-fault-context-uri verb-types]] [dog-and-duck.quack.picky.control-variables :refer [*reify-refs*]] [dog-and-duck.quack.picky.fault-messages :refer [messages]] [dog-and-duck.utils.process :refer [get-hostname get-pid]] [taoensso.timbre :as log :refer [warn]]) (:import [java.net URI URISyntaxException])) ;;; Copyright (C) Simon Brooke, 2022 ;;; This program is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU General Public License ;;; as published by the Free Software Foundation; either version 2 ;;; of the License, or (at your option) any later version. ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. (defn actor-type? "Return `true` if the `x` is a recognised actor type, else `false`." [^String x] (if (actor-types x) true false)) (defn truthy? "Return `true` if `x` is truthy, else `false`. There must be some more idiomatic way to do this?" [x] (if x true false)) (defn has-type? "Return `true` if object `x` has type `type`, else `false`. The values of `type` fields of ActivityStreams objects may be lists; they are considered to have a type if the type token is a member of the list." [x type] (assert (map? x) (string? type)) (let [tv (:type x)] (cond (coll? tv) (truthy? (not-empty (filter #(= % type) tv))) :else (= tv type)))) (defn object-or-uri? "Very basic check that `x` is either an object or a URI." [x] (try (cond (string? x) (uri? (URI. x)) (map? x) (if (and (:type x) (:id x)) true false) :else false) (catch URISyntaxException _ false) (catch NullPointerException _ false))) (defmacro link-or-uri? "Very basic check that `x` is either a link object or a URI." [x] `(if (object-or-uri? ~x) (has-type? ~x "Link") false)) (defn verb-type? "`true` if `x`, a string, represents a recognised ActivityStreams activity type." [^String x] (if (verb-types x) true false)) (defn has-activity-type? "Return `true` if the object `x` has a type which is an activity type, else `false`." [x] (let [tv (:type x)] (cond (coll? tv) (truthy? (not-empty (filter verb-type? tv))) :else (verb-type? tv)))) (defn has-actor-type? "Return `true` if the object `x` has a type which is an actor type, else `false`." [x] (let [tv (:type x)] (cond (coll? tv) (truthy? (not-empty (filter actor-type? tv))) :else (actor-type? tv)))) (defn filter-severity "Return a list of reports taken from these `reports` where the severity of the report is greater than this or equal to this `severity`." [reports severity] (cond (nil? reports) nil (and (coll? reports) (every? map? reports) (every? :severity reports)) (remove #((severity-filters severity) (:severity %)) reports) :else (throw (ex-info "Argument `reports` was not a collection of fault reports" {:arguments {:reports reports :severity severity}})))) (defn context? "Returns `true` iff `x` quacks like an ActivityStreams context, else false. A context is either 1. the URI (actually an IRI) `activitystreams-context-uri`, or 2. a collection comprising that URI and a map." [x] (cond (nil? x) false (string? x) (and (= x activitystreams-context-uri) true) (coll? x) (and (context? (first (remove map? x))) (= (count x) 2) true) :else false)) (defmacro has-context? "True if `x` is an ActivityStreams object with a valid context, else `false`." [x] `(context? (context-key ~x))) (defn make-fault-object "Return a fault object with these `severity`, `fault` and `narrative` values. An ActivityPub object MUST have a globally unique ID. Whether this is meaningful depends on whether we persist fault report objects and serve them, which at present I have no plans to do." ;; TODO: should not pass in the narrative; instead should use the :fault value ;; to look up the narrative in a resource file. [severity fault] (assoc {} context-key validation-fault-context-uri :id (str "https://" (get-hostname) "/fault/" (get-pid) ":" (inst-ms (java.util.Date.))) :type "Fault" :severity severity :fault fault :narrative (or (messages fault) (do (warn "No narrative provided for fault token " fault) (str fault))))) (defmacro nil-if-empty "if `x` is an empty collection, return `nil`; else return `x`." [x] `(if (and (coll? ~x) (empty? ~x)) nil ~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 "If object `x` has a `:type` value which is `acceptable`, return `nil`; else return a fault object with this `severity` and `token`. `acceptable` may be passed as either nil, a string, or a set of strings. If `acceptable` is `nil`, no type specific tests will be performed." [x acceptable severity token] (when acceptable (let [tv (:type x)] (when-not (cond (and (string? tv) (string? acceptable)) (= tv acceptable) (and (string? tv) (set? acceptable)) (acceptable tv) (and (coll? tv) (string? acceptable)) ((set tv) acceptable) (and (coll? tv) (set? acceptable)) (not-empty (intersection (set tv) acceptable)) :else (throw (ex-info "Type value or `acceptable` argument not as expected." {:arguments {:x x :acceptable acceptable :severity severity :token token}}))) (make-fault-object severity token))))) (defn any-or-faults "Return `nil` if validating one of these options returns `nil`; otherwise return a list comprising a fault report object with this `severity-if-none` and this token followed by all the fault reports from validating each option. There are several places - but especially in validating collections - where there are several different valid configurations, but few or no properties are always required." [options severity-if-none token] (let [faults (filter empty? options)] (when (empty? faults) ;; 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 "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))) (defn string-or-fault "If this `value` is not a string, return a fault object with this `severity` and `token`, else `nil`. If `pattern` is also passed, it is expected to be a Regex, and the fault object will be returned unless `value` matches the `pattern`." ([value severity token] (when-not (string? value) (make-fault-object severity token))) ([value severity token pattern] (when not (and (string? value) (re-matches pattern value)) (make-fault-object severity token)))) (defn object-faults "Return a list of faults found in object `x`, or `nil` if none are. If `expected-type` is also passed, verify that `x` has `expected-type`. `expected-type` may be passed as a string or as a set of strings. Detailed verification of the particular features of types is not done here." ([x] (nil-if-empty (remove empty? (list (when-not (map? x) (make-fault-object :critical :not-an-object)) (when-not (has-context? x) (make-fault-object :should :no-context)) (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)))))) ([x expected-type] (concat-non-empty (object-faults x) (when expected-type (list (has-type-or-fault x expected-type :critical :unexpected-type)))))) (defn object-reference-or-faults "If this `value` is either 1. an object of `expected-type`; 2. a URI referencing an object of `expected-type`; or 3. a link object referencing an object of `expected-type` and no faults are returned from validating the linked object, then return `nil`; else return a sequence comprising a fault object with this `severity` and `token`, prepended to the faults returned. As with `has-type-or-fault` (q.v.), `expected-type` may be passed as a string, as a set of strings, or `nil` (indicating the type of the referenced object should not be checked). **NOTE THAT** if `*reify-refs*` is `false`, referenced objects will not actually be checked." [value expected-type severity token] (let [faults (cond (string? value) (try (let [uri (URI. value) object (when *reify-refs* (json/read-str (slurp uri)))] (when object (object-faults object expected-type))) (catch URISyntaxException _ (make-fault-object severity token))) (map? value) (if (has-type? value "Link") (cond ;; if we were looking for a link and we've ;; found a link, that's OK. (= expected-type "Link") nil (and (set? expected-type) (expected-type "Link")) nil (nil? expected-type) nil :else (object-reference-or-faults (:href value) expected-type severity token)) (object-faults value expected-type)) :else (throw (ex-info "Argument `value` was not an object or a link to an object" {:arguments {:value value} :expected-type expected-type :severity severity :token token})))] (when faults (cons (make-fault-object severity token) faults)))) (defn coll-object-reference-or-fault "As object-reference-or-fault, except `value` argument may also be a list of objects and/or object references." [value expected-type severity token] (cond (map? value) (object-reference-or-faults value expected-type severity token) (coll? value) (concat-non-empty (map #(object-reference-or-faults % expected-type severity token) value)) :else (throw (ex-info "Argument `value` was not an object, a link to an object, nor a list of these." {:arguments {:value value} :expected-type expected-type :severity severity :token token}))))