320 lines
12 KiB
Clojure
320 lines
12 KiB
Clojure
(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}))))
|