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

Validating time (not complete)

Browse source
This commit is contained in:
Simon Brooke 2023-01-04 12:30:02 +00:00
parent 33956ed516
commit a613092771
3 changed files with 80 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
project.clj
View file

@ -8,6 +8,7 @@
:source-uri "https://github.com/simon-brooke/dog-and-duck/blob/master/{filepath}#L{line}"}
:description "A playground for hacking ActivityPub stuff."
:dependencies [[clj-activitypub/activitypub "0.49"]
[clojure.java-time "1.1.0"]
[com.taoensso/timbre "6.0.4"]
[mvxcvi/clj-pgp "1.1.0"]
[org.bouncycastle/bcpkix-jdk18on "1.72"]

7
src/dog_and_duck/quack/picky/constants.clj
View file

@ -22,6 +22,13 @@
literal string."
"https://www.w3.org/ns/activitystreams")
(def ^:const xsd-date-time-pattern
"The pattern to which valid
[xsd:dateTime](https://www.w3.org/TR/xmlschema11-2/#dateTime) values conform.
TODO: this is failing on some of the published examples, so may be wrong."
"yyyy-MM-dd'T'HH:mm:ssX")
(def ^:const actor-types
"The set of types we will accept as actors.

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

@ -1,18 +1,22 @@
(ns dog-and-duck.quack.picky.utils
"Utility functions supporting the picky validator"
(:require [clojure.data.json :as json]
[java-time.api :as jt]
[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]]
verb-types
xsd-date-time-pattern]]
[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]))
(:import [java.io FileNotFoundException]
[java.net URI URISyntaxException]
[java.time.format DateTimeParseException]))
;;; Copyright (C) Simon Brooke, 2022
@ -204,7 +208,7 @@
are always required."
[options severity-if-none token]
(let [faults (filter empty? options)]
(when (empty? faults)
(when (empty? faults)
;; i.e. there was at least one option that returned no faults...
(cons (make-fault-object severity-if-none token) faults))))
@ -225,6 +229,28 @@
(when not (and (string? value) (re-matches pattern value))
(make-fault-object severity token))))
(defn xsd-date-time?
"Return `true` if `value` matches the pattern for an
[xsd:dateTime](https://www.w3.org/TR/xmlschema11-2/#dateTime), else `false`"
[^String value]
(try
(if (jt/local-date-time xsd-date-time-pattern value) true false)
(catch DateTimeParseException _
(log/warn "Not a recognised xsd:dateTime: " value)
false)))
(defn date-time-property-or-fault
"If the value of this `property` of object `x` is a valid xsd:dateTime
value, return a fault object with this `token` and `severity`.
If `required?` is false and there is no such property, no fault will be
returned."
[x property severity token required?]
(let [value (property x)]
(if (and required? (not (x property)))
(make-fault-object severity token)
(cond-make-fault-object
(and value (xsd-date-time? value)) severity token))))
(defn object-faults
"Return a list of faults found in object `x`, or `nil` if none are.
@ -232,6 +258,11 @@
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."
;; TODO: many more properties which are nor required, nevertheless have required
;; property TYPES as detailed in
;; https://www.w3.org/TR/activitystreams-vocabulary/#properties
;; if these properties are present, these types should be checked.
([x]
(nil-if-empty
(remove empty?
@ -244,7 +275,13 @@
(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))))))
(make-fault-object :minor :no-id-transient))
(date-time-property-or-fault x :endTime :must
:not-valid-date-time false)
(date-time-property-or-fault x :published :must
:not-valid-date-time false)
(date-time-property-or-fault x :startTime :must
:not-valid-date-time false)))))
([x expected-type]
(concat-non-empty
(object-faults x)
@ -252,6 +289,36 @@
(list
(has-type-or-fault x expected-type :critical :unexpected-type))))))
(def maybe-reify
"If `*reify-refs*` is `true`, return the object at this `target` URI.
Returns `nil` if
1. `*reify-refs*` is false;
2. the object was not found;
3. access to the object was not permitted.
Consequently, use with care."
(memoize
(fn [target]
(try (let [uri (URI. target)]
(when *reify-refs*
(json/read-str (slurp uri))))
(catch URISyntaxException _
(log/warn "Reification target" target "was not a valid URI.")
nil)
(catch FileNotFoundException _
(log/warn "Reification target" target "was not found.")
nil)))))
(defn maybe-reify-or-faults
"If `*reify-refs*` is `true`, runs basic checks on the object at this
`target` URI, if it is found, or a list containing a fault object with
this `severity` and `token` if it is not."
[value expected-type severity token]
(let [object (maybe-reify value)]
(cond object
(object-faults object expected-type)
*reify-refs* (list (make-fault-object severity token)))))
(defn object-reference-or-faults
"If this `value` is either
@ -272,13 +339,7 @@
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)))
(string? value) (maybe-reify-or-faults value severity token expected-type)
(map? value) (if (has-type? value "Link")
(cond
;; if we were looking for a link and we've