dog-and-duck/src/dog_and_duck/quack/picky/utils.clj

(ns dog-and-duck.quack.picky.utils
  "Utility functions supporting the picky validator"
  (:require [clojure.set :refer [intersection]]
            [dog-and-duck.quack.picky.constants :refer [activitystreams-context-uri
                                                        actor-types
                                                        context-key severity-filters
                                                        validation-fault-context-uri
                                                        activity-types]]
            [dog-and-duck.utils.process :refer [get-hostname get-pid]]
            [scot.weft.i18n.core :refer [get-message]]
            [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 xsd-non-negative-integer?
  "Return `true` if `value` matches the pattern for an 
   [xsd:nonNegativeInteger](https://www.w3.org/TR/xmlschema11-2/#nonNegativeInteger), else `false`"
  [x]
  (and (integer? x)(>= x 0)))

(defn has-type?
  "Return `true` if object `x` has a type in `acceptable`, else `false`.
   
   The values of `:type` fields of ActivityStreams objects may be lists; they
   are considered to have a type if a member of the list is in `acceptable`.
   
   `acceptable` may be passed as a string, in which case there is only one
   acceptable value, or as a set of strings, in which case any member of the
   set is acceptable."
  [x acceptable]
  (assert (map? x) (or (string? acceptable) (set? acceptable)))
  (let [tv (:type x)]
    (truthy?
     (cond
       (and (string? acceptable) (coll? tv)) (not-empty (filter #(= % acceptable) tv))
       (and (set? acceptable) (coll? tv)) (not-empty (filter #(acceptable %) tv))
       (string? acceptable) (= tv acceptable)
       (set? acceptable) (acceptable tv)))))

(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) true
           :else false)
     (catch URISyntaxException _ false)
     (catch NullPointerException _ false)))
  ([x type]
   (if (object-or-uri? x)
     (if (map? x)
       (has-type? x type)
       true)
     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 activity-type?
  "`true` if `x`, a string, represents a recognised ActivityStreams activity
   type."
  [^String x]
  (if (activity-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 activity-type? tv)))
      :else (activity-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? (severity-filters severity)) (throw
                                             (ex-info
                                              "Argument `severity` was not a valid severity key"
                                              {:arguments {:reports reports
                                                           :severity severity}}))
    (empty? reports) nil
        (and
         (coll? reports)
         (every? map? reports)
         (every? :severity reports))(remove
                                     #(if  (:severity %)
                                        ((severity-filters severity) (:severity %))
                                        false)
                                     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 (get-message 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))
         (not
          (or (string? acceptable)
              (set? acceptable))) (throw
                                   (ex-info
                                    "`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))))

(defn 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))))