Initial commit

This commit is contained in:
Simon Brooke 2023-01-10 13:37:40 +00:00
commit 6fb60dfe50
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
18 changed files with 3308 additions and 0 deletions

15
.gitignore vendored Normal file
View file

@ -0,0 +1,15 @@
pom.xml
pom.xml.asc
*.jar
*.class
/lib/
/classes/
/target/
/checkouts/
.lein-deps-sum
.lein-repl-history
.lein-plugins/
.lein-failures
.nrepl-port
.cpcache/
.calva

16
.hgignore Normal file
View file

@ -0,0 +1,16 @@
syntax: glob
pom.xml
pom.xml.asc
*.jar
*.class
.gitignore
.git/**
syntax: regexp
^.nrepl-port
^.prepl-port
^.lein-.*
^target/
^classes/
^checkouts/
profiles.clj

24
CHANGELOG.md Normal file
View file

@ -0,0 +1,24 @@
# Change Log
All notable changes to this project will be documented in this file. This change log follows the conventions of [keepachangelog.com](http://keepachangelog.com/).
## [Unreleased]
### Changed
- Add a new arity to `make-widget-async` to provide a different widget shape.
## [0.1.1] - 2023-01-10
### Changed
- Documentation on how to make the widgets.
### Removed
- `make-widget-sync` - we're all async, all the time.
### Fixed
- Fixed widget maker to keep working when daylight savings switches over.
## 0.1.0 - 2023-01-10
### Added
- Files from the new template.
- Widget maker public API - `make-widget-sync`.
[Unreleased]: https://sourcehost.site/your-name/quack/compare/0.1.1...HEAD
[0.1.1]: https://sourcehost.site/your-name/quack/compare/0.1.0...0.1.1

288
LICENSE Normal file
View file

@ -0,0 +1,288 @@
# GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
## Preamble
The licenses for most software are designed to take away your freedom
to share and change it. By contrast, the GNU General Public License is
intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Lesser General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if
you distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on,
we want its recipients to know that what they have is not the
original, so that any problems introduced by others will not reflect
on the original authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at
all.
The precise terms and conditions for copying, distribution and
modification follow.
## TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
**0.** This License applies to any program or other work which
contains a notice placed by the copyright holder saying it may be
distributed under the terms of this General Public License. The
"Program", below, refers to any such program or work, and a "work
based on the Program" means either the Program or any derivative work
under copyright law: that is to say, a work containing the Program or
a portion of it, either verbatim or with modifications and/or
translated into another language. (Hereinafter, translation is
included without limitation in the term "modification".) Each licensee
is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the Program
(independent of having been made by running the Program). Whether that
is true depends on what the Program does.
**1.** You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a
fee.
**2.** You may modify your copy or copies of the Program or any
portion of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
**a)** You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
**b)** You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any part
thereof, to be licensed as a whole at no charge to all third parties
under the terms of this License.
**c)** If the modified program normally reads commands interactively
when run, you must cause it, when started running for such interactive
use in the most ordinary way, to print or display an announcement
including an appropriate copyright notice and a notice that there is
no warranty (or else, saying that you provide a warranty) and that
users may redistribute the program under these conditions, and telling
the user how to view a copy of this License. (Exception: if the
Program itself is interactive but does not normally print such an
announcement, your work based on the Program is not required to print
an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote
it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
**3.** You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
**a)** Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections 1
and 2 above on a medium customarily used for software interchange; or,
**b)** Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your cost of
physically performing source distribution, a complete machine-readable
copy of the corresponding source code, to be distributed under the
terms of Sections 1 and 2 above on a medium customarily used for
software interchange; or,
**c)** Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is allowed
only for noncommercial distribution and only if you received the
program in object code or executable form with such an offer, in
accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
**4.** You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt otherwise
to copy, modify, sublicense or distribute the Program is void, and
will automatically terminate your rights under this License. However,
parties who have received copies, or rights, from you under this
License will not have their licenses terminated so long as such
parties remain in full compliance.
**5.** You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
**6.** Each time you redistribute the Program (or any work based on
the Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
**7.** If, as a consequence of a court judgment or allegation of
patent infringement or for any other reason (not limited to patent
issues), conditions are imposed on you (whether by court order,
agreement or otherwise) that contradict the conditions of this
License, they do not excuse you from the conditions of this License.
If you cannot distribute so as to satisfy simultaneously your
obligations under this License and any other pertinent obligations,
then as a consequence you may not distribute the Program at all. For
example, if a patent license would not permit royalty-free
redistribution of the Program by all those who receive copies directly
or indirectly through you, then the only way you could satisfy both it
and this License would be to refrain entirely from distribution of the
Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
**8.** If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
**9.** The Free Software Foundation may publish revised and/or new
versions of the General Public License from time to time. Such new
versions will be similar in spirit to the present version, but may
differ in detail to address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and
"any later version", you have the option of following the terms and
conditions either of that version or of any later version published by
the Free Software Foundation. If the Program does not specify a
version number of this License, you may choose any version ever
published by the Free Software Foundation.
**10.** If you wish to incorporate parts of the Program into other
free programs whose distribution conditions are different, write to
the author to ask for permission. For software which is copyrighted by
the Free Software Foundation, write to the Free Software Foundation;
we sometimes make exceptions for this. Our decision will be guided by
the two goals of preserving the free status of all derivatives of our
free software and of promoting the sharing and reuse of software
generally.
**NO WARRANTY**
**11.** BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO
WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY
KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME
THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
**12.** IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU
FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF
SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
DAMAGES.
## END OF TERMS AND CONDITIONS

80
README.md Normal file
View file

@ -0,0 +1,80 @@
# quack
> If it walks like a duck, and it quacks like a duck, it's a duck.
A validator for [ActivityStreams](https://www.w3.org/TR/activitystreams-core/) documents.
Part of the [dog-and-duck](https://github.com/simon-brooke/dog-and-duck) project, q.v.
## Installation
Download from http://example.com/FIXME.
## Usage
```
java -jar target/dog-and-duck-0.1.0-standalone.jar -i resources/activitystreams-test-documents/vocabulary-ex10-jsonld.json -f html -o report.html -s info
```
Note that it is almost certain that in some places I have misinterpreted the spec. Of all 205 documents in the [activitystreams-test-documents repository](https://github.com/w3c-social/activitystreams-test-documents), not a single one passes validation, and that must be wrong.
Nevertheless I think that this is a basis on which a useful validator can be built. Feedback and contributions welcome.
## Options
The full range of command-line switches is as follows:
```
-i, --input SOURCE standard input The file or URL to validate
-o, --output DEST standard output The file to write to, defaults to standard out
-f, --format FORMAT :edn The format to output, one of `edn` `csv` `html`
-l, --language LANG en-GB The ISO 639-1 code for the language to output
-s, --severity LEVEL :info The minimum severity of faults to report
-h, --help Print this message and exit
```
Note, though, that internationalisation files for languages other than British English have not yet been written, and that one is not complete.
The following severity levels are understood:
0. `info` things which are not actuallys fault, but issues noted during
validation;
1. `minor` things which I consider to be faults, but which
don't actually breach the spec;
2. `should` instances where the spec says something *SHOULD*
be done, which isn't;
3. `must` instances where the spec says something *MUST*
be done, which isn't;
4. `critical` instances where I believe the fault means that
the object cannot be meaningfully processed.
## Examples
...
## Documentation
Full documentation is [here](https://simon-brooke.github.io/dog-and-duck/).
### Bugs
...
### Any Other Sections
### That You Think
### Might be Useful
## License
Copyright © 2023 FIXME
This program and the accompanying materials are made available under the
terms of the Eclipse Public License 2.0 which is available at
http://www.eclipse.org/legal/epl-2.0.
This Source Code may also be made available under the following Secondary
Licenses when the conditions for such availability set forth in the Eclipse
Public License, v. 2.0 are satisfied: GNU General Public License as published by
the Free Software Foundation, either version 2 of the License, or (at your
option) any later version, with the GNU Classpath Exception which is available
at https://www.gnu.org/software/classpath/license.html.

3
doc/intro.md Normal file
View file

@ -0,0 +1,3 @@
# Introduction to quack
TODO: write [great documentation](http://jacobian.org/writing/what-to-write/)

25
project.clj Normal file
View file

@ -0,0 +1,25 @@
(defproject dog-and-duck/quack "0.1.0-SNAPSHOT"
:cloverage {:output "docs/cloverage"
:codecov? true
:emma-xml? true}
:codox {:metadata {:doc "**TODO**: write docs"
:doc/format :markdown}
:output-path "docs/codox"
:source-uri "https://github.com/simon-brooke/quack/blob/master/{filepath}#L{line}"}
:dependencies [[com.taoensso/timbre "6.0.4"]
[hiccup "1.0.5"]
[mvxcvi/clj-pgp "1.1.0"]
[org.clojars.simon_brooke/internationalisation "1.0.5"]
[org.clojure/clojure "1.10.3"]
[org.clojure/data.json "2.4.0"]
[org.clojure/tools.cli "1.0.214"]
[trptr/java-wrapper "0.2.3"]]
:description "A validator for ActivityStreams."
:license {:name "GPL-2.0-or-later"
:url "https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html"}
:main ^:skip-aot dog-and-duck.quack.core
:profiles {:uberjar {:aot :all
:jvm-opts ["-Dclojure.compiler.direct-linking=true"]}}
:repl-options {:init-ns dog-and-duck.quack.core}
:target-path "target/%s"
:url "http://example.com/FIXME")

12
report.html Normal file
View file

@ -0,0 +1,12 @@
<!DOCTYPE html><html><head><title>Validation report for ../dog-and-duck/resources/activitystreams-test-documents/vocabulary-ex10-jsonld.json</title><meta content="dog-and-duck/quack 0.1.0-SNAPSHOT" name="generator" /><link href="resources/public/css/style.css" media="screen" rel="stylesheet" type="text/css" /></head><body><h1>Validation report for ../dog-and-duck/resources/activitystreams-test-documents/vocabulary-ex10-jsonld.json</h1><p>Generated on 2023-01-10T13:21:52.260571 by dog-and-duck/quack 0.1.0-SNAPSHOT</p><h2>The following faults were found</h2><table><tr><th>@context</th><th>type</th><th>narrative</th><th>fault</th><th>id</th><th>severity</th></tr><tr class="should"><td>https://simon-brooke.github.io/dog-and-duck/codox/Validation_Faults.html</td><td>Fault</td><td>Section 3 of the ActivityPub specification states Implementers SHOULD include the ActivityPub context in their object definitions`.</td><td>no-context</td><td>https://mason/fault/42756:1673356912254</td><td>should</td></tr><tr class="minor"><td>https://simon-brooke.github.io/dog-and-duck/codox/Validation_Faults.html</td><td>Fault</td><td>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.</td><td>no-id-transient</td><td>https://mason/fault/42756:1673356912258</td><td>minor</td></tr></table><div class="text-analysed"><h2>text-analysed</h2><pre class="ft-syntax-highlight" data-syntax-theme="bootstrap" data-syntax="javascript" data-ui-theme="light">{"@context":"http:\/\/www.w3.org\/ns\/activitystreams",
"name":
"Sally added a picture of her cat to her cat picture collection",
"type":"Add",
"actor":{"type":"Person", "name":"Sally"},
"object":
{"type":"Image",
"name":"A picture of my cat",
"url":"http:\/\/example.org\/img\/cat.png"},
"origin":{"type":"Collection", "name":"Camera Roll"},
"target":{"type":"Collection", "name":"My Cat Pictures"}}
</pre></div></body></html>

37
resources/i18n/en-GB.edn Normal file
View file

@ -0,0 +1,37 @@
;;; Copyright (C) Simon Brooke, 2023
;;; 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.
;; Actual fault messages to which fault codes resolve: English language version.
{:by "by"
:expected-collection "A collection was expected, but was not found."
:faults-found "The following faults were 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."
: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."
: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."
:text-analysed "Text analysed"
:validation-report-for "Validation report for"}

File diff suppressed because one or more lines are too long

View file

@ -0,0 +1,175 @@
@import url('ft-syntax-highlight.css');
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;
}
.info {
background-color: lightgreen;
}
.minor {
background-color: greenyellow;
}
.should {
background-color: orange;
}
.must {
background-color: orangered;
color: white;
}
.critical {
background-color: maroon;
color: white;
}
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;
}

View file

@ -0,0 +1,116 @@
(ns dog-and-duck.quack.constants
"Constants supporting the validator.")
;;; 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 ^:const activitystreams-context-uri
"The URI of the context of an ActivityStreams object is expected to be this
literal string.
**NOTE THAT** the URI actually used in the published suite of
activitystreams-test-documents use this URI with 'http' rather than
'https' as the property part, but the spec itself specifies 'https'."
"https://www.w3.org/ns/activitystreams")
(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"})
(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 re-rfc5646
"A regex which tests conformity to RFC 5646. Cribbed from
https://newbedev.com/regex-to-detect-locales"
#"^[a-z]{2,4}(-[A-Z][a-z]{3})?(-([A-Z]{2}|[0-9]{3}))?$")
(def ^:const severity
"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
don't actually breach the spec;
2. `:should` instances where the spec says something SHOULD
be done, which isn't;
3. `:must` instances where the spec says something MUST
be done, which isn't;
4. `:critical` instances where I believe the fault means that
the object cannot be meaningfully processed."
#{:info :minor :should :must :critical})
(def ^:const severity-filters
"Hack for implementing a severity hierarchy"
{:all #{}
:info #{}
:minor #{:info}
:should #{:info :minor}
:must #{:info :minor :should}
:critical #{:info :minor :should :must}})
(def ^:const validation-fault-context-uri
"The URI of the context of a validation fault report object shall be this
literal string."
"https://simon-brooke.github.io/dog-and-duck/codox/Validation_Faults.html")
(def ^:const activity-types
"The set of types we will accept as activities.
There's an [explicit set of allowed activity 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"})
(def ^:const noun-types
"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/#object-types), but by
implication it is not exhaustive."
#{"Article"
"Audio"
"Document"
"Event"
"Image"
"Link"
"Mention"
"Note"
"Object"
"Page"
"Place"
"Profile"
"Relationsip"
"Tombstone"
"Video"})
(def ^:const implicit-noun-types
"These types are not explicitly listed in [Section 3.3 of the spec]
(https://www.w3.org/TR/activitystreams-vocabulary/#object-types), but are
mentioned in narrative"
#{"Link"})

View file

@ -0,0 +1,40 @@
(ns dog-and-duck.quack.control-variables
"Control variables for the validator.")
;;; 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 ^: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)

View file

@ -0,0 +1,195 @@
(ns dog-and-duck.quack.core
(:require [clojure.data.json :as json :refer [read-str]]
[clojure.java.io :refer [resource]]
[clojure.pprint :as pprint]
[clojure.string :refer [join]]
[clojure.tools.cli :refer [parse-opts]]
[clojure.walk :refer [keywordize-keys]]
[dog-and-duck.quack.constants :refer [severity]]
[dog-and-duck.quack.objects :refer [object-faults]]
[dog-and-duck.quack.utils :refer [filter-severity]]
[hiccup.core :refer [html]]
[scot.weft.i18n.core :refer [get-message *config*]]
[trptr.java-wrapper.locale :as locale])
(:gen-class))
;;; Copyright (C) Simon Brooke, 2023
;;; 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 ^:const stylesheet-url
;; TODO: fix this to github pages before go live
;;"https://simon-brooke.github.io/quack/style.css"
"resources/public/css/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 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
(if-not (empty? faults)
(doall
(println (join ", " (map name cols)))
(map
#(println (join ", " (map (fn [p] (p %)) cols)))
faults))
(println (get-message :no-faults-found))))))
(defn output-json
[faults]
(with-out-str
(json/pprint (if-not (empty? faults)
faults
(get-message :no-faults-found)))))
(defn html-header-row
[cols]
(apply vector (cons :tr (map #(vector :th (name %)) cols))))
(defn html-fault-row
[fault cols]
(apply
vector
(cons :tr
(cons
{:class (name (or (:severity fault) :info))}
(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/quack/pom.properties")
slurp
(re-find #"version=(.*)")
second)
(catch Exception _ nil))]))
(defn- output-html-text-analysed
[options]
[:div
{:class "text-analysed"}
[:h2 :text-analysed]
[:pre {:class "ft-syntax-highlight"
:data-syntax "javascript"
:data-syntax-theme "bootstrap"
:data-ui-theme "light"}
(with-out-str
(json/pprint
(read-str
(slurp
(:input options)))))]])
(defn output-html
[faults options]
(let [source-name (if (= (:input options) *in*) "Standard input" (str (:input options)))
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]))]
[:h2 (get-message :faults-found)]
(if-not
(empty? faults)
(apply
vector
:table
(html-header-row cols)
(map
#(html-fault-row % cols)
faults))
[:p (get-message :no-faults-found)])
(when-not (= (:input options) *in*)
(output-html-text-analysed options))]]))))
(defn output
"Output this `content` as directed by these `options`."
[content options]
(let [faults (filter-severity content (:severity options))]
(spit (:output options)
(case (:format options)
:html (output-html faults options)
:csv (output-csv faults)
:json (output-json faults)
(with-out-str (if-not (empty? faults)
(pprint/pprint faults)
(println (get-message :no-faults-found))))))))
(defn -main
"Parse command line `args`, and, using the options found therein,
validate one ActivityStreams document and exit."
[& 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)))))

View file

@ -0,0 +1,521 @@
(ns dog-and-duck.quack.objects
(:require [clojure.data.json :as json]
[clojure.set :refer [union]]
[dog-and-duck.quack.constants :refer [actor-types
noun-types
re-rfc5646]]
[dog-and-duck.quack.control-variables :refer [*reify-refs*]]
[dog-and-duck.quack.time :refer [xsd-date-time?
xsd-duration?]]
[dog-and-duck.quack.utils :refer [concat-non-empty
cond-make-fault-object
has-activity-type?
has-context?
has-type?
has-type-or-fault
make-fault-object
nil-if-empty
object-or-uri?
truthy?
xsd-non-negative-integer?]]
[taoensso.timbre :refer [warn]])
(:import [java.io FileNotFoundException]
[java.net URI URISyntaxException]))
(defn- xsd-float?
[pv]
(or (integer? pv) (float? pv)))
;;; 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 object-expected-properties
"Requirements of properties of object, cribbed from
https://www.w3.org/TR/activitystreams-vocabulary/#properties
Note the following sub-key value types:
* `:collection` opposite of `:functional`: if true, value should be a
collection (in the Clojure sense), not a single object;
* `:functional` if true, value should be a single object; if false, may
be a single object or a sequence of objects, but each must pass
validation checks;
* `:if-invalid` a sequence of two keywords, first indicating severity,
second being a message key;
* `:if-missing` a sequence of two keywords, first indicating severity,
second being a message key;
* `:required` a boolean, or a function of one argument returning a
boolean, in which case the function will be applied to the object
having the property;
* `:validator` a function of one argument returning a boolean, which will
be applied to the value or values of the identified property."
{:accuracy {:functional false
:if-invalid [:must :invalid-number]
:validator (fn [pv] (and (xsd-float? pv)
(>= pv 0)
(<= pv 100)))}
:actor {:functional false
:if-invalid [:must :invalid-actor]
:if-missing [:must :no-actor]
:required has-activity-type?
:validator object-or-uri?}
:altitude {:functional false
:if-invalid [:must :invalid-number]
:validator xsd-float?}
:anyOf {:collection true
:functional false
;; a Question should have a `:oneOf` or `:anyOf`, but at this layer
;; that's hard to check.
:if-invalid [:must :invalid-option]
:validator object-or-uri?}
:attachment {:functional false
:if-invalid [:must :invalid-attachment]
:validator object-or-uri?}
:attributedTo {:functional false
:if-invalid [:must :invalid-attribution]
:validator object-or-uri?}
:audience {:functional false
:if-invalid [:must :invalid-audience]
:validator object-or-uri?}
:bcc {:functional false
:if-invalid [:must :invalid-audience] ;; do we need a separate message for bcc, cc, etc?
:validator object-or-uri?}
:cc {:functional false
:if-invalid [:must :invalid-audience] ;; do we need a separate message for bcc, cc, etc?
:validator object-or-uri?}
:closed {:functional false
:if-invalid [:must :invalid-closed]
:validator (fn [pv] (truthy? (or (object-or-uri? pv)
(xsd-date-time? pv)
(#{"true" "false"} pv))))}
:content {:functional false
:if-invalid [:must :invalid-content]
:validator string?}
:context {:functional false
:if-invalid [:must :invalid-context]
:validator object-or-uri?}
:current {:functional true
:if-missing [:minor :paged-collection-no-current]
:if-invalid [:must :paged-collection-invalid-current]
:required (fn [x] ;; if an object is a collection which has pages,
;; it ought to have a `:current` page. But
;; 1. it isn't required to, and
;; 2. there's no certain way of telling that it
;; does have pages - although if it has a
;; `:first`, then it is.
(and
(or (has-type? x "Collection")
(has-type? x "OrderedCollection"))
(:first x)))
:validator (fn [pv] (object-or-uri? pv #{"CollectionPage"
"OrderedCollectionPage"}))}
:deleted {:functional true
:if-missing [:minor :tombstone-missing-deleted]
:if-invalid [:must :invalid-deleted]
:required (fn [x] (has-type? x "Tombstone"))
:validator xsd-date-time?}
:describes {:functional true
:required (fn [x] (has-type? x "Profile"))
:if-invalid [:must :invalid-describes]
;; TODO: actually the spec says this MUST be an object and
;; not a URI, which it doesn't say anywhere else, but this seems
;; to make no sense?
:validator object-or-uri?}
:duration {:functional false
:if-invalid [:must :invalid-duration]
:validator xsd-duration?}
:endTime {:functional true
:if-invalid [:must :invalid-date-time]
:validator xsd-date-time?}
:first {:functional true
:if-missing [:minor :paged-collection-no-first]
:if-invalid [:must :paged-collection-invalid-first]
:required (fn [x] ;; if an object is a collection which has pages,
;; it ought to have a `:first` page. But
;; 1. it isn't required to, and
;; 2. there's no certain way of telling that it
;; does have pages - although if it has a
;; `:last`, then it is.
(and
(or (has-type? x "Collection")
(has-type? x "OrderedCollection"))
(:last x)))
:validator (fn [pv] (object-or-uri? pv #{"CollectionPage"
"OrderedCollectionPage"}))}
:formerType {:functional false
:if-missing [:minor :tombstone-missing-former-type]
:if-invalid [:must :invalid-former-type]
:required (fn [x] (has-type? x "Tombstone"))
;; The narrative of the spec says this should be an `Object`,
;; but in all the provided examples it's a string.
:validator string?}
:generator {:functional false
:if-invalid [:must :invalid-generator]
:validator object-or-uri?}
:height {:functional false
:if-invalid [:must :invalid-non-negative]
:validator xsd-non-negative-integer?}
:href {:functional false
:if-invalid [:must :invalid-href]
:validator (fn [pv] (try (uri? (URI. pv))
(catch URISyntaxException _ false)))}
:hreflang {:validator (fn [pv] (truthy? (re-matches re-rfc5646 pv)))}
:icon {:functional false
:if-invalid [:must :invalid-icon]
;; an icon is also expected to have a 1:1 aspect ratio, but that's
;; too much detail at this level of verification
:validator (fn [pv] (object-or-uri? pv "Image"))}
:id {:functional true
:if-missing [:minor :no-id-transient]
:if-invalid [:must :invalid-id]
:validator (fn [pv] (try (uri? (URI. pv))
(catch URISyntaxException _ false)))}
:image {:functional false
:if-invalid [:must :invalid-image]
:validator (fn [pv] (object-or-uri? pv "Image"))}
:inReplyTo {:functional false
:if-invalid [:must :invalid-in-reply-to]
:validator (fn [pv] (object-or-uri? pv noun-types))}
:instrument {:functional false
:if-invalid [:must :invalid-instrument]
:validator object-or-uri?}
:items {:collection true
:functional false
:if-invalid [:must :invalid-items]
:if-missing [:must :no-items-or-pages]
:required (fn [x] (or (has-type? x "CollectionPage")
(and (has-type? x "Collection")
;; if it's a collection and has pages,
;; it doesn't need items.
(not (:current x))
(not (:first x))
(not (:last x)))))
:validator (fn [pv] (and (coll? pv) (every? object-or-uri? pv)))}
:last {:functional true
:if-missing [:minor :paged-collection-no-last]
:if-invalid [:must :paged-collection-invalid-last]
:required (fn [x] (if (and
(string? x)
(try (uri? (URI. x))
(catch URISyntaxException _ false)))
true
;; if an object is a collection which has pages,
;; it ought to have a `:last` page. But
;; 1. it isn't required to, and
;; 2. there's no certain way of telling that it
;; does have pages - although if it has a
;; `:first`, then it is.
(and
(has-type? x #{"Collection"
"OrderedCollection"})
(:first x))))
:validator (fn [pv] (object-or-uri? pv #{"CollectionPage"
"OrderedCollectionPage"}))}
:latitude {:functional true
:if-invalid [:must :invalid-latitude]
;; The XSD spec says this is an IEEE 754-2008, and the IEEE
;; wants US$104 for me to find out what that is. So I don't
;; strictly know that an integer is valid here.
:validator xsd-float?}
:location {:functional false
:if-invalid [:must :invalid-location]
:validator (fn [pv] (object-or-uri? pv #{"Place"}))}
:longitude {:functional true
:if-invalid [:must :invalid-longitude]
:validator xsd-float?}
:mediaType {:functional true
:if-invalid [:must :invalid-mime-type]
:validator (fn [pv] (truthy? (re-matches #"\w+/[-.\w]+(?:\+[-.\w]+)?" pv)))}
:name {:functional false
:if-invalid [:must :invalid-name]
:validator string?}
:next {:functional true
:if-invalid [:must :invalid-next-page]
:validator (fn [pv] (object-or-uri? pv #{"CollectionPage"
"OrderedCollectionPage"}))}
:object {:functional false
:if-invalid [:must :invalid-direct-object]
:validator object-or-uri?}
:oneOf {:collection true
:functional false
;; a Question should have a `:oneOf` ot `:anyOf`, but at this layer
;; that's hard to check.
:if-invalid [:must :invalid-option]
:validator object-or-uri?}
:orderedItems {:collection true
:functional false
:if-invalid [:must :invalid-items]
:if-missing [:must :no-items-or-pages]
:required (fn [x] (or (has-type? x "OrderedCollectionPage")
(and (has-type? x "OrderedCollection")
;; if it's a collection and has pages,
;; it doesn't need items.
(not (:current x))
(not (:first x))
(not (:last x)))))
:validator (fn [pv] (and (coll? pv) (every? object-or-uri? pv)))}
:origin {:functional false
:if-invalid [:must :invalid-origin]
:validator object-or-uri?}
:partOf {:functional true
:if-missing [:must :missing-part-of]
:if-invalid [:must :invalid-part-of]
:required (fn [x] (object-or-uri? x #{"CollectionPage"
"OrderedCollectionPage"}))
:validator (fn [pv] (object-or-uri? pv #{"Collection"
"OrderedCollection"}))}
:prev {:functional true
:if-invalid [:must :invalid-prior-page]
:validator (fn [pv] (object-or-uri? pv #{"CollectionPage"
"OrderedCollectionPage"}))}
:preview {:functional false
:if-invalid [:must :invalid-preview]
;; probably likely to be an Image or Video, but that isn't stated.
:validator object-or-uri?}
:published {:functional true
:if-invalid [:must :invalid-date-time]
:validator xsd-date-time?}
:replies {:functional true
:if-invalid [:must :invalid-replies]
:validator (fn [pv] (object-or-uri? pv #{"Collection"
"OrderedCollection"}))}
:radius {:functional true
:if-invalid [:must :invalid-positive-number]
:validator (fn [pv] (and (xsd-float? pv) (> pv 0)))}
:rel {:functional false
:if-invalid [:must :invalid-link-relation]
;; TODO: this is not really good enough.
:validator (fn [pv] (truthy? (re-matches #"[a-zA-A0-9_\-\.\:\?/\\]*" pv)))}
:relationship {;; this exists in the spec, but it doesn't seem to be required and it's
;; extremely hazily specified.
}
:result {:functional false
:if-invalid [:must :invalid-result]
:validator object-or-uri?}
:startIndex {:functional true
:if-invalid [:must :invalid-start-index]
:validator xsd-non-negative-integer?}
:start-time {:functional true
:if-invalid [:must :invalid-date-time]
:validator xsd-date-time?}
:subject {:functional true
:if-invalid [:must :invalid-subject]
:if-missing [:minor :no-relationship-subject]
:required (fn [x] (has-type? x "Relationship"))
:validator object-or-uri?}
:summary {:functional false
:if-invalid [:must :invalid-summary]
;; TODO: HTML formatting is allowed, but other forms of formatting
;; are not. Can this be validated?
:validator string?}
:tag {:functional false
:if-invalid [:must :invalid-tag]
:validator object-or-uri?}
:target {:functional false
:if-invalid [:must :invalid-target]
:validator object-or-uri?}
:to {:functional false
:if-invalid [:must :invalid-to]
:validator (fn [pv] (object-or-uri? pv actor-types))}
:totalItems {:functional true
:if-invalid [:must :invalid-total-items]
:validator xsd-non-negative-integer?}
:type {:functional false
:if-missing [:minor :no-type]
:if-invalid [:must :invalid-type]
;; strictly, it's an `anyURI`, but realistically these are not checkable.
:validator string?}
:units {:functional true
:if-invalid [:must :invalid-units]
;; the narrative says that `anyURI`, but actually unless it's a recognised
;; unit the property is useless. These are the units explicitly specified.
:validator (fn [pv] (#{"cm" "feet" "inches" "km" "m" "miles"} pv))}
:updated {:functional true
:if-invalid [:must :invalid-updated]
:validator xsd-date-time?}
:url {:functional false
:if-invalid [:must :invalid-url-property]
:validator (fn [pv] (object-or-uri? pv "Link"))}
:width {:functional true
:if-invalid [:must :invalid-width]
:validator xsd-non-negative-integer?}})
(defn check-property-required [obj prop clause]
(let [required (:required clause)
[severity token] (:if-missing clause)]
(when required
(when
(and (apply required (list obj)) (not (obj prop)))
(make-fault-object severity token)))))
(defn check-property-valid
[obj prop clause]
;; (info "obj" obj "prop" prop "clause" clause)
(let [val (obj prop)
validator (:validator clause)
[severity token] (:if-invalid clause)]
(when (and val validator)
(cond-make-fault-object
(apply validator (list val))
severity token))))
(defn check-property [obj prop]
(assert (map? obj))
(assert (keyword? prop))
(let [clause (object-expected-properties prop)]
(nil-if-empty
(remove nil?
(list
(check-property-required obj prop clause)
(check-property-valid obj prop clause))))))
(defn properties-faults
"Return a lost of faults found on properties of the object `x`, or
`nil` if none are."
[x]
(apply
concat-non-empty
(let [props (set (keys x))
required (set
(filter
#((object-expected-properties %) :required)
(keys object-expected-properties)))]
(map
(fn [p] (check-property x p))
(union props required)))))
(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."
;; 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]
(concat-non-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))))
(properties-faults x)))
([x expected-type]
(concat-non-empty
(object-faults x)
(when expected-type
(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 _
(warn "Reification target" target "was not a valid URI.")
nil)
(catch FileNotFoundException _
(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
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) (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
;; 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}))))

View file

@ -0,0 +1,66 @@
(ns dog-and-duck.quack.time
"Time, gentleman, please! Recognising and validating date time values."
(:require [dog-and-duck.quack.utils :refer [cond-make-fault-object
make-fault-object
truthy?]]
[scot.weft.i18n.core :refer [get-message]]
[taoensso.timbre :refer [warn error]])
(:import [java.time LocalDateTime]
[java.time.format DateTimeFormatter DateTimeParseException]
[javax.xml.datatype DatatypeFactory]))
;;; Copyright (C) Simon Brooke, 2023
;;; 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 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 (LocalDateTime/from (.parse DateTimeFormatter/ISO_DATE_TIME value)) true false)
(catch DateTimeParseException _
(warn (get-message :bad-date-time) ":" value)
false)
(catch Exception e
(error "Exception thrown while parsing date" value e)
false)))
(defn xsd-duration?
"Return `true` if `value` matches the pattern for an
[xsd:duration](https://www.w3.org/TR/xmlschema11-2/#duration), else `false`"
[value]
(truthy?
(and (string? value)
(try (.newDuration (DatatypeFactory/newInstance) value)
(catch IllegalArgumentException _
(warn (get-message :bad-duration) ":" value)
false)
(catch Exception e
(error "Exception thrown while parsing duration" value e)
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))))

View file

@ -0,0 +1,289 @@
(ns dog-and-duck.quack.utils
"Utility functions supporting the picky validator"
(:require [clojure.set :refer [intersection]]
[clojure.string :refer [split]]
[dog-and-duck.quack.constants :refer [activitystreams-context-uri
actor-types
context-key severity-filters
validation-fault-context-uri
activity-types]]
[scot.weft.i18n.core :refer [get-message]]
[taoensso.timbre :as log :refer [warn]])
(: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.
;; (defn actor-type?
;; "Return `true` if the `x` is a recognised actor type, else `false`."
;; [^String x]
;; (if (actor-types x) true false))
(defn truthy?
"Return `true` if `x` is truthy, else `false`. There must be some more
idiomatic way to do this?"
[x]
(if x true false))
(defn xsd-non-negative-integer?
"Return `true` if `value` matches the pattern for an
[xsd:nonNegativeInteger](https://www.w3.org/TR/xmlschema11-2/#nonNegativeInteger), else `false`"
[x]
(and (integer? x)(>= x 0)))
(defn has-type?
"Return `true` if object `x` has a type in `acceptable`, else `false`.
The values of `:type` fields of ActivityStreams objects may be lists; they
are considered to have a type if a member of the list is in `acceptable`.
`acceptable` may be passed as a string, in which case there is only one
acceptable value, or as a set of strings, in which case any member of the
set is acceptable."
[x acceptable]
(assert (map? x) (or (string? acceptable) (set? acceptable)))
(let [tv (:type x)]
(truthy?
(cond
(and (string? acceptable)
(coll? tv)) (not-empty (filter #(= % acceptable) tv))
(and (set? acceptable)
(coll? tv)) (not-empty (filter #(acceptable %) tv))
(string? acceptable) (= tv acceptable)
(set? acceptable) (acceptable tv)))))
(defn object-or-uri?
"Very basic check that `x` is either an object or a URI."
([x]
(try
(cond (string? x) (uri? (URI. x))
(map? x) true
:else false)
(catch URISyntaxException _ false)
(catch NullPointerException _ false)))
([x type]
(if (object-or-uri? x)
(if (map? x)
(has-type? x type)
true)
false)))
;; (defmacro link-or-uri?
;; "Very basic check that `x` is either a link object or a URI."
;; [x]
;; `(if (object-or-uri? ~x) (has-type? ~x "Link") false))
(defn activity-type?
"`true` if `x`, a string, represents a recognised ActivityStreams activity
type."
[^String x]
(if (activity-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 activity-type? tv)))
:else (activity-type? tv))))
;; (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 filter-severity
"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?
(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
#(if (:severity %)
((severity-filters severity) (:severity %))
false)
reports)
:else (throw
(ex-info
"Argument `reports` was not a collection of fault reports"
{:arguments {:reports reports
:severity severity}}))))
(defn context?
"Returns `true` iff `x` quacks like an ActivityStreams context, else false.
A context is either
1. the URI (actually an IRI) `activitystreams-context-uri`, or
2. a collection comprising that URI and a map."
[x]
(cond
(nil? x) false ;; fail fast!
(string? x) (and (= x activitystreams-context-uri) true)
(coll? x) (or
(= ((keyword "@vocab") x) activitystreams-context-uri)
(and (context? (first (remove map? x)))
(= (count x) 2)
true))
:else false))
(defmacro has-context?
"True if `x` is an ActivityStreams object with a valid context, else `false`."
[x]
`(context? (context-key ~x)))
(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
of Java development, and the code for one version of Java won't even compile
in a different version."
(memoize
(fn []
(let [java-version (read-string (apply str (take 2
(split
(System/getProperty "java.version")
#"[_\.]"))))
cmd (case java-version
18 "(let [[_ pid hostname]
(re-find
#\"^(\\d+)@(.*)\"
(.getName
(java.lang.management.ManagementFactory/getRuntimeMXBean)))]
pid)"
(19 110) "(.pid (java.lang.ProcessHandle/current))"
111 "(.getPid (java.lang.management.ManagementFactory/getRuntimeMXBean))"
":default")]
(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))))
(defn make-fault-object
"Return a fault object with these `severity`, `fault` and `narrative` values.
An ActivityPub object MUST have a globally unique ID. Whether this is
meaningful depends on whether we persist fault report objects and serve
them, which at present I have no plans to do."
;; TODO: should not pass in the narrative; instead should use the :fault value
;; to look up the narrative in a resource file.
[severity fault]
(assoc {}
context-key validation-fault-context-uri
:id (str "https://"
(get-hostname)
"/fault/"
(get-pid)
":"
(inst-ms (java.util.Date.)))
:type "Fault"
:severity severity
:fault fault
:narrative (or (get-message fault)
(do
(warn "No narrative provided for fault token " fault)
(str fault)))))
(defmacro nil-if-empty
"if `x` is an empty collection, return `nil`; else return `x`."
[x]
`(if (and (coll? ~x) (empty? ~x)) nil
~x))
(defn concat-non-empty
"Quick function to replace the pattern (nil-if-empty (remove nil? (concat ...)))
which I'm using a lot!"
[& lists]
(nil-if-empty (remove nil? (apply concat lists))))
(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 nil, a string, or a set of strings.
If `acceptable` is `nil`, no type specific tests will be performed."
[x acceptable severity token]
(when acceptable
(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))
(not
(or (string? acceptable)
(set? acceptable))) (throw
(ex-info
"`acceptable` argument not as expected."
{:arguments {:x x
:acceptable acceptable
:severity severity
:token token}})))
(make-fault-object severity token)))))
;; (defn any-or-faults
;; "Return `nil` if validating one of these options returns `nil`; otherwise
;; return a list comprising a fault report object with this `severity-if-none`
;; and this token followed by all the fault reports from validating each
;; option.
;; There are several places - but especially in validating collections - where
;; there are several different valid configurations, but few or no properties
;; are always required."
;; [options severity-if-none token]
;; (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))))
(defn 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))))

7
test/quack/core_test.clj Normal file
View file

@ -0,0 +1,7 @@
(ns quack.core-test
(:require [clojure.test :refer :all]
[quack.core :refer :all]))
(deftest a-test
(testing "FIXME, I fail."
(is (= 0 1))))