001 (ns dog-and-duck.quack.picky "Fault-finder for ActivityPub documents.
002
003 Generally, each `-faults` function will return:
004
005 1. `nil` if no faults were found;
006 2. a sequence of fault objects if faults were found.
007
008 Each fault object shall have the properties:
009
010 1. `:@context` whose value shall be the URL of a
011 document specifying this vocabulary;
012 2. `:type` whose value shall be `Fault`;
013 3. `:severity` whose value shall be one of
014 `minor`, `should`, `must` or `critical`;
015 4. `:fault` whose value shall be a unique token
016 representing the particular fault type;
017 5. `:narrative` whose value shall be a natural
018 language description of the fault type.
019
020 Note that the reason for the `:fault` property is
021 to be able to have a well known place, linked to
022 from the @context URL, which allows narratives
023 for each fault type to be served in as many
024 natural languages as possible.
025
026 The idea further is that it should ultimately be
027 possible to serialise a fault report as a
028 document which in its own right conforms to the
029 ActivityStreams spec."
030 (:require [dog-and-duck.quack.fault-messages :refer [messages]]
031 [dog-and-duck.utils.process :refer [pid]])
032 (:import [java.net URI URISyntaxException]))
033
034 (def ^:const severity
035 "Severity of faults found, as follows:
036
037 1. `:minor` things which I consider to be faults, but which
038 don't actually breach the spec;
039 2. `:should` instances where the spec says something SHOULD
040 be done, which isn't;
041 3. `:must` instances where the spec says something MUST
042 be done, which isn't;
043 4. `:critical` instances where I believe the fault means that
044 the object cannot be meaningfully processed."
045 #{:minor :should :must :critical})
046
047 (def ^:const severity-filters
048 "Hack for implementing a severity hierarchy"
049 {:all #{}
050 :minor #{:minor}
051 :should #{:minor :should}
052 :must #{:minor :should :must}
053 :critical severity})
054
055 (defn filter-severity
056 "Return a list of reports taken from these `reports` where the severity
057 of the report is greater than this `severity`."
058 [reports severity]
059 (assert
060 (and
061 (coll? reports)
062 (every? map? reports)
063 (every? :severity reports)))
064 (remove
065 #((severity-filters severity) (:severity %))
066 reports))
067
068 (def ^:const activitystreams-context-uri
069 "The URI of the context of an ActivityStreams object is expected to be this
070 literal string."
071 "https://www.w3.org/ns/activitystreams")
072
073 (def ^:const validation-fault-context-uri
074 "The URI of the context of a validation fault report object shall be this
075 literal string."
076 "https://simon-brooke.github.io/dog-and-duck/codox/Validation_Faults.html")
077
078 (defn context?
079 "Returns `true` iff `x` quacks like an ActivityStreams context, else false.
080
081 A context is either
082 1. the URI (actually an IRI) `activitystreams-context-uri`, or
083 2. a collection comprising that URI and a map."
084 [x]
085 (cond
086 (nil? x) false
087 (string? x) (and (= x activitystreams-context-uri) true)
088 (coll? x) (and (context? (first (remove map? x)))
089 (= (count x) 2)
090 true)
091 :else false))
092
093 (defmacro has-context?
094 "True if `x` is an ActivityStreams object with a valid context, else `false`."
095 [x]
096 `(context? ((keyword "@context") ~x)))
097
098 (defn make-fault-object
099 "Return a fault object with these `severity`, `fault` and `narrative` values.
100
101 An ActivityPub object MUST have a globally unique ID. Whether this is
102 meaningful depends on whether we persist fault report objects and serve
103 them, which at present I have no plans to do."
104 ;; TODO: should not pass in the narrative; instead should use the :fault value
105 ;; to look up the narrative in a resource file.
106 [severity fault]
107 (assoc {}
108 (keyword "@context") validation-fault-context-uri
109 :id (str "https://"
110 (.. java.net.InetAddress getLocalHost getHostName)
111 "/fault/"
112 pid
113 ":"
114 (inst-ms (java.util.Date.)))
115 :type "Fault"
116 :severity severity
117 :fault fault
118 :narrative (messages fault)))
119
120 (defn object-faults
121 "Return a list of faults found in object `x`, or `nil` if none are."
122 [x]
123 (let [faults (remove
124 empty?
125 (list
126 (when-not (map? x)
127 (make-fault-object
128 :critical
129 :not-an-object))
130 (when-not
131 (has-context? x)
132 (make-fault-object
133 :should
134 :no-context))
135 (when-not (:type x)
136 (make-fault-object
137 :minor
138 :no-type))
139 (when-not (and (map? x) (contains? x :id))
140 (make-fault-object
141 :minor
142 :no-id-transient))))]
143 (if (empty? faults) nil faults)))
144
145 (defn persistent-object-faults
146 "Return a list of faults found in persistent object `x`, or `nil` if none are."
147 [x]
148 (let [faults (concat
149 (object-faults x)
150 (remove empty?
151 (list
152 (if (contains? x :id)
153 (try (let [id (URI. (:id x))]
154 (when-not (= (.getScheme id) "https")
155 (make-fault-object :should :id-not-https)))
156 (catch URISyntaxException _
157 (make-fault-object :must :id-not-uri))
158 (catch NullPointerException _
159 (make-fault-object :must :null-id-persistent)))
160 (make-fault-object :must :no-id-persistent)))))]
161 (if (empty? faults) nil faults)))
162