Huge amounts of (unfinished, not working) work on picky validator.
This commit is contained in:
parent
21220970a8
commit
3f35c5e293
|
@ -43,6 +43,8 @@ The value of the `type` field of a fault report object MUST be `Fault`.
|
||||||
|
|
||||||
Each fault report object MUST have a `severity` field whose value MUST be one of
|
Each fault report object MUST have a `severity` field whose value MUST be one of
|
||||||
|
|
||||||
|
0. `:info` things which are not actuallys fault, but issues noted during
|
||||||
|
validation;
|
||||||
1. `:minor` things which I consider to be faults, but which
|
1. `:minor` things which I consider to be faults, but which
|
||||||
don't actually breach the spec;
|
don't actually breach the spec;
|
||||||
2. `:should` instances where the spec says something SHOULD
|
2. `:should` instances where the spec says something SHOULD
|
||||||
|
@ -57,5 +59,3 @@ Each fault report object MUST have a `severity` field whose value MUST be one of
|
||||||
Unique codes shall be assigned to each fault type, and shall be documented in this section.
|
Unique codes shall be assigned to each fault type, and shall be documented in this section.
|
||||||
|
|
||||||
It is intended that there should ultimately be a well known site at which the fault codes can be resolved to natural language explanations in as many natural languages as possible of the nature of the particular fault.
|
It is intended that there should ultimately be a well known site at which the fault codes can be resolved to natural language explanations in as many natural languages as possible of the nature of the particular fault.
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,21 @@
|
||||||
(ns dog-and-duck.quack.fault-messages)
|
(ns dog-and-duck.quack.fault-messages)
|
||||||
|
|
||||||
|
;;; 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.
|
||||||
|
|
||||||
(def messages
|
(def messages
|
||||||
"Actual fault messages to which fault codes resolve."
|
"Actual fault messages to which fault codes resolve."
|
||||||
{:id-not-https "Publicly facing content SHOULD use HTTPS URIs"
|
{:id-not-https "Publicly facing content SHOULD use HTTPS URIs"
|
||||||
|
|
|
@ -11,7 +11,7 @@
|
||||||
document specifying this vocabulary;
|
document specifying this vocabulary;
|
||||||
2. `:type` whose value shall be `Fault`;
|
2. `:type` whose value shall be `Fault`;
|
||||||
3. `:severity` whose value shall be one of
|
3. `:severity` whose value shall be one of
|
||||||
`minor`, `should`, `must` or `critical`;
|
`info`, `minor`, `should`, `must` or `critical`;
|
||||||
4. `:fault` whose value shall be a unique token
|
4. `:fault` whose value shall be a unique token
|
||||||
representing the particular fault type;
|
representing the particular fault type;
|
||||||
5. `:narrative` whose value shall be a natural
|
5. `:narrative` whose value shall be a natural
|
||||||
|
@ -27,13 +27,73 @@
|
||||||
possible to serialise a fault report as a
|
possible to serialise a fault report as a
|
||||||
document which in its own right conforms to the
|
document which in its own right conforms to the
|
||||||
ActivityStreams spec."
|
ActivityStreams spec."
|
||||||
(:require [dog-and-duck.quack.fault-messages :refer [messages]]
|
(:require [clojure.set :refer [intersection]]
|
||||||
[dog-and-duck.utils.process :refer [pid]])
|
[dog-and-duck.quack.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]])
|
||||||
(:import [java.net URI URISyntaxException]))
|
(: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.
|
||||||
|
|
||||||
|
;; ERRATA
|
||||||
|
|
||||||
|
(def ^:dynamic *reify-refs*
|
||||||
|
"If `true`, references to objects in fields will be reified and validated.
|
||||||
|
If `false`, they won't, but an `:info` level fault report will be generated.
|
||||||
|
|
||||||
|
There are several things in the spec which, in a document, may correctly be
|
||||||
|
either
|
||||||
|
|
||||||
|
1. a fully fleshed out object, or
|
||||||
|
2. a URI pointing to such an object.
|
||||||
|
|
||||||
|
Obviously to fully validate a document we ought to reify all the refs and
|
||||||
|
check that they are themselves valid, but
|
||||||
|
|
||||||
|
a. in some of the published test documents the URIs do not reference a
|
||||||
|
valid document;
|
||||||
|
b. there will be performance costs to reifying all the refs;
|
||||||
|
c. in perverse cases, reifying refs might result in runaway recursion.
|
||||||
|
|
||||||
|
TODO: I think that in production this should default to `true`."
|
||||||
|
false)
|
||||||
|
|
||||||
|
(def ^:dynamic *reject-severity*
|
||||||
|
"The severity at which the binary validator will return `false`.
|
||||||
|
|
||||||
|
In practice documents seen in the wild do not typically appear to be
|
||||||
|
fully valid, and this does not matter. This allows the sensitivity of
|
||||||
|
the binary validator (`dog-and-duck.quack.quack`) to be tuned. It's in
|
||||||
|
this (`dog-and-duck.quack.picky`) namespace, not that one, because this
|
||||||
|
namespace is where concerns about severity are handled."
|
||||||
|
:must)
|
||||||
|
|
||||||
|
(def ^:const context-key
|
||||||
|
"The Clojure reader barfs on `:@context`, although it is in principle a valid
|
||||||
|
keyword. So we'll make it once, here, to make the code more performant and
|
||||||
|
easier to read."
|
||||||
|
(keyword "@context"))
|
||||||
|
|
||||||
(def ^:const severity
|
(def ^:const severity
|
||||||
"Severity of faults found, as follows:
|
"Severity of faults found, as follows:
|
||||||
|
|
||||||
|
0. `:info` not actually a fault, but an issue noted during validation;
|
||||||
1. `:minor` things which I consider to be faults, but which
|
1. `:minor` things which I consider to be faults, but which
|
||||||
don't actually breach the spec;
|
don't actually breach the spec;
|
||||||
2. `:should` instances where the spec says something SHOULD
|
2. `:should` instances where the spec says something SHOULD
|
||||||
|
@ -42,28 +102,47 @@
|
||||||
be done, which isn't;
|
be done, which isn't;
|
||||||
4. `:critical` instances where I believe the fault means that
|
4. `:critical` instances where I believe the fault means that
|
||||||
the object cannot be meaningfully processed."
|
the object cannot be meaningfully processed."
|
||||||
#{:minor :should :must :critical})
|
#{:info :minor :should :must :critical})
|
||||||
|
|
||||||
(def ^:const severity-filters
|
(def ^:const severity-filters
|
||||||
"Hack for implementing a severity hierarchy"
|
"Hack for implementing a severity hierarchy"
|
||||||
{:all #{}
|
{:all #{}
|
||||||
:minor #{:minor}
|
:info #{}
|
||||||
:should #{:minor :should}
|
:minor #{:info}
|
||||||
:must #{:minor :should :must}
|
:should #{:info :minor}
|
||||||
|
:must #{:info :minor :should}
|
||||||
:critical severity})
|
:critical severity})
|
||||||
|
|
||||||
|
(defn truthy?
|
||||||
|
"Return `true` if `x` is truthy, else `false`."
|
||||||
|
[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 filter-severity
|
(defn filter-severity
|
||||||
"Return a list of reports taken from these `reports` where the severity
|
"Return a list of reports taken from these `reports` where the severity
|
||||||
of the report is greater than this `severity`."
|
of the report is greater than this or equal to this `severity`."
|
||||||
[reports severity]
|
[reports severity]
|
||||||
(assert
|
(cond (nil? reports) nil
|
||||||
(and
|
(and
|
||||||
(coll? reports)
|
(coll? reports)
|
||||||
(every? map? reports)
|
(every? map? reports)
|
||||||
(every? :severity reports)))
|
(every? :severity reports)) (remove
|
||||||
(remove
|
|
||||||
#((severity-filters severity) (:severity %))
|
#((severity-filters severity) (:severity %))
|
||||||
reports))
|
reports)
|
||||||
|
:else reports)) ;; TODO this actually shouldn't happen and we should
|
||||||
|
;; error if it does
|
||||||
|
|
||||||
(def ^:const activitystreams-context-uri
|
(def ^:const activitystreams-context-uri
|
||||||
"The URI of the context of an ActivityStreams object is expected to be this
|
"The URI of the context of an ActivityStreams object is expected to be this
|
||||||
|
@ -93,7 +172,7 @@
|
||||||
(defmacro has-context?
|
(defmacro has-context?
|
||||||
"True if `x` is an ActivityStreams object with a valid context, else `false`."
|
"True if `x` is an ActivityStreams object with a valid context, else `false`."
|
||||||
[x]
|
[x]
|
||||||
`(context? ((keyword "@context") ~x)))
|
`(context? (context-key ~x)))
|
||||||
|
|
||||||
(defn make-fault-object
|
(defn make-fault-object
|
||||||
"Return a fault object with these `severity`, `fault` and `narrative` values.
|
"Return a fault object with these `severity`, `fault` and `narrative` values.
|
||||||
|
@ -105,28 +184,52 @@
|
||||||
;; to look up the narrative in a resource file.
|
;; to look up the narrative in a resource file.
|
||||||
[severity fault]
|
[severity fault]
|
||||||
(assoc {}
|
(assoc {}
|
||||||
(keyword "@context") validation-fault-context-uri
|
context-key validation-fault-context-uri
|
||||||
:id (str "https://"
|
:id (str "https://"
|
||||||
(.. java.net.InetAddress getLocalHost getHostName)
|
(get-hostname)
|
||||||
"/fault/"
|
"/fault/"
|
||||||
pid
|
(get-pid)
|
||||||
":"
|
":"
|
||||||
(inst-ms (java.util.Date.)))
|
(inst-ms (java.util.Date.)))
|
||||||
:type "Fault"
|
:type "Fault"
|
||||||
:severity severity
|
:severity severity
|
||||||
:fault fault
|
:fault fault
|
||||||
:narrative (messages fault)))
|
:narrative (or (messages fault)
|
||||||
|
(do
|
||||||
|
(warn "No narrative provided for fault token " fault)
|
||||||
|
(str fault)))))
|
||||||
|
|
||||||
(defmacro nil-if-empty
|
(defmacro nil-if-empty
|
||||||
"if `x` is an empty collection, return `nil`; else return `x`."
|
"if `x` is an empty collection, return `nil`; else return `x`."
|
||||||
[x]
|
[x]
|
||||||
`(if (coll? ~x)
|
`(if (coll? ~x)
|
||||||
(if (empty? ~x) nil ~x)
|
(nil-if-empty ~x)
|
||||||
~x))
|
~x))
|
||||||
|
|
||||||
|
(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 a string, or as a set of strings."
|
||||||
|
[x acceptable severity token]
|
||||||
|
(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))
|
||||||
|
;; TODO else should error
|
||||||
|
)
|
||||||
|
(make-fault-object severity token))))
|
||||||
|
|
||||||
(defn object-faults
|
(defn object-faults
|
||||||
"Return a list of faults found in object `x`, or `nil` if none are."
|
"Return a list of faults found in object `x`, or `nil` if none are.
|
||||||
[x]
|
|
||||||
|
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
|
(nil-if-empty
|
||||||
(remove empty?
|
(remove empty?
|
||||||
(list
|
(list
|
||||||
|
@ -139,6 +242,27 @@
|
||||||
(make-fault-object :minor :no-type))
|
(make-fault-object :minor :no-type))
|
||||||
(when-not (and (map? x) (contains? x :id))
|
(when-not (and (map? x) (contains? x :id))
|
||||||
(make-fault-object :minor :no-id-transient))))))
|
(make-fault-object :minor :no-id-transient))))))
|
||||||
|
([x expected-type]
|
||||||
|
(nil-if-empty
|
||||||
|
(remove empty?
|
||||||
|
(concat
|
||||||
|
(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`
|
||||||
|
and `if-missing-token`. Otherwise return nil."
|
||||||
|
[u severity if-missing-token if-invalid-token]
|
||||||
|
(try
|
||||||
|
(uri? (URI. u))
|
||||||
|
(catch URISyntaxException _
|
||||||
|
(make-fault-object severity if-invalid-token))
|
||||||
|
(catch NullPointerException _
|
||||||
|
(make-fault-object severity if-missing-token))))
|
||||||
|
|
||||||
(defn persistent-object-faults
|
(defn persistent-object-faults
|
||||||
"Return a list of faults found in persistent object `x`, or `nil` if none are."
|
"Return a list of faults found in persistent object `x`, or `nil` if none are."
|
||||||
|
@ -158,3 +282,131 @@
|
||||||
(make-fault-object :must :null-id-persistent)))
|
(make-fault-object :must :null-id-persistent)))
|
||||||
(make-fault-object :must :no-id-persistent)))))))
|
(make-fault-object :must :no-id-persistent)))))))
|
||||||
|
|
||||||
|
(def ^:const actor-types
|
||||||
|
"The set of types we will accept as actors.
|
||||||
|
|
||||||
|
There's an [explicit set of allowed actor types]
|
||||||
|
(https://www.w3.org/TR/activitystreams-vocabulary/#actor-types)."
|
||||||
|
#{"Application"
|
||||||
|
"Group"
|
||||||
|
"Organization"
|
||||||
|
"Person"
|
||||||
|
"Service"})
|
||||||
|
|
||||||
|
(defmacro actor-type?
|
||||||
|
"Return `true` if the `x` is a recognised actor type, else `false`."
|
||||||
|
[^String x]
|
||||||
|
`(if (actor-types ~x) true false))
|
||||||
|
|
||||||
|
(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 actor-faults
|
||||||
|
"Return a list of faults found in actor `x`, or `nil` if none are."
|
||||||
|
[x]
|
||||||
|
(nil-if-empty
|
||||||
|
(remove empty?
|
||||||
|
(concat (persistent-object-faults x)
|
||||||
|
(list
|
||||||
|
(when-not (has-actor-type? x)
|
||||||
|
(make-fault-object :must :not-actor-type))
|
||||||
|
(uri-or-fault
|
||||||
|
(:inbox x) :must :no-inbox :invalid-inbox-uri)
|
||||||
|
(uri-or-fault
|
||||||
|
(:outbox x) :must :no-outbox :invalid-outbox-uri))))))
|
||||||
|
|
||||||
|
(def ^:const verb-types
|
||||||
|
"The set of types we will accept as verbs.
|
||||||
|
|
||||||
|
There's an [explicit set of allowed verb types]
|
||||||
|
(https://www.w3.org/TR/activitystreams-vocabulary/#activity-types)."
|
||||||
|
#{"Accept" "Add" "Announce" "Arrive" "Block" "Create" "Delete" "Dislike"
|
||||||
|
"Flag" "Follow" "Ignore" "Invite" "Join" "Leave" "Like" "Listen" "Move"
|
||||||
|
"Offer" "Question" "Reject" "Read" "Remove" "TentativeAccept"
|
||||||
|
"TentativeReject" "Travel" "Undo" "Update" "View"})
|
||||||
|
|
||||||
|
(defmacro 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 (actor-type? tv))))
|
||||||
|
|
||||||
|
(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 link-faults
|
||||||
|
"A link object is required to have an `href` property. It may have all of
|
||||||
|
`rel` | `mediaType` | `name` | `hreflang` | `height` | `width` | `preview`
|
||||||
|
but I *think* they're all optional."
|
||||||
|
[x]
|
||||||
|
(list
|
||||||
|
(uri-or-fault
|
||||||
|
(:href x) :must :no-href-uri :invalid-href-uri)
|
||||||
|
(string-or-fault (:mediaType x) :minor :no-media-type #"\w+\/[-+.\w]+")))
|
||||||
|
|
||||||
|
(defn object-reference-or-fault
|
||||||
|
"If this `value` is either
|
||||||
|
|
||||||
|
1. an object of `expected-type`;
|
||||||
|
2. a URI; or
|
||||||
|
3. a link object
|
||||||
|
|
||||||
|
then return `nil`; else return a fault object with this `severity` and `token`.
|
||||||
|
|
||||||
|
As with `has-type-or-fault` (q.v.), `expected-type` may be passed as a
|
||||||
|
string or as a set of strings.
|
||||||
|
|
||||||
|
**NOTE THAT** TODO if `*reify-refs*` is `true` and `value` is either a URI or
|
||||||
|
a link, the linked object should be checked and validated as an object of
|
||||||
|
`expected-type`."
|
||||||
|
[value expected-type severity token]
|
||||||
|
(cond TODO continue here in the morning))
|
||||||
|
|
||||||
|
(defn activity-type-faults
|
||||||
|
"Some specific activity types have specific requirements which are not
|
||||||
|
requirements."
|
||||||
|
([x]
|
||||||
|
(if (coll? (:type x))
|
||||||
|
(map #(activity-type-faults x %) (:type x))
|
||||||
|
(activity-type-faults x (:type x))))
|
||||||
|
([x token]
|
||||||
|
(case token
|
||||||
|
"Link" (link-faults x)
|
||||||
|
)))
|
||||||
|
|
||||||
|
(defn activity-faults
|
||||||
|
[x]
|
||||||
|
(nil-if-empty
|
||||||
|
(remove empty?
|
||||||
|
(concat (persistent-object-faults x)
|
||||||
|
(activity-type-faults x)
|
||||||
|
(list
|
||||||
|
(when-not
|
||||||
|
(has-activity-type? x)
|
||||||
|
(make-fault-object :must :not-activity-type))
|
||||||
|
(when-not (string? (:summary x)) (make-fault-object :should :no-summary))
|
||||||
|
|
||||||
|
)))))
|
||||||
|
|
|
@ -13,9 +13,10 @@
|
||||||
I may have to implement a `*strict*` dynamic variable, so that users can
|
I may have to implement a `*strict*` dynamic variable, so that users can
|
||||||
toggle some checks off."
|
toggle some checks off."
|
||||||
|
|
||||||
;;(:require [clojure.spec.alpha as s])
|
(:require [dog-and-duck.quack.picky :refer [*reject-severity* actor-faults
|
||||||
(:require [dog-and-duck.quack.picky :refer [filter-severity has-context?
|
filter-severity
|
||||||
object-faults]])
|
has-context?
|
||||||
|
object-faults persistent-object-faults]])
|
||||||
(:import [java.net URI URISyntaxException]))
|
(:import [java.net URI URISyntaxException]))
|
||||||
|
|
||||||
;;; Copyright (C) Simon Brooke, 2022
|
;;; Copyright (C) Simon Brooke, 2022
|
||||||
|
@ -54,7 +55,7 @@
|
||||||
|
|
||||||
but in samples found in the wild they typically don't."
|
but in samples found in the wild they typically don't."
|
||||||
([x]
|
([x]
|
||||||
(and (map? x) (:type x) true))
|
(object? x *reject-severity*))
|
||||||
([x severity]
|
([x severity]
|
||||||
(empty? (filter-severity (object-faults x) severity))))
|
(empty? (filter-severity (object-faults x) severity))))
|
||||||
|
|
||||||
|
@ -63,69 +64,16 @@
|
||||||
|
|
||||||
Transient objects in ActivityPub are not required to have an `id` key, but persistent
|
Transient objects in ActivityPub are not required to have an `id` key, but persistent
|
||||||
ones must have a key, and it must be an IRI (but normally a URI)."
|
ones must have a key, and it must be an IRI (but normally a URI)."
|
||||||
[x]
|
([x]
|
||||||
(try
|
(persistent-object? x *reject-severity*))
|
||||||
(and (object? x) (uri? (URI. (:id x))))
|
([x severity]
|
||||||
(catch URISyntaxException _ false)))
|
(empty? (filter-severity (persistent-object-faults x) severity))))
|
||||||
|
|
||||||
;; (persistent-object? {:type "test" :id "https://mastodon.scot/@barfilfarm"})
|
|
||||||
|
|
||||||
(def ^:const actor-types
|
|
||||||
"The set of types we will accept as actors.
|
|
||||||
|
|
||||||
There's an [explicit set of allowed actor types]
|
|
||||||
(https://www.w3.org/TR/activitystreams-vocabulary/#actor-types)."
|
|
||||||
#{"Application"
|
|
||||||
"Group"
|
|
||||||
"Organization"
|
|
||||||
"Person"
|
|
||||||
"Service"})
|
|
||||||
|
|
||||||
(defmacro actor-type?
|
|
||||||
"Return `true` iff the `x` is a recognised actor type, else `false`."
|
|
||||||
[^String x]
|
|
||||||
`(if (actor-types ~x) true false))
|
|
||||||
|
|
||||||
;; (actor-type? "Group")
|
|
||||||
|
|
||||||
(def ^:const verb-types
|
|
||||||
"The set of types we will accept as verbs.
|
|
||||||
|
|
||||||
There's an [explicit set of allowed verb types]
|
|
||||||
(https://www.w3.org/TR/activitystreams-vocabulary/#activity-types)."
|
|
||||||
#{"Accept" "Add" "Announce" "Arrive" "Block" "Create" "Delete" "Dislike"
|
|
||||||
"Flag" "Follow" "Ignore" "Invite" "Join" "Leave" "Like" "Listen" "Move"
|
|
||||||
"Offer" "Question" "Reject" "Read" "Remove" "TentativeAccept"
|
|
||||||
"TentativeReject" "Travel" "Undo" "Update" "View"})
|
|
||||||
|
|
||||||
(defmacro verb-type?
|
|
||||||
;; TODO: better as a macro
|
|
||||||
[^String x]
|
|
||||||
`(if (verb-types ~x) true false))
|
|
||||||
|
|
||||||
|
|
||||||
(defn actor?
|
(defn actor?
|
||||||
"Returns `true` if `x` quacks like an actor, else false.
|
"Returns `true` if `x` quacks like an actor, else false."
|
||||||
|
([x] (actor? x *reject-severity*))
|
||||||
**NOTE THAT** [Section 4.1 of the spec]
|
([x severity]
|
||||||
(https://www.w3.org/TR/activitypub/#actor-objects) says explicitly that
|
(empty? (filter-severity (actor-faults x) severity))))
|
||||||
|
|
||||||
> Actor objects MUST have, in addition to the properties mandated by 3.1 Object Identifiers, the following properties:
|
|
||||||
>
|
|
||||||
> inbox
|
|
||||||
> A reference to an [ActivityStreams] OrderedCollection comprised of all the messages received by the actor; see 5.2 Inbox.
|
|
||||||
> outbox
|
|
||||||
> An [ActivityStreams] OrderedCollection comprised of all the messages produced by the actor; see 5.1 Outbox.
|
|
||||||
|
|
||||||
However, none of the provided examples in the [activitystreams-test-documents repository]() does in fact have these properties"
|
|
||||||
[x]
|
|
||||||
(and
|
|
||||||
(object? x)
|
|
||||||
(has-context? x)
|
|
||||||
(uri? (URI. (:inbox x)))
|
|
||||||
(uri? (URI. (:outbox x)))
|
|
||||||
(actor-type? (:type x))
|
|
||||||
true))
|
|
||||||
|
|
||||||
(defn actor-or-uri?
|
(defn actor-or-uri?
|
||||||
"`true` if `x` is either a URI or an actor.
|
"`true` if `x` is either a URI or an actor.
|
||||||
|
|
|
@ -1,5 +1,21 @@
|
||||||
(ns dog-and-duck.scratch.core)
|
(ns dog-and-duck.scratch.core)
|
||||||
|
|
||||||
|
;;; 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 foo
|
(defn foo
|
||||||
"I don't do a whole lot."
|
"I don't do a whole lot."
|
||||||
[x]
|
[x]
|
||||||
|
|
|
@ -2,11 +2,8 @@
|
||||||
"Scratchpad where I try to understand how to do this stuff."
|
"Scratchpad where I try to understand how to do this stuff."
|
||||||
(:require [clj-activitypub.core :as activitypub]
|
(:require [clj-activitypub.core :as activitypub]
|
||||||
[clj-activitypub.webfinger :as webfinger]
|
[clj-activitypub.webfinger :as webfinger]
|
||||||
[clj-pgp.core :as pgp]
|
|
||||||
[clj-pgp.keyring :as keyring]
|
|
||||||
[clj-pgp.generate :as pgp-gen]
|
[clj-pgp.generate :as pgp-gen]
|
||||||
[clojure.walk :refer [keywordize-keys]]
|
[clojure.walk :refer [keywordize-keys]]))
|
||||||
[clojure.pprint :refer [pprint]]))
|
|
||||||
|
|
||||||
;;; Copyright (C) Simon Brooke, 2022
|
;;; Copyright (C) Simon Brooke, 2022
|
||||||
|
|
||||||
|
@ -44,9 +41,8 @@
|
||||||
;;; examine what you got back!
|
;;; examine what you got back!
|
||||||
(:inbox account)
|
(:inbox account)
|
||||||
|
|
||||||
|
;; (def rsa (pgp-gen/rsa-keypair-generator 2048))
|
||||||
(def rsa (pgp-gen/rsa-keypair-generator 2048))
|
;; (def kp (pgp-gen/generate-keypair rsa :rsa-general))
|
||||||
(def kp (pgp-gen/generate-keypair rsa :rsa-general))
|
|
||||||
|
|
||||||
;; how we make a public/private key pair. But this key pair is not the one
|
;; how we make a public/private key pair. But this key pair is not the one
|
||||||
;; known to mastodon.scot as my key pair, so that doesn't get us very far...
|
;; known to mastodon.scot as my key pair, so that doesn't get us very far...
|
||||||
|
|
|
@ -1,11 +1,31 @@
|
||||||
(ns dog-and-duck.utils.process
|
(ns dog-and-duck.utils.process
|
||||||
(:require [clojure.string :refer [split]]))
|
(:require [clojure.string :refer [split]]))
|
||||||
|
|
||||||
(def pid
|
;;; Copyright (C) Simon Brooke, 2022
|
||||||
"OK, this is hacky as fuck, but I hope it works. The problem is that the
|
|
||||||
|
;;; 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.
|
||||||
|
|
||||||
|
(def get-pid
|
||||||
|
"Get the process id of the current process.
|
||||||
|
|
||||||
|
OK, this is hacky as fuck, but I hope it works. The problem is that the
|
||||||
way to get the process id has changed several times during the history
|
way to get the process id has changed several times during the history
|
||||||
of Java development, and the code for one version of Java won't even compile
|
of Java development, and the code for one version of Java won't even compile
|
||||||
in a different version."
|
in a different version."
|
||||||
|
(memoize
|
||||||
|
(fn []
|
||||||
(let [java-version (read-string (apply str (take 2
|
(let [java-version (read-string (apply str (take 2
|
||||||
(split
|
(split
|
||||||
(System/getProperty "java.version")
|
(System/getProperty "java.version")
|
||||||
|
@ -20,4 +40,11 @@
|
||||||
(19 110) "(.pid (java.lang.ProcessHandle/current))"
|
(19 110) "(.pid (java.lang.ProcessHandle/current))"
|
||||||
111 "(.getPid (java.lang.management.ManagementFactory/getRuntimeMXBean))"
|
111 "(.getPid (java.lang.management.ManagementFactory/getRuntimeMXBean))"
|
||||||
":default")]
|
":default")]
|
||||||
(eval (read-string cmd))))
|
(eval (read-string cmd))))))
|
||||||
|
|
||||||
|
(def get-hostname
|
||||||
|
"return the hostname of the current host.
|
||||||
|
|
||||||
|
Java's methods for getting the hostname are quite startlingly slow, we
|
||||||
|
do not want todo this repeatedly!"
|
||||||
|
(memoize (fn [] (.. java.net.InetAddress getLocalHost getHostName))))
|
|
@ -4,6 +4,22 @@
|
||||||
filter-severity object-faults
|
filter-severity object-faults
|
||||||
persistent-object-faults]]))
|
persistent-object-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.
|
||||||
|
|
||||||
(deftest object-fault-tests
|
(deftest object-fault-tests
|
||||||
(let [perfect {(keyword "@context") activitystreams-context-uri
|
(let [perfect {(keyword "@context") activitystreams-context-uri
|
||||||
:id "https://somewhere.out.there/object/14323:1671654380083"
|
:id "https://somewhere.out.there/object/14323:1671654380083"
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
(ns dog-and-duck.quack.quack-test
|
(ns dog-and-duck.quack.quack-test
|
||||||
(:require [clojure.test :refer [deftest is testing]]
|
(:require [clojure.test :refer [deftest is testing]]
|
||||||
[dog-and-duck.quack.picky :refer [activitystreams-context-uri
|
[dog-and-duck.quack.picky :refer [activitystreams-context-uri
|
||||||
context?]]
|
context? context-key]]
|
||||||
[dog-and-duck.quack.quack :refer [actor? actor-type?
|
[dog-and-duck.quack.quack :refer [actor? actor-type?
|
||||||
object? ordered-collection-page?
|
object? ordered-collection-page?
|
||||||
persistent-object?
|
persistent-object?
|
||||||
|
@ -32,7 +32,7 @@
|
||||||
(let [expected true
|
(let [expected true
|
||||||
actual (object? {:type "Test"})]
|
actual (object? {:type "Test"})]
|
||||||
(is (= actual expected)))
|
(is (= actual expected)))
|
||||||
(let [expected false
|
(let [expected true
|
||||||
actual (object?
|
actual (object?
|
||||||
(first
|
(first
|
||||||
(clean
|
(clean
|
||||||
|
@ -117,18 +117,25 @@
|
||||||
(let [expected true
|
(let [expected true
|
||||||
actual (context? [activitystreams-context-uri {:foo "bar"}])]
|
actual (context? [activitystreams-context-uri {:foo "bar"}])]
|
||||||
(is (= actual expected)
|
(is (= actual expected)
|
||||||
"order of elements within a context should not matter"))
|
"order of elements within a context should not matter"))))
|
||||||
))
|
|
||||||
|
|
||||||
(deftest actor-test
|
(deftest actor-test
|
||||||
(testing "identification of actors"
|
(testing "identification of actors"
|
||||||
(let [expected false
|
(let [expected false
|
||||||
actual (actor? (-> "resources/activitystreams-test-documents/simple0008.json" slurp clean first))]
|
actual (actor? (-> "resources/activitystreams-test-documents/simple0008.json" slurp clean first))]
|
||||||
(is (= actual expected) "A Note is not an actor"))
|
(is (= actual expected) "A Note is not an actor"))
|
||||||
(let [expected true
|
(let [expected false
|
||||||
actual (actor? (-> "resources/activitystreams-test-documents/simple0020.json" slurp clean first :actor))]
|
actual (actor? (-> "resources/activitystreams-test-documents/simple0020.json" slurp clean first :actor))]
|
||||||
(is (= actual expected) "A Person is an actor"))
|
(is (= actual expected) "The Person in this file is not valid as an actor, because it lacks a context."))
|
||||||
))
|
(let [o (assoc (-> "resources/activitystreams-test-documents/simple0020.json"
|
||||||
|
slurp
|
||||||
|
clean
|
||||||
|
first
|
||||||
|
:actor)
|
||||||
|
context-key activitystreams-context-uri)
|
||||||
|
expected true
|
||||||
|
actual (actor? o)]
|
||||||
|
(is (= actual expected) (str "The Person from this file is now valid as an actor, because it has a context." o)))))
|
||||||
|
|
||||||
(deftest ordered-collection-page-test
|
(deftest ordered-collection-page-test
|
||||||
(testing "identification of ordered collection pages."
|
(testing "identification of ordered collection pages."
|
||||||
|
@ -137,5 +144,4 @@
|
||||||
(is (= actual expected) "A Note is not an ordered collection page."))
|
(is (= actual expected) "A Note is not an ordered collection page."))
|
||||||
(let [expected true
|
(let [expected true
|
||||||
actual (ordered-collection-page? (-> "resources/test_documents/outbox_page.json" slurp clean first))]
|
actual (ordered-collection-page? (-> "resources/test_documents/outbox_page.json" slurp clean first))]
|
||||||
(is (= actual expected) "A page from an outbox is an ordered collection page."))
|
(is (= actual expected) "A page from an outbox is an ordered collection page."))))
|
||||||
))
|
|
Loading…
Reference in a new issue