simon/dog-and-duck
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Collections validation written, refactoring done, existing tests pass.

Browse source 
New tests have yet to be written for collections functionality.
This commit is contained in:
Simon Brooke 2022-12-27 20:28:27 +00:00
parent 4b04bf020f
commit 25c86b80fa
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
40 changed files with 2833 additions and 1885 deletions
Download patch file Download diff file Expand all files Collapse all files

155
src/dog_and_duck/quack/picky.clj
View file

@ -27,18 +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*]]
(: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
cond-make-fault-object
has-context?
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
@ -57,31 +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)
(when expected-type
(list
(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`
@ -132,82 +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, 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}))))
(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`
@ -313,41 +214,6 @@
(make-fault-object :must :not-activity-type))
(when-not (string? (:summary x)) (make-fault-object :should :no-summary)))))
(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))))
(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
@ -374,11 +240,12 @@
"CollectionPage"
"OrderedCollectionPage"])))))
([x type]
;; (log/info "collection-faults called with argumens " x ", " type)
(case type
["Collection" "OrderedCollection"] (any-or-faults
("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)
("CollectionPage" "OrderedCollectionPage") (collection-page-faults x type)
(list (make-fault-object :critical :expected-collection)))))

57
src/dog_and_duck/quack/picky/collections.clj Normal file
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))))

1
src/dog_and_duck/quack/picky/fault_messages.clj
View file

@ -27,6 +27,7 @@
: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."

1
src/dog_and_duck/quack/picky/required_properties.clj
View file

@ -0,0 +1 @@
(ns dog-and-duck.quack.picky.required-properties)

118
src/dog_and_duck/quack/picky/utils.clj
View file

@ -1,16 +1,16 @@
(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]))
@ -203,11 +203,117 @@
there are several different valid configurations, but few or no properties
are always required."
[options severity-if-none token]
(let [faults (remove empty? (reduce concat options))]
(when-not (empty? faults) (cons (make-fault-object severity-if-none token) faults))))
(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}))))

4
src/dog_and_duck/quack/quack.clj
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]))