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

OK, this is ready for a pre-alpha release!

Browse source
This commit is contained in:
Simon Brooke 2023-01-10 01:26:44 +00:00
parent 86e07385b8
commit 21a4c23c8f
11 changed files with 414 additions and 69 deletions

190
docs/style.css Normal file
View file

@ -0,0 +1,190 @@
body {
color: #333;
background-color: #f2f2f2;
font-family: 'Helvetica Neue', Helvetica, Arial, sans-serif;
padding: 1em 5em;
}
h1,h2,h3,h4,h5,h6,th {
font-family: 'Archivo Black', Helvetica, Arial, sans-serif;
}
th,td {
border: thin solid darkgray;
padding: 0.25em 1em;
text-align: left;
vertical-align: top;
}
th {
background-color: silver;
}
.container {
max-width: 1000px;
}
.right {
float: right;
text-align: right;
}
.navbar {
border-radius: 0;
box-shadow: 0 0 0 0, 0 6px 12px rgba(34, 34, 34, 0.3);
}
.navbar-default {
background-color: #002b00;
border: none;
}
.navbar-default .navbar-brand {
color: #fff;
font-family: 'Archivo Black', Helvetica, Arial, sans-serif;
}
.navbar-default .navbar-brand:hover {
color: #fff;
}
.navbar-default .navbar-nav li a {
color: #fff;
}
.navbar-default .navbar-nav li a:hover {
color: #fff;
background-color: #002b00;
}
.navbar-default .navbar-nav .active a {
color: #fff;
background-color: #002b00;
}
.navbar-default .navbar-toggle:hover {
background-color: #002b00;
}
.navbar-default .navbar-toggle .icon-bar {
background-color: #fff;
}
#sidebar {
margin-left: 15px;
margin-top: 50px;
}
#content {
background-color: #fff;
border-radius: 3px;
box-shadow: 0 0 0 0, 0 6px 12px rgba(34, 34, 34, 0.1);
}
#content img {
max-width: 100%;
height: auto;
}
footer {
font-size: 14px;
text-align: center;
padding-top: 75px;
padding-bottom: 30px;
}
blockquote footer {
text-align: left;
padding-top: 0px;
padding-bottom: 0px;
}
#post-tags {
margin-top: 30px;
}
#prev-next {
padding: 15px 0;
}
.post-header {
margin-bottom: 20px;
}
.post-header h2 {
font-size: 32px;
}
#post-meta {
font-size: 14px;
color: rgba(0, 0, 0, 0.4)
}
#page-header {
border-bottom: 1px solid #dbdbdb;
margin-bottom: 20px;
}
#page-header h2 {
font-size: 32px;
}
pre {
overflow-x: auto;
}
pre code {
display: block;
padding: 0.5em;
overflow-wrap: normal;
white-space: pre;
}
code {
color: #002b00;
}
pre,
code,
.hljs {
background-color: #f7f9fd;
}
@media (min-width: 768px) {
.navbar {
min-height: 70px;
}
.navbar-nav>li>a {
padding: 30px 20px;
}
.navbar-default .navbar-brand {
font-size: 36px;
padding: 25px 15px;
}
#content {
margin-top: 30px;
padding: 30px 40px;
}
}
@media (max-width: 767px) {
body {
font-size: 14px;
}
.navbar-default .navbar-brand {
font-size: 30px;
}
#content {
padding: 15px;
}
#post-meta .right {
float: left;
text-align: left;
}
}

11
project.clj
View file

@ -10,16 +10,21 @@
:dependencies [[clj-activitypub/activitypub "0.52"]
[clojure.java-time "1.1.0"]
[com.taoensso/timbre "6.0.4"]
[hiccup "1.0.5"]
[mvxcvi/clj-pgp "1.1.0"]
[org.bouncycastle/bcpkix-jdk18on "1.72"]
[org.clojars.simon_brooke/internationalisation "1.0.4"]
[org.clojars.simon_brooke/internationalisation "1.0.5"]
[org.clojure/clojure "1.11.1"]
[org.clojure/data.json "2.4.0"]
[org.clojure/math.numeric-tower "0.0.5"]
[org.clojure/spec.alpha "0.3.218"]]
[org.clojure/spec.alpha "0.3.218"]
[org.clojure/tools.cli "1.0.214"]
[trptr/java-wrapper "0.2.3"]]
:license {:name "GPL-2.0-or-later"
:url "https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html"}
:main dog-and-duck.quack.cli
:plugins [[lein-cloverage "1.2.2"]
[lein-codox "0.10.7"]]
:repl-options {:init-ns dog-and-duck.scratch.core}
:profiles {:uberjar {:aot :all}}
:repl-options {:init-ns dog-and-duck.quack.cli}
:url "http://example.com/FIXME")

8
resources/i18n/en-GB.edn
View file

@ -15,10 +15,13 @@
;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
;; Actual fault messages to which fault codes resolve: English language version.
{:expected-collection "A collection was expected, but was not found."
{:by "by"
:expected-collection "A collection was expected, but was not found."
:generated-on "Generated on"
: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-faults-found "No faults were found."
: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."
@ -28,4 +31,5 @@
:not-actor-type "The `type` value of the object was not a recognised actor type."
:not-valid-date-time "A date/time of format required for `xsd:dateTime` was expected but was not found."
:null-id-persistent "Persistent objects MUST have non-null identifiers."
:not-an-object "ActivityStreams object must be JSON objects."}
:not-an-object "ActivityStreams object must be JSON objects."
:validation-report-for "Validation report for"}

3
src/dog_and_duck/activitypub.code-workspace
View file

@ -5,6 +5,9 @@
},
{
"path": "../../../clj-activitypub"
},
{
"path": "../../../internationalisation"
}
],
"settings": {}

139
src/dog_and_duck/quack/cli.clj Normal file
View file

@ -0,0 +1,139 @@
(ns dog-and-duck.quack.cli
(:require [clojure.data.json :refer [read-str]]
[clojure.java.io :refer [resource]]
[clojure.pprint :refer [pprint]]
[clojure.string :refer [join]]
[clojure.tools.cli :refer [parse-opts]]
[clojure.walk :refer [keywordize-keys]]
[dog-and-duck.quack.picky.constants :refer [severity]]
[dog-and-duck.quack.picky.objects :refer [object-faults]]
[dog-and-duck.quack.picky.utils :refer [filter-severity]]
[hiccup.core :refer [html]]
[scot.weft.i18n.core :refer [get-message *config*]]
[trptr.java-wrapper.locale :as locale])
(:gen-class))
(def ^:const stylesheet-url
;; TODO: fix this to github pages before go live
"https://simon-brooke.github.io/dog-and-duck/style.css")
(def cli-options
;; An option with a required argument
[["-i" "--input SOURCE" "The file or URL to validate"
:default "standard input"]
["-o" "--output DEST" "The file to write to, defaults to standard out"
:default "standard output"]
["-f" "--format FORMAT" "The format to output, one of `edn` `csv` `html`"
:default :edn
:parse-fn #(keyword %)
:validate [#(#{:csv :edn :html} %) "Expect one of `edn` `csv` `html`"]]
["-l" "--language LANG" "The ISO 639-1 language code for the language to output"
:default (-> (locale/get-default) locale/to-language-tag)]
["-s" "--severity LEVEL" "The minimum severity of faults to report"
:default :info
:parse-fn #(keyword %)
:validate [#(severity %) (join " "
(cons
"Expected one of"
(map name severity)))]]
["-h" "--help"]])
(defn validate
[source]
(println (str "Reading " source))
(let [input (read-str (slurp source))]
(cond (map? input) (object-faults (keywordize-keys input))
(and (coll? input)
(every? map? input)) (map #(object-faults
(keywordize-keys %)
input)))))
(defn output-csv
[faults]
(let [cols (set (reduce concat (map keys faults)))]
(with-out-str
(println (join ", " (map name cols)))
(map
#(println (join ", " (map (fn [p] (p %)) cols)))
faults))))
(defn html-header-row
[cols]
(apply vector (cons :tr (map #(vector :th (name %)) cols))))
(defn html-fault-row
[fault cols]
(apply
vector (cons :tr (map (fn [col] (vector :td (col fault))) cols))))
(defn- version-string []
(join
" "
["dog-and-duck/quack"
(try
(some->>
(resource "META-INF/maven/dog-and-duck/dog-and-duck/pom.properties")
slurp
(re-find #"version=(.*)")
second)
(catch Exception _ nil))]))
(defn output-html
[faults opts]
(let [source-name (if (= (:input opts) *in*) "Standard input" (str (:input opts)))
title (join " " [(get-message :validation-report-for) source-name])
cols (set (reduce concat (map keys faults)))
version (version-string)]
(str
"<!DOCTYPE html>"
(html
[:html
[:head
[:title title]
[:meta {:name "generator" :content version}]
[:link {:rel "stylesheet" :media "screen" :href stylesheet-url :type "text/css"}]]
[:body
[:h1 title]
[:p (join " " (remove nil? [(get-message :generated-on)
(java.time.LocalDateTime/now)
(get-message :by)
version]))]
(if-not
(empty? faults)
(apply
vector
:table
(html-header-row cols)
(map
#(html-fault-row % cols)
faults))
[:p (get-message :no-faults-found)])]]))))
(defn output
[content options]
(let [faults (filter-severity content (:severity options))]
(spit (:output options)
(case (:format options)
:html (output-html faults options)
:csv (output-csv faults)
(with-out-str (pprint faults))))))
(defn -main [& args]
(let [opts (parse-opts args cli-options)
options (assoc (:options opts)
:input (if (= (:input (:options opts)) "standard input")
*in*
(:input (:options opts)))
:output (if (= (:output (:options opts)) "standard output")
*out*
(:output (:options opts))))]
;;(println options)
(when (:help options)
(println (:summary opts)))
(when (:errors opts)
(println (:errors opts)))
(when-not (or (:help options) (:errors options))
(binding [*config* (assoc *config* :default-language (:language options))]
(output
(validate (:input options))
options)))))

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

@ -90,7 +90,7 @@
"The set of object types we will accept as nouns.
There's an [explicit set of allowed 'object types']
(https://www.w3.org/TR/activitystreams-vocabulary/#activity-types), but by
(https://www.w3.org/TR/activitystreams-vocabulary/#object-types), but by
implication it is not exhaustive."
#{"Article"
"Audio"

18
src/dog_and_duck/scratch/core.clj → src/dog_and_duck/quack/picky/distribution.clj
View file

@ -1,4 +1,4 @@
(ns dog-and-duck.scratch.core)
(ns dog-and-duck.quack.picky.distribution)
;;; Copyright (C) Simon Brooke, 2022
@ -16,7 +16,15 @@
;;; 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
"I don't do a whole lot."
[x]
(println x "Hello, World!"))
(defn distribution
"Distribution of values of function `f` when applied to `vals`.
I *know* there's a library function that does this, probably better, but I
don't remember what it's called!"
[f vals]
(loop [result {} values vals]
(if (empty? values) result
(let [r (apply f (list (first values)))]
(recur
(assoc result r (if (result r) (inc (result r)) 1))
(rest values))))))

2
src/dog_and_duck/quack/picky/objects.clj
View file

@ -365,7 +365,7 @@
(defn check-property-valid
[obj prop clause]
(info "obj" obj "prop" prop "clause" clause)
;; (info "obj" obj "prop" prop "clause" clause)
(let [val (obj prop)
validator (:validator clause)
[severity token] (:if-invalid clause)]

81
src/dog_and_duck/quack/picky/scratch.clj
View file

@ -3,62 +3,51 @@
(:require [clojure.data.json :refer [read-str]]
[clojure.java.io :refer [file]]
[clojure.walk :refer [keywordize-keys]]
[dog-and-duck.quack.picky.distribution :refer [distribution]]
[dog-and-duck.quack.picky.objects :refer
[object-faults properties-faults]]
[dog-and-duck.quack.picky.utils :refer [concat-non-empty
filter-severity]]))
(def files (filter
#(and (.isFile %) (.endsWith (.getName %) ".json"))
(file-seq (file "resources/activitystreams-test-documents"))))
;; (def files (filter
;; #(and (.isFile %) (.endsWith (.getName %) ".json"))
;; (file-seq (file "resources/activitystreams-test-documents"))))
(def r
(reduce
concat-non-empty
(map
#(try
(let [contents (read-str (slurp %))
faults (cond (map? contents) (filter-severity
(object-faults
(keywordize-keys contents))
:should)
;; (coll? contents) (apply
;; concat-non-empty
;; (map (fn [obj]
;; (object-faults
;; (keywordize-keys obj)))
;; contents))
)]
(map (fn [f] (assoc f :document (.getName %))) faults))
(catch Exception any
[(.getName %) (str "Exception "
(.getName (.getClass any))
": "
(.getMessage any))]))
(filter
#(and (.isFile %) (.endsWith (.getName %) ".json"))
(file-seq (file "resources/activitystreams-test-documents"))))))
;; (def r
;; (reduce
;; concat-non-empty
;; (map
;; #(try
;; (let [contents (read-str (slurp %))
;; faults (cond (map? contents) (filter-severity
;; (object-faults
;; (keywordize-keys contents))
;; :should)
;; ;; (coll? contents) (apply
;; ;; concat-non-empty
;; ;; (map (fn [obj]
;; ;; (object-faults
;; ;; (keywordize-keys obj)))
;; ;; contents))
;; )]
;; (map (fn [f] (assoc f :document (.getName %))) faults))
;; (catch Exception any
;; [(.getName %) (str "Exception "
;; (.getName (.getClass any))
;; ": "
;; (.getMessage any))]))
;; (filter
;; #(and (.isFile %) (.endsWith (.getName %) ".json"))
;; (file-seq (file "resources/activitystreams-test-documents"))))))
(count (filter-severity (object-faults (keywordize-keys (read-str (slurp "resources/activitystreams-test-documents/vocabulary-ex189-jsonld.json")))) :critical))
;; (count (filter-severity (object-faults (keywordize-keys (read-str (slurp "resources/activitystreams-test-documents/vocabulary-ex189-jsonld.json")))) :critical))
(count (filter
#(and (.isFile %) (.endsWith (.getName %) ".json"))
(file-seq (file "resources/activitystreams-test-documents"))))
;; (count (filter
;; #(and (.isFile %) (.endsWith (.getName %) ".json"))
;; (file-seq (file "resources/activitystreams-test-documents"))))
;; (count r)
;; (last r)
;; (clojure.pprint/pprint (last r))
(defn distribution
"Distribution of values of function `f` when applied to `vals`.
I *know* there's a library function that does this, probably better, but I
don't remember what it's called!"
[f vals]
(loop [result {} values vals]
(cond (empty? values) result
:else (let [r (apply f (list (first values)))
i (if (result r) (inc (result r)) 1)]
(recur (assoc result r i) (rest values))))))
(distribution :fault r)
;; (distribution :fault r)

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

@ -115,13 +115,20 @@
"Return a list of reports taken from these `reports` where the severity
of the report is greater than this or equal to this `severity`."
[reports severity]
(cond (nil? reports) nil
(cond (nil? (severity-filters severity)) (throw
(ex-info
"Argument `severity` was not a valid severity key"
{:arguments {:reports reports
:severity severity}}))
(empty? reports) nil
(and
(coll? reports)
(every? map? reports)
(every? :severity reports)) (remove
#((severity-filters severity) (:severity %))
reports)
(every? :severity reports))(remove
#(if (:severity %)
((severity-filters severity) (:severity %))
false)
reports)
:else
(throw
(ex-info

14
src/dog_and_duck/scratch/scratch.clj
View file

@ -34,15 +34,15 @@
;;; Retrieve the account details from its home server
;;; (`keywordize-keys` is not necessary here but produces a more idiomatic clojure
;;; data structure)
(def account
(-> account-handle
(webfinger/parse-handle)
(webfinger/fetch-user-id!)
(activitypub-net/fetch-user!)
(select-keys [:name :preferredUsername :inbox :summary])))
;; (def account
;; (-> account-handle
;; (webfinger/parse-handle)
;; (webfinger/fetch-user-id!)
;; (activitypub-net/fetch-user!)
;; (select-keys [:name :preferredUsername :inbox :summary])))
;; ;;; examine what you got back!
(:inbox account)
;; (:inbox account)
;; (-> account
;; :inbox