Merge remote-tracking branch 'origin/master'

This commit is contained in:
Simon Brooke 2022-12-31 09:16:27 +00:00
commit 7e7bd7ec90
25 changed files with 2830 additions and 1807 deletions

View file

@ -27,16 +27,20 @@
possible to serialise a fault report as a
document which in its own right conforms to the
ActivityStreams spec."
(:require [dog-and-duck.quack.picky.constants :refer [actor-types]]
[dog-and-duck.quack.picky.control-variables :refer [*reify-refs*]]
[dog-and-duck.quack.picky.utils :refer [concat-non-empty
has-context?
(:require [dog-and-duck.quack.picky.collections :refer [collection-page-faults
paged-collection-faults
simple-collection-faults]]
[dog-and-duck.quack.picky.constants :refer [actor-types]]
[dog-and-duck.quack.picky.utils :refer [any-or-faults
coll-object-reference-or-fault
concat-non-empty
has-activity-type?
has-actor-type? has-type?
has-type-or-fault
make-fault-object
nil-if-empty]]
[clojure.data.json :as json])
object-faults
object-reference-or-faults
string-or-fault]])
(:import [java.net URI URISyntaxException]))
;;; Copyright (C) Simon Brooke, 2022
@ -55,32 +59,6 @@
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
(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."
([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)
(list
;; TODO: should resolve the correct `-faults`function for the
;; `expected-type` and call that; but that's for later.
(has-type-or-fault x expected-type :critical :unexpected-type)))))
(defn uri-or-fault
"If `u` is not a valid URI, return a fault object with this `severity` and
`if-invalid-token`. If it's `nil`, return a fault object with this `severity`
@ -131,80 +109,6 @@
(uri-or-fault
(:outbox x) :must :no-outbox :invalid-outbox-uri))))
(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-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 or as a set of strings.
**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
: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}))))
(defn link-faults
"A link object is required to have an `href` property. It may have all of
`rel` | `mediaType` | `name` | `hreflang` | `height` | `width` | `preview`
@ -311,3 +215,38 @@
(make-fault-object :must :not-activity-type))
(when-not (string? (:summary x)) (make-fault-object :should :no-summary)))))
(defn collection-faults
"Return a list of faults found in the collection `x`; if `type` is also
specified, it should be a string naming a specific collection type for
which checks should be performed.
Every collection *should*(?) have a `totalItems` field (an integer).
Beyond that, collections are either 'just collections' (in which case
they *should* have an `items` field (a sequence)), or else they're paged
collections, in which case they *must*(?) have a `first` field which is
a collection page or a URI pointing to a collection page, and *should*
have a `last` field which is similar.
The pages of collections *should* be collection pages; the pages of
ordered collections *should* be ordered collection pages."
([x]
(collection-faults
x
(first
(remove nil?
(map #(when (has-type? x %) %)
["Collection"
"OrderedCollection"
"CollectionPage"
"OrderedCollectionPage"])))))
([x type]
;; (log/info "collection-faults called with argumens " x ", " type)
(case type
("Collection" "OrderedCollection") (any-or-faults
(list (simple-collection-faults x type)
(paged-collection-faults x type))
:must
:no-items)
("CollectionPage" "OrderedCollectionPage") (collection-page-faults x type)
(list (make-fault-object :critical :expected-collection)))))

View file

@ -0,0 +1,57 @@
(ns dog-and-duck.quack.picky.collections
(:require [dog-and-duck.quack.picky.utils :refer [concat-non-empty
cond-make-fault-object
object-faults
object-reference-or-faults]]))
;;; 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 paged-collection-faults
"Return a list of faults found in `x` considered as a paged collection
object of this sub-`type`, or `nil` if none are found."
[x type]
(concat-non-empty
(object-faults x type)
(list (object-reference-or-faults x type :critical :expected-collection)
(cond-make-fault-object (integer? (:totalItems x)) :should :no-total-items)
(object-reference-or-faults (:first x) nil :must :no-first-page)
(object-reference-or-faults (:last x) nil :should :no-last-page))))
(defn simple-collection-faults
"Return a list of faults found in `x` considered as a non-paged collection
object of this sub-`type`, or `nil` if none are found."
[x type]
(concat-non-empty
(object-faults x type)
(cons
(list (object-reference-or-faults x type :critical :expected-collection)
(cond-make-fault-object (integer? (:totalItems x)) :should :no-total-items)
(cond-make-fault-object (coll? (:items x)) :must :no-items-collection))
(map #(object-reference-or-faults % nil :must :not-object-reference) (:items x)))))
(defn collection-page-faults
[x type]
(concat-non-empty
(simple-collection-faults x type)
(list
(object-reference-or-faults (:partOf x)
(apply str (drop-last 4 type))
:should
:n-part-of)
(object-reference-or-faults (:next x) type :minor :no-next-page)
(object-reference-or-faults (:prev x) type :minor :no-prev-page))))

View file

@ -20,12 +20,14 @@
(def messages
"Actual fault messages to which fault codes resolve."
{:id-not-https "Publicly facing content SHOULD use HTTPS URIs"
{:expected-collection "A collection was expected, but was not found."
:id-not-https "Publicly facing content SHOULD use HTTPS URIs"
:id-not-uri "identifiers must be publicly dereferencable URIs"
:no-context "Section 3 of the ActivityPub specification states Implementers SHOULD include the ActivityPub context in their object definitions`."
:no-id-persistent "Persistent objects MUST have unique global identifiers."
:no-id-transient "The ActivityPub specification allows objects without `id` fields only if they are intentionally transient; even so it is preferred that the object should have an explicit null id."
:no-inbox "Actor objects MUST have an `inbox` property, whose value MUST be a reference to an ordered collection."
:no-items-collection "A collection expected to be simple had no items."
:no-outbox "Actor objects MUST have an `outbox` property, whose value MUST be a reference to an ordered collection."
:no-type "The ActivityPub specification states that the `type` field is optional, but it is hard to process objects with no known type."
:not-actor-type "The `type` value of the object was not a recognised actor type."

View file

@ -1,16 +1,18 @@
(ns dog-and-duck.quack.picky.utils
"Utility functions supporting the picky validator"
(:require [clojure.set :refer [intersection]]
(: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 timbre
;; Optional, just refer what you like:
:refer [warn]]))
[taoensso.timbre :as log :refer [warn]])
(:import [java.net URI URISyntaxException]))
;;; Copyright (C) Simon Brooke, 2022
@ -35,7 +37,8 @@
(if (actor-types x) true false))
(defn truthy?
"Return `true` if `x` is truthy, else `false`."
"Return `true` if `x` is truthy, else `false`. There must be some more
idiomatic way to do this?"
[x]
(if x true false))
@ -51,6 +54,22 @@
(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."
@ -173,3 +192,128 @@
: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}))))

View file

@ -14,10 +14,10 @@
toggle some checks off."
(:require [dog-and-duck.quack.picky :refer [activity-faults actor-faults
link-faults object-faults
link-faults
persistent-object-faults]]
[dog-and-duck.quack.picky.control-variables :refer [*reject-severity*]]
[dog-and-duck.quack.picky.utils :refer [filter-severity]])
[dog-and-duck.quack.picky.utils :refer [filter-severity object-faults]])
(:import [java.net URI URISyntaxException]))