(ns dog-and-duck.quack.picky "Fault-finder for ActivityPub documents. 
                              
                              Generally, each `-faults` function will return:
                              
                              1. `nil` if no faults were found;
                              2. a sequence of fault objects if faults were found.
                              
                              Each fault object shall have the properties:
                              
                              1. `:@context` whose value shall be the URL of a 
                                 document specifying this vocabulary;
                              2. `:type` whose value shall be `Fault`;
                              3. `:severity` whose value shall be one of 
                                 `info`, `minor`, `should`, `must` or `critical`;
                              4. `:fault` whose value shall be a unique token
                                 representing the particular fault type;
                              5. `:narrative` whose value shall be a natural
                                 language description of the fault type.
                              
                              Note that the reason for the `:fault` property is
                              to be able to have a well known place, linked to
                              from the @context URL, which allows narratives 
                              for each fault type to be served in as many
                              natural languages as possible.
                              
                              The idea further is that it should ultimately be
                              possible to serialise a fault report as a 
                              document which in its own right conforms to the
                              ActivityStreams spec."
    (:require [dog-and-duck.quack.picky.collections :refer [collection-page-faults
                                                            paged-collection-faults
                                                            simple-collection-faults]]
              [dog-and-duck.quack.picky.constants :refer [actor-types]]
              [dog-and-duck.quack.picky.objects :refer [coll-object-reference-or-fault
                                                        object-faults
                                                        object-reference-or-faults]]
              [dog-and-duck.quack.picky.utils :refer [any-or-faults
                                                      concat-non-empty
                                                      has-activity-type?
                                                      has-actor-type? has-type?
                                                      has-type-or-fault
                                                      make-fault-object
                                                      string-or-fault]])
    (: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 uri-or-fault
  "If `u` is not a valid URI, return a fault object with this `severity` and 
   `if-invalid-token`. If it's `nil`, return a fault object with this `severity`
   and `if-missing-token`. Otherwise return nil."
  ([u severity if-missing-token]
   (uri-or-fault u severity if-missing-token if-missing-token))
  ([u severity if-missing-token if-invalid-token]
   (try
     (if (uri? (URI. u))
       nil
       (make-fault-object severity if-invalid-token))
     (catch URISyntaxException _
       (make-fault-object severity if-invalid-token))
     (catch NullPointerException _
       (make-fault-object severity if-missing-token)))))

(defn persistent-object-faults
  "Return a list of faults found in persistent object `x`, or `nil` if none are."
  ([x]
   (concat-non-empty
    (object-faults x)
    (list
     (if (contains? x :id)
       (try (let [id (URI. (:id x))]
              (when-not (= (.getScheme id) "https")
                (make-fault-object :should :id-not-https)))
            (catch URISyntaxException _
              (make-fault-object :must :id-not-uri))
            (catch NullPointerException _
              (make-fault-object :must :null-id-persistent)))
       (make-fault-object :must :no-id-persistent)))))
  ([x types severity token]
   (concat-non-empty
    (persistent-object-faults x)
    (list
     (has-type-or-fault x types severity token)))))

(defn actor-faults
  "Return a list of faults found in actor `x`, or `nil` if none are."
  [x]
  (concat-non-empty
   (persistent-object-faults x)
   (list
    (when-not (has-actor-type? x)
      (make-fault-object :must :not-actor-type))
    (uri-or-fault
     (:inbox x) :must :no-inbox :invalid-inbox-uri)
    (uri-or-fault
     (:outbox x) :must :no-outbox :invalid-outbox-uri))))

(defn link-faults
  "A link object is required to have an `href` property. It may have all of
   `rel` | `mediaType` | `name` | `hreflang` | `height` | `width` | `preview`
   but I *think* they're all optional."
  [x]
  (concat-non-empty
   (object-reference-or-faults x "Link" :critical :expected-link)
   (list
    (uri-or-fault
     (:href x) :must :no-href-uri :invalid-href-uri)
    (string-or-fault (:mediaType x) :minor :no-media-type #"\w+\/[-+.\w]+")
   ;; TODO: possibly more here. Audit against the specs
    )))

(def ^:const base-activity-required-properties
  "Properties most activities should have. Values are validating functions, each.
   
   See https://www.w3.org/TR/activitystreams-vocabulary/#dfn-activity"
  {:summary (fn [v] (when-not (string? v)
                      (list (make-fault-object :should :no-summary))))
   :actor (fn [v] (object-reference-or-faults v actor-types :must :no-actor))
   :object (fn [v] (object-reference-or-faults v nil :must :no-object))})

(def ^:const intransitive-activity-required-properties
  "Properties intransitive activities should have.
   
   See https://www.w3.org/TR/activitystreams-vocabulary/#dfn-intransitiveactivity"
  (dissoc base-activity-required-properties :object))

(def ^:const accept-required-properties
  "As base-activity-required-properties, except that the type of the object
   is restricted."
  (assoc base-activity-required-properties
         :object
         (fn [v]
           (object-reference-or-faults v #{"Invite" "Person"}
                                       :must
                                       :bad-accept-target))))

(def ^:const activity-required-properties
  "Properties activities should have, keyed by activity type. Values are maps 
   of the format of `base-activity-required-properties`, q.v."
  {"Accept" accept-required-properties
   "Add" base-activity-required-properties
   "Announce" base-activity-required-properties
   "Arrive" intransitive-activity-required-properties
   ;; TODO: is `:location` required for arrive?
   "Block" base-activity-required-properties
   "Create" base-activity-required-properties
   "Delete" base-activity-required-properties
   "Dislike" base-activity-required-properties
   "Flag" base-activity-required-properties
   "Follow" base-activity-required-properties
   ;; TODO: is `:object` required to be an actor?
   "Ignore" base-activity-required-properties
   "Invite" (assoc base-activity-required-properties :target
                   (fn [v]
                     (coll-object-reference-or-fault v #{"Event" "Group"}
                                                     :must
                                                     :bad-accept-target)))
   ;; TODO: are here other things one could meaningfully be invited to?
   "Join" base-activity-required-properties
   "Leave" base-activity-required-properties
   "Like" base-activity-required-properties
   "Listen" base-activity-required-properties
   "Move" base-activity-required-properties
   "Offer" base-activity-required-properties
   "Question" intransitive-activity-required-properties
   "Reject" base-activity-required-properties
   "Read" base-activity-required-properties
   "Remove" base-activity-required-properties
   "TentativeReject" base-activity-required-properties
   "TentativeAccept" accept-required-properties
   "Travel" base-activity-required-properties
   "Undo" base-activity-required-properties
   "Update" base-activity-required-properties
   "View" base-activity-required-properties})

(defn activity-type-faults
  "Return a list of faults found in the activity `x`; if `type` is also 
   specified, it should be a string naming a specific activity type for
   which checks should be performed.
   
   Some specific activity types have specific requirements which are not
   requirements."
  ([x]
   (if (coll? (:type x))
     (map #(activity-type-faults x %) (:type x))
     (activity-type-faults x (:type x))))
  ([x type]
   (let [checks (activity-required-properties type)]
     (map
      #(apply (checks %) (x %))
      (keys checks)))))

(defn activity-faults
  [x]
  (concat-non-empty
   (persistent-object-faults x)
   (activity-type-faults x)
   (list
    (when-not
     (has-activity-type? x)
      (make-fault-object :must :not-activity-type))
    (when-not (string? (:summary x)) (make-fault-object :should :no-summary)))))

(defn collection-faults
  "Return a list of faults found in the collection `x`; if `type` is also 
   specified, it should be a string naming a specific collection type for
   which checks should be performed. 
   
   Every collection *should*(?) have a `totalItems` field (an integer).
   
   Beyond that, collections are either 'just collections' (in which case
   they *should* have an `items` field (a sequence)), or else they're paged
   collections, in which case they *must*(?) have a `first` field which is 
   a collection page or a URI pointing to a collection page, and *should* 
   have a `last` field which is similar.
   
   The pages of collections *should* be collection pages; the pages of 
   ordered collections *should* be ordered collection pages."
  ([x]
   (collection-faults
    x
    (first
     (remove nil?
             (map #(when (has-type? x %) %)
                  ["Collection"
                   "OrderedCollection"
                   "CollectionPage"
                   "OrderedCollectionPage"])))))
  ([x type]
   ;; (log/info "collection-faults called with argumens " x ", " type)
   (case type
     ("Collection" "OrderedCollection") (any-or-faults
                                         (list (simple-collection-faults x type)
                                               (paged-collection-faults x type))
                                         :must
                                         :no-items)
     ("CollectionPage" "OrderedCollectionPage") (collection-page-faults x type)
     (list (make-fault-object :critical :expected-collection)))))
