From 573e5f513387ebd34ad9df4b7fe4dc83d7323c8d Mon Sep 17 00:00:00 2001 From: eltrac Date: Thu, 29 Oct 2026 12:42:50 +0100 Subject: all: use JF2 as a single source of truth, compile microformats/JSON-LD/ to JF2 (#80) closes #75 This is a large squash commit. For details, see https://codeberg.org/eltrac/weepinbell/pulls/80 --- src/weepinbell/core.clj | 1 + src/weepinbell/metadata/html_head.clj | 91 +++++++++++++++++++++ src/weepinbell/metadata/jf2.clj | 32 ++++++++ src/weepinbell/metadata/jf2_spec.clj | 42 ++++++++++ src/weepinbell/metadata/json_ld.clj | 33 ++++++++ src/weepinbell/metadata/microformats.clj | 132 +++++++++++++++++++++++++++++++ src/weepinbell/microformats/reducer.clj | 26 ------ src/weepinbell/microformats/searcher.clj | 91 --------------------- src/weepinbell/migration.clj | 49 +++++++++--- src/weepinbell/processor/wrapper.clj | 126 +++++++++++++---------------- src/weepinbell/processor/writer.clj | 6 +- src/weepinbell/storage/h2.clj | 41 +++++----- src/weepinbell/storage/spec.clj | 36 ++++++++- src/weepinbell/utils/url.clj | 4 +- src/weepinbell/webserver/handler.clj | 24 +++--- src/weepinbell/webserver/retriever.clj | 111 ++++++++++---------------- 16 files changed, 537 insertions(+), 308 deletions(-) create mode 100644 src/weepinbell/metadata/html_head.clj create mode 100644 src/weepinbell/metadata/jf2.clj create mode 100644 src/weepinbell/metadata/jf2_spec.clj create mode 100644 src/weepinbell/metadata/json_ld.clj create mode 100644 src/weepinbell/metadata/microformats.clj delete mode 100644 src/weepinbell/microformats/reducer.clj delete mode 100644 src/weepinbell/microformats/searcher.clj (limited to 'src') diff --git a/src/weepinbell/core.clj b/src/weepinbell/core.clj index 903d228..0cc7bda 100644 --- a/src/weepinbell/core.clj +++ b/src/weepinbell/core.clj @@ -86,5 +86,6 @@ (defn -main [& args] (case (first args) "migrate-db" (apply m/edn->h2 (rest args)) + "edn-jf2ify" (apply m/edn-jf2ify (rest args)) (start-engine))) diff --git a/src/weepinbell/metadata/html_head.clj b/src/weepinbell/metadata/html_head.clj new file mode 100644 index 0000000..9a020df --- /dev/null +++ b/src/weepinbell/metadata/html_head.clj @@ -0,0 +1,91 @@ + (ns weepinbell.metadata.html-head + "HTML parser that takes a hickory document, then tries + to gather information from basic properties, Open Graph + protocol, Twitter tags and with rel attribute, + and finally compiles to a JF2 object. + + This namespace also contains some utility functions to manipulate + a hickory document." + (:require [weepinbell.metadata.jf2-spec])) + +(defn get-child + "Get a specific type of tag inside a hickory object." + [tag hickory] + (->> hickory :content (filter #(= (:tag %) tag)) first)) + +(defn get-meta + "Gets tags from a hickory document. Returns a seq of maps. + e.g. ({:name \"description\", :content \"A sentence.\"})" + [hickory] + (->> hickory :content + (filter #(= (:tag %) :meta)) + (map #(get-in % [:attrs])) + (filter #(and (or (:name %) (:property %)) + (:content %))))) +(defn get-rels + "Gets tags with rel attribute from a hickory document. + Returns a seq of maps, e.g. ({:rel ..., :href ...})" + [hickory] + (->> hickory :content + (filter #(= (:tag %) :link)) + (map #(get-in % [:attrs])) + (filter #(and (:rel %) + (:href %))))) +(defn attrs->map + "Converts a seq of maps to a regular map, like this: + ({:name \"a\", :content \"a\"} {:property \"b\", :content \"b\"}) + becomes {\"a\" \"a\", \"b\" \"b\"}" + [meta-attrs] + (let [{:keys [property name content rel href]} meta-attrs] + {(or name property rel) (or content href)})) + +(defn get-metadata + "Takes a hickory data object, returns a map of name/content" + [hickory] + (->> hickory (get-child :html) (get-child :head) + get-meta (map attrs->map) (reduce merge))) + +(defn get-title + "Takes a hickory data object, returns content of ." + [hickory] + (->> hickory (get-child :html) (get-child :head) + :content (filter #(= (:tag %) :title)) first + :content first)) + +(defn get-reldata + "Takes a hickory data object, returns a map of <link> rel/hrefs" + [hickory] + (->> hickory (get-child :html) (get-child :head) + get-rels (map attrs->map) (reduce merge))) + +(defn parse-meta + "Takes hickory document, parses <meta> <link> <title> tags, + returns a jf2 map. Supports Open Graph protocol and more." + [hickory] + (let [data (get-metadata hickory) + rels (get-reldata hickory)] + {:type "entry" + :name (or (get data "og:title") + (get data "twitter:title") + (get-title hickory)) + :url (or (get data "og:url") + (get data "twitter:url") + (get rels "canonical")) + :author {:type "card" + :name (or (get data "article:author") + (get data "twitter:creator") + (get data "profile:username") + (let [fullname + (str (get data "profile:first_name") + " " (get data "profile:last_name"))] + (when (not= fullname " ") fullname))) + :url nil + :photo (get rels "icon")} + :published (get data "article:published_time") + :content "" + :wm-property :mention + :summary (or (get data "og:description") + (get data "description") + (get data "twitter:description"))})) + + diff --git a/src/weepinbell/metadata/jf2.clj b/src/weepinbell/metadata/jf2.clj new file mode 100644 index 0000000..758c381 --- /dev/null +++ b/src/weepinbell/metadata/jf2.clj @@ -0,0 +1,32 @@ +(ns weepinbell.metadata.jf2 + "JF2 parser from various data formats (eg. microformats) to JF2 format." + (:require [hickory.core :as hickory] + [mf2clj.core :as mf] + [weepinbell.metadata.microformats :refer [parse-microformats]] + [weepinbell.metadata.html-head :refer [parse-meta]] + [weepinbell.metadata.json-ld :refer [parse-json-ld]])) + +(defn supplement-merge + "Deep merge maps A and B where B never overrides A. + Supplements A with values A does not have but B has." + [a b] + (let [supplement (fn [acc k v] + (assoc acc k (supplement-merge (get acc k) v)))] + (cond + (nil? a) b + (not (and (map? a) (map? b))) a + :else (reduce-kv supplement a b)))) + +(defn parse + "Takes HTML string, return a JF2 data object compiled from + mircorformats and more sources." + [^String html-string] + {:pre [(string? html-string)]} + (let [mf (mf/parse html-string) + mf->jf2 (parse-microformats mf) + hick (-> html-string hickory/parse hickory/as-hickory) + more [mf->jf2 + (parse-meta hick) + (parse-json-ld hick)]] + (reduce supplement-merge more))) + diff --git a/src/weepinbell/metadata/jf2_spec.clj b/src/weepinbell/metadata/jf2_spec.clj new file mode 100644 index 0000000..f179244 --- /dev/null +++ b/src/weepinbell/metadata/jf2_spec.clj @@ -0,0 +1,42 @@ +(ns weepinbell.metadata.jf2-spec + (:require [clojure.spec.alpha :as s] + [weepinbell.utils.url :refer [valid-http-url?]])) + +(s/def ::type string?) + +(s/def ::name string?) + +(s/def ::url + (s/or :has-value valid-http-url? + :lacks-value nil?)) + +(s/def ::published + (s/or :date-string string? + :timestamp int? + :no-date nil?)) + +(s/def ::author + (s/keys :req-un [::type ::name ::url] + :opt-un [::photo])) + +(s/def ::content + (s/or :content-map (s/keys :req-un [::html ::text]) + :string string?)) + +(s/def ::wm-property + #{:like-of :in-reply-to :repost-of :rsvp :mention + "like-of" "in-reply-to" "repost-of" "rsvp" "mention"}) + +(s/def ::summary + (s/or :has-summary string? + :no-summary nil?)) + +(s/def ::like-of valid-http-url?) +(s/def ::in-reply-to valid-http-url?) +(s/def ::repost-of valid-http-url?) +(s/def ::rsvp valid-http-url?) + +(s/def ::jf2 + (s/keys :req-un [::type ::name ::url ::author ::published ::content ::wm-property] + :opt-un [::summary ::like-of ::in-reply-to ::repost-of ::rsvp])) + diff --git a/src/weepinbell/metadata/json_ld.clj b/src/weepinbell/metadata/json_ld.clj new file mode 100644 index 0000000..5ff098a --- /dev/null +++ b/src/weepinbell/metadata/json_ld.clj @@ -0,0 +1,33 @@ +(ns weepinbell.metadata.json-ld + "JSON-LD parser that finds JSON-LD string in a hickroy document + and then tries to convert it to a JF2 object." + (:require [weepinbell.metadata.html-head :refer [get-child]] + [cheshire.core :as json])) + +(defn- find-json-ld [hickory] + (->> hickory (get-child :html) (get-child :head) :content + (filter #(and (= (:tag %) :script) + (= "application/ld+json" + (get-in % [:attrs :type])))) + first :content first)) + +(defn parse-json-ld + "Takes hickory document, finds <script type=\"application/ld+json\">, + parses JSON, returns a JF2 map." + [hickory] + (let [data (-> hickory find-json-ld json/parse-string) + author (get data "author")] + {:type "entry" + :name (or (get data "headline") + (get data "name")) + :url (get data "url") + :author (when author + {:type "card" + :name (get author "name") + :url (get author "url") + :photo (get-in author ["image" "url"])}) + :published (get data "datePublished") + :content "" + :wm-property :mention + :summary (get data "description")})) + diff --git a/src/weepinbell/metadata/microformats.clj b/src/weepinbell/metadata/microformats.clj new file mode 100644 index 0000000..81317cc --- /dev/null +++ b/src/weepinbell/metadata/microformats.clj @@ -0,0 +1,132 @@ +(ns weepinbell.metadata.microformats + "Microformats parser that converts a microformats map to a JF2 equivalent. + This namespace also contains utilities for handling microformats." + (:require [weepinbell.utils.url :refer [normalize]] + [weepinbell.metadata.jf2-spec])) + +(defn- get-key [data k] + (cond + (not (map? data)) nil + (contains? data k) (get data k) + (keyword? k) (get data (name k)) + (string? k) (get data (keyword k)) + :else nil)) + +(defn- has-key? [data k] + (cond + (not (map? data)) false + (contains? data k) true + (keyword? k) (contains? data (name k)) + (string? k) (contains? data (keyword k)) + :else false)) + +(defn- first-value [value] + (if (and (coll? value) (not (map? value))) + (first value) + value)) + +(defn- type-vector [item] + (let [t (get-key item :type)] + (cond + (nil? t) [] + (coll? t) t + (string? t) [t] + (keyword? t) [(name t)] + :else [t]))) + +(defn use-items [data] + (cond + (not (coll? data)) nil + (empty? data) nil + (has-key? data :items) (get-key data :items) + (sequential? data) data + (has-key? data :type) [data] + :else nil)) + +(defn use-prop-all [property data] + (cond + (not (map? data)) nil + (has-key? data :properties) (get-key (get-key data :properties) property) + (has-key? data property) (get-key data property) + :else nil)) + +(defn use-prop [property data] + (first-value (use-prop-all property data))) + +(defn find-type [mftype items] + (concat (filter #(some #{mftype} (type-vector %)) items) + (mapcat #(find-type mftype (:children %)) items))) +(def find-h-entries (partial find-type "h-entry")) +(def find-h-cards (partial find-type "h-card")) + +(defn find-h-entry [items] + (-> items find-h-entries first)) +(defn find-h-card [items] + (-> items find-h-cards first)) + +(defn search-photo [node] + (if-let [photo (use-prop :photo node)] + (if (map? photo) (get-key photo :value) photo) + (let [author-photo (when-let [card (use-prop :author node)] + (search-photo card))] + (if author-photo author-photo + (when-let [card (use-prop :org node)] + (search-photo card)))))) + +(defn- assoc-wm-property + "Associate like-of, in-reply-to, repost-of and rsvp properties + to J2F base map, and add an additional :wm-property key." + [base h-entry] + (let [data (select-keys (:properties h-entry) + [:like-of :repost-of :in-reply-to :rsvp]) + props (keys data)] + (if (empty? props) + (assoc base :wm-property :mention) + (-> base (merge data) (assoc :wm-property (first props)))))) + +(defn- assoc-content + "Associate content and sumary to J2F base map." + [base h-entry] + (let [content (use-prop :content h-entry) + summary (use-prop :summary h-entry) + get-value (fn [data] + ;; convert microformats "content.value" + ;; to JF2 "content.text", weirdly necessary + (if (and (map? data) (:value data)) + (dissoc (assoc data :text (:value data)) :value) + data))] + (cond-> base + content (assoc :content (get-value content)) + summary (assoc :summary (get-value summary))))) + +(defn- assoc-author + "Associate author map to J2F base map." + [base h-card photo] + (let [author {:type "card" + :name (use-prop :name h-card) + :url (normalize (use-prop :url h-card))} + author (if photo + (assoc author :photo photo) + author)] + (assoc base :author author))) + +(defn parse-microformats + "Convert microformats h-entry to JF2 format/" + [mf] + {:pre [(coll? mf)]} + (let [items (use-items mf) + entry (find-h-entry items) + card (find-h-card items) + author (or (use-prop :author entry) card) + photo (or (search-photo author) + (search-photo card)) + base {:type "entry" + :name (use-prop :name entry) + :url (let [raw-url (use-prop :url entry)] + (normalize + (if (map? raw-url) (:value raw-url) raw-url))) + :published (use-prop :published entry)}] + (-> base + (assoc-author author photo) + (assoc-content entry) + (assoc-wm-property entry)))) diff --git a/src/weepinbell/microformats/reducer.clj b/src/weepinbell/microformats/reducer.clj deleted file mode 100644 index f718451..0000000 --- a/src/weepinbell/microformats/reducer.clj +++ /dev/null @@ -1,26 +0,0 @@ -(ns weepinbell.microformats.reducer - (:require [weepinbell.microformats.searcher :refer [use-items find-h-card find-h-entry - search-photo use-prop search-mftype]] - [clojure.spec.alpha :as s])) - -(s/def ::author - (s/keys :req-un [::name] - :opt-un [::url ::photo])) -(s/def ::reduced-microformats - (s/keys :req-un [::author ::type ::published ::content])) - -(defn reduce-mf [target mf] - (let [items (use-items mf) - entry (find-h-entry items) - card (find-h-card items) - author (or (->> entry (use-prop :author)) - card) - photo (or (search-photo author) - (search-photo card))] - {:author {:name (use-prop :name author) - :url (use-prop :url author) - :photo photo} - :type (search-mftype target entry) - :published (use-prop :published entry) - :content (use-prop :content entry)})) - diff --git a/src/weepinbell/microformats/searcher.clj b/src/weepinbell/microformats/searcher.clj deleted file mode 100644 index e156eb9..0000000 --- a/src/weepinbell/microformats/searcher.clj +++ /dev/null @@ -1,91 +0,0 @@ -(ns weepinbell.microformats.searcher - "This namespace contains functions used for searching in a microformats JSON. - Microformats are indeterministic and dynamic. A specific properties could be - in different places and many forms, thus will require extra effort finding it." - (:require [weepinbell.utils.url :refer [url=]])) - -;; glossary -;; -;; find: finding elements of a specific type in a vector or list -;; search: searching for s specific key in a map -;; use: make sure the data node passed to it is indeed of a specific type, reduce it or return nil otherwise - -(defn- get-key [data k] - (cond - (not (map? data)) nil - (contains? data k) (get data k) - (keyword? k) (get data (name k)) - (string? k) (get data (keyword k)) - :else nil)) - -(defn- has-key? [data k] - (cond - (not (map? data)) false - (contains? data k) true - (keyword? k) (contains? data (name k)) - (string? k) (contains? data (keyword k)) - :else false)) - -;; a property value is usually a vector; unwrap it but leave scalars and -;; unwrapped maps as they are. -(defn- first-value [value] - (if (and (coll? value) (not (map? value))) - (first value) - value)) - -(defn- type-vector [item] - (let [t (get-key item :type)] - (cond - (nil? t) [] - (coll? t) t - (string? t) [t] - (keyword? t) [(name t)] - :else [t]))) - -(defn use-items [data] - (cond - (not (coll? data)) nil - (empty? data) nil - (has-key? data :items) (get-key data :items) - (sequential? data) data - (has-key? data :type) [data] - :else nil)) - -(defn use-prop-all [property data] - (cond - (not (map? data)) nil - (has-key? data :properties) (get-key (get-key data :properties) property) - (has-key? data property) (get-key data property) - :else nil)) - -(defn use-prop [property data] - (first-value (use-prop-all property data))) - -(defn find-type [mftype items] - (concat (filter #(some #{mftype} (type-vector %)) items) - (mapcat #(find-type mftype (:children %)) items))) -(def find-h-entries (partial find-type "h-entry")) -(def find-h-cards (partial find-type "h-card")) - -(defn find-h-entry [items] - (-> items find-h-entries first)) -(defn find-h-card [items] - (-> items find-h-cards first)) - -(defn search-photo [node] - (if-let [photo (use-prop :photo node)] - (if (map? photo) (get-key photo :value) photo) - (let [author-photo (when-let [card (use-prop :author node)] - (search-photo card))] - (if author-photo author-photo - (when-let [card (use-prop :org node)] - (search-photo card)))))) - -(defn search-mftype [target h-entry] - (or - (->> [:like-of :repost-of :in-reply-to :rsvp] - (filter #(some (fn [x] (url= x target)) - (use-prop-all % h-entry))) - first) - :mention)) - diff --git a/src/weepinbell/migration.clj b/src/weepinbell/migration.clj index 6579d84..c029b56 100644 --- a/src/weepinbell/migration.clj +++ b/src/weepinbell/migration.clj @@ -1,12 +1,29 @@ (ns weepinbell.migration + "Migration utilities that is meant to be used as a command in the -main + function. Not to be used inside the system. + Features may be removed when they are not needed." (:require [weepinbell.storage.h2 :as h2] - [weepinbell.storage.edn-storage :as edns]) - #_(:import [org.h2 SQLiteException])) + [weepinbell.storage.edn-storage :as edns] + [weepinbell.storage.spec] + [weepinbell.metadata.microformats :refer [parse-microformats]] + [clojure.java.io :as io] + [fast-edn.core :as edn])) + +(defn mf->jf2 + "Given a Webmention object with microformats, convert it to + jf2, and remove original microformats." + [wm] + {:pre [(map? wm) (contains? wm :microformats)]} + (-> wm + (assoc :jf2 (parse-microformats (:microformats wm))) + (dissoc :microformats))) (defn edn->h2 - "Given a EDN file and a SQLite DB path, migrate data from that + "Given an EDN file and a SQLite DB path, migrate data from that edn file to SQLite DB. It appends data to DB so the destination - db can be empty or it can has some data." + db can be empty or it can has some data. + This also converts microformats to jf2, as the new H2 schema is + incompatible with microformats." [edn-file h2-db] {:pre [(some? edn-file) (some? h2-db)]} (let [ds (h2/make-datasource h2-db)] @@ -16,12 +33,26 @@ (doseq [wm wms] (let [id (get-in wm [:webmention :id])] (println "Appending webmention" id "to database") - (try - (h2/insert-webmention ds wm) -;; (catch SQLiteException e -;; (println "Something wrong with data or database") -;; (println (.getMessage e))) + (try + (let [wm (if (contains? wm :microformats) + (mf->jf2 wm) wm)] + (h2/insert-webmention ds wm)) (catch Exception e (println "Something unexpected happened.") (println (.getMessage e)))))))) (println "Done"))) + +(defn edn-jf2ify + "Given an EDN file with deprecated microformats data, converts + microformats to jf2 and generate a new file in new format." + [old-edn new-edn] + {:pre [(string? old-edn) (string? new-edn)]} + (io/make-parents new-edn) + (.createNewFile (io/file new-edn)) + (with-open [rdr (io/reader old-edn)] + (doseq [wm (map edn/read-string (line-seq rdr))] + (println (get-in wm [:webmention :id])) + (let [new-data (if (contains? wm :microformats) + (mf->jf2 wm) wm)] + (spit new-edn (prn-str new-data) :append true))))) + diff --git a/src/weepinbell/processor/wrapper.clj b/src/weepinbell/processor/wrapper.clj index 8e2a8e2..be43a5b 100644 --- a/src/weepinbell/processor/wrapper.clj +++ b/src/weepinbell/processor/wrapper.clj @@ -1,90 +1,74 @@ (ns weepinbell.processor.wrapper - "Wrapper component wraps a qualified webmention while processing, used by processor. - It adds microformats and extra data and return complete webmention map ready for storage." + "Wrapper component wraps a qualified webmention while processing, part of the pipeline. + It adds metadata and extra, and return complete webmention map ready for storage." (:require [clojure.java.io :as io] [weepinbell.http.downloader :refer [download-file]] - [weepinbell.utils.url :refer [valid-http-url? get-base relative? normalize]] - [weepinbell.microformats.searcher :refer [use-items search-photo find-h-entry find-h-card]] - [mf2clj.core :as mf-parser] + [weepinbell.utils.url :refer [get-base relative? normalize]] + [weepinbell.metadata.jf2 :as jf2] + [weepinbell.metadata.jf2-spec] [taoensso.timbre :as timbre] [weepinbell.utils.digest :refer [digest]] - [clojure.spec.alpha :as s])) + [clojure.string :refer [split]])) -;;;; spec definitions -(s/def ::source valid-http-url?) -(s/def ::target valid-http-url?) -(s/def ::id (s/and string? - #(let [len (count %)] - (or (= len 32) - (= len 8))))) -(s/def ::modified int?) -(s/def ::webmention - (s/keys :req-un [::source ::target ::id ::modified])) - -;; NOTE current microformats parser is unstable -;; will have to postpone microformats spec definition -(s/def ::microformats map?) - -(s/def ::proxied-photo valid-http-url?) -(s/def ::extra - (s/keys :opt-un [::proxied-photo])) - -(s/def ::webmention-wrapped - (s/keys :req-un [::webmention] - :opt-un [::microformats ::extra])) - -;;;; utilities -(defn- find-mf-photo [mf] - (or (->> mf use-items find-h-entry search-photo) - (->> mf use-items find-h-card search-photo))) - -(defn- proxy-mf-photo [photo-base raw-photo] - (if raw-photo - (let [photo-url (str raw-photo) - file-ext (or (re-find #"\.(?:jpg|jpeg|png|gif|webp)" photo-url) ".jpg") - filename (str (digest photo-url) file-ext) - local-path (str "data/avatars/" filename) - public-path (str "/avatars/" filename)] +(defn- proxy-photo + "Download a photo to /data/avatars to serve from our server." + [photo-base raw-photo] + (let [photo-url (str raw-photo) + ;; TODO might need to use MIME-type to get ext + file-ext (str "." (last (split photo-url #"\."))) + filename (str (digest photo-url) file-ext) + local-path (str "data/avatars/" filename) + public-path (str "/avatars/" filename)] ;; download photo if not exists - (when-not (.exists (io/file local-path)) - (timbre/info "Downloading microformats photo to proxy external image.") - (download-file photo-url local-path)) - (str photo-base public-path)) - nil)) + (when-not (.exists (io/file local-path)) + (timbre/info "Downloading author photo to serve locally") + (download-file photo-url local-path)) + (str photo-base public-path))) -(defn complete-url [source-base url] +(defn- complete-url + "Prepend base URL if a URL is relative." + [source-base url] (if (relative? url) (normalize (str source-base url)) url)) -(defn- wrap-webmention - "Parse microformats and collect essential info. - Wrap source, target and collected data into a map and return it." - [id source-html source target photo-base] - (timbre/info "parsing microformats and wrapping up webmention" id) - (let [mf (-> source-html mf-parser/parse :items) - wm {:source source - :target target - :id (digest (str source target)) - :modified (System/currentTimeMillis)} - proxied-photo (->> mf - find-mf-photo - (complete-url (get-base source)) - (proxy-mf-photo photo-base)) - data {:webmention wm - :microformats mf - :extra {:proxied-photo proxied-photo}}] - (when-not (s/valid? ::webmention-wrapped data) - (timbre/warn "webmention" id "data corrupted before writing to storage")) - data)) +;; wrappers +(defn- wrap-webmention-basics + "Wrap basic webmention data, :source :target :id and :modified. + Will use current system time in milliseconds for :modified." + [{:keys [s t]} id] + {:webmention {:source s, :target t, + :id (or id (digest (str s t))), + :modified (System/currentTimeMillis)}}) + +(defn- wrap-jf2 + "Parses JF2 from source html, and associate :jf2 key to it." + [data source-html] + (assoc data :jf2 (-> source-html jf2/parse))) + +(defn- wrap-extra + "Wrap extra data, i.e. proxied photo." + [data photo-base] + (let [{:keys [webmention jf2]} data] + (if-let [photo (get-in jf2 [:author :photo])] + (assoc data :extra + {:proxied-photo + (->> photo + (complete-url (get-base (:source webmention))) + (proxy-photo photo-base))}) + data))) (defn wrap + "Part of the processor pipeline. Takes :source-html from last + handler of the pipeline, parses data from it, wraps data + to :new-data in the data map, and proceed with ok signal." [data config] (when (:ok? data) (let [{:keys [source-html wm id]} data - {:keys [s t]} wm] + new-data (-> wm (wrap-webmention-basics id) + (wrap-jf2 source-html) + (wrap-extra (:base-url config)))] (-> data - (assoc :new-data - (wrap-webmention id source-html s t (:base-url config))) - (assoc :ok true))))) + (assoc :new-data new-data) + (assoc :ok? true))))) diff --git a/src/weepinbell/processor/writer.clj b/src/weepinbell/processor/writer.clj index 02043f1..5bc6725 100644 --- a/src/weepinbell/processor/writer.clj +++ b/src/weepinbell/processor/writer.clj @@ -1,5 +1,7 @@ (ns weepinbell.processor.writer - (:require [taoensso.timbre :as timbre])) + (:require [taoensso.timbre :as timbre] + [weepinbell.storage.spec] + [clojure.spec.alpha :as s])) (defn write [data storage callbacks] @@ -14,4 +16,6 @@ (timbre/info "webmention" id "exists, updating...") ((:update storage) id new-data) ((:on-update callbacks) new-data))) + (when (not (s/valid? :weepinbell.storage.spec/webmention-wrapped new-data)) + (timbre/warn "webmention" id "data does not match spec before writing to storage")) (-> data (assoc :ok? true))))) diff --git a/src/weepinbell/storage/h2.clj b/src/weepinbell/storage/h2.clj index 8d6c2af..4994412 100644 --- a/src/weepinbell/storage/h2.clj +++ b/src/weepinbell/storage/h2.clj @@ -5,22 +5,21 @@ [next.jdbc.sql :as sql] [clojure.java.io :as io] [fast-edn.core :as edn] - [weepinbell.utils.url :refer [get-domain get-path]] - [weepinbell.microformats.searcher :refer [use-items find-h-entry search-mftype]])) + [weepinbell.utils.url :refer [get-domain get-path]])) ;; data trasnformation utilities (defn schema->map [{:keys [wm_source wm_target hash lastmod - mf_data photo_url]}] + jf2_data photo_url]}] (let [parse #(if (string? %) (edn/read-string %) %) - mf (parse mf_data) + jf2 (parse jf2_data) photo photo_url] (cond-> {:webmention {:source wm_source :target wm_target :id hash :modified lastmod}} - (some? mf) (assoc :microformats mf) + (some? jf2) (assoc :jf2 jf2) (some? photo) (assoc :extra {:proxied-photo photo})))) (defn wm->schema [data] @@ -35,39 +34,39 @@ :wm_target_path (get-path target) :lastmod (or modified (System/currentTimeMillis))})) -(defn mf->schema [wm_id data] - (let [mf (:microformats data) - target (get-in data [:webmention :target])] +(defn jf2->schema [wm_id data] + (let [jf2 (:jf2 data) + get-name #(if % (name %) "mention")] {:wm_id wm_id - :mf_type (->> mf use-items find-h-entry (search-mftype target) name) + :jf2_type (->> jf2 :wm-property get-name) ;; conver EDN to raw string - :mf_data (pr-str mf)})) + :jf2_data (pr-str jf2)})) ;; sql (defn insert-webmention [ds data] (jdbc/with-transaction [tx ds] (let [tx (jdbc/with-options tx {:builder-fn as-unqualified-lower-maps}) - mf (:microformats data) + jf2 (:jf2 data) photo (get-in data [:extra :proxied-photo]) wm_result (sql/insert! tx :webmention (wm->schema data)) wm_id (:id wm_result)] - (when mf - (sql/insert! tx :microformats (mf->schema wm_id data))) + (when jf2 + (sql/insert! tx :jf2 (jf2->schema wm_id data))) (when photo (sql/insert! tx :proxied_photo {:wm_id wm_id :url photo}))))) (defn delete-webmention [ds hashcode] - ;; microformats and photo will be deleted by + ;; jf2 data and photo will be deleted by ;; cascade rule by SQL, no need to handle it (sql/delete! ds :webmention {:hash hashcode})) -(def base-sql "SELECT w.*, m.mf_data, m.mf_type, p.url AS photo_url +(def base-sql "SELECT w.*, j.jf2_data, j.jf2_type, p.url AS photo_url FROM webmention w - LEFT JOIN microformats m - ON w.id = m.wm_id + LEFT JOIN jf2 j + ON w.id = j.wm_id LEFT JOIN proxied_photo p ON w.id = p.wm_id") @@ -107,11 +106,11 @@ (map schema->map r)))) (defn- update-related! [ds wm_id data] - (let [mf (:microformats data) + (let [jf2 (:jf2 data) photo (get-in data [:extra :proxied-photo])] - (sql/delete! ds :microformats {:wm_id wm_id}) - (when mf - (sql/insert! ds :microformats (mf->schema wm_id data))) + (sql/delete! ds :jf2 {:wm_id wm_id}) + (when jf2 + (sql/insert! ds jf2 (jf2->schema wm_id data))) (sql/delete! ds :proxied_photo {:wm_id wm_id}) (when photo (sql/insert! ds :proxied_photo {:wm_id wm_id :url photo})))) diff --git a/src/weepinbell/storage/spec.clj b/src/weepinbell/storage/spec.clj index d7d6469..6a09b29 100644 --- a/src/weepinbell/storage/spec.clj +++ b/src/weepinbell/storage/spec.clj @@ -1,10 +1,40 @@ (ns weepinbell.storage.spec "Spec of storage middle layer, which is a vtable/map of storage functions. The spec makes sure any map is a valid storage vtable." - (:require [clojure.spec.alpha :as s])) + (:require [clojure.spec.alpha :as s] + [weepinbell.utils.url :refer [valid-http-url?]])) + +;; storage vtable + +(s/def ::append fn?) +(s/def ::update fn?) +(s/def ::delete fn?) +(s/def ::get fn?) +(s/def ::get-by-domain fn?) (s/def ::vtable (s/keys :req-un [::append ::update ::delete ::get ::get-by-domain])) -;; TODO Needs to define specs for ::append ::update and other keys. -;; make sure they're functions and has the right paramters. +;; storage schema + +(s/def ::source valid-http-url?) +(s/def ::target valid-http-url?) +(s/def ::id (s/and string? + #(let [len (count %)] + (or (= len 32) + (= len 8))))) +(s/def ::modified int?) +(s/def ::webmention + (s/keys :req-un [::source ::target ::id ::modified])) + +(s/def ::jf2 + #(s/valid? :weepinbell.metadata.jf2-spec/jf2 %)) + +(s/def ::proxied-photo valid-http-url?) +(s/def ::extra + (s/keys :opt-un [::proxied-photo])) + +(s/def ::webmention-wrapped + (s/keys :req-un [::webmention] + :opt-un [::jf2 ::extra])) + diff --git a/src/weepinbell/utils/url.clj b/src/weepinbell/utils/url.clj index 9b25cd2..49c8535 100644 --- a/src/weepinbell/utils/url.clj +++ b/src/weepinbell/utils/url.clj @@ -58,8 +58,8 @@ query (normalize-query (.getQuery base))] (str scheme "://" auth path (when (seq query) (str "?" query)))) - ;; fallback to empty string is url is nil - (catch NullPointerException _ "") + ;; return nil is url is nil + (catch NullPointerException _ nil) ;; fallback to original string if syntax is invalid (catch URISyntaxException _ url))) diff --git a/src/weepinbell/webserver/handler.clj b/src/weepinbell/webserver/handler.clj index 7f40f57..70c26d2 100644 --- a/src/weepinbell/webserver/handler.clj +++ b/src/weepinbell/webserver/handler.clj @@ -35,30 +35,26 @@ (POST "/send" [source target] (receive {:s source :t target} wmc config)) ;; query webmention list - (context "/mentions" [page microformats mftype] + (context "/mentions" [page jf2type] (GET "/" [url] (retrieve-by-url url page store - {:microformats microformats - :type mftype})) + {:type jf2type})) (GET "/:domain" [domain] (retrieve-by-domain domain page store - {:microformats microformats - :type mftype}))) + {:type jf2type}))) ;; query count of webmention list - (context "/count" [mftype] + (context "/count" [jf2type] (GET "/" [url] - (count-by-url url store {:type mftype})) + (count-by-url url store {:type jf2type})) (GET "/:domain" [domain] - (count-by-domain domain store {:type mftype}))) + (count-by-domain domain store {:type jf2type}))) ;; query one specific webmention - (context "/mention" [microformats] - (GET "/:id" [id] (retrieve-by-id id store - {:microformats microformats})) - (GET "/" [source target] (retrieve-by-pair source target store - {:microformats microformats})))) + (context "/mention" [] + (GET "/:id" [id] (retrieve-by-id id store)) + (GET "/" [source target] (retrieve-by-pair source target store)))) ;; RSS feed (GET "/feed/:domain" [domain] (gen-feed domain store config)) - ;; host proxied avatars (microformats photos) + ;; host proxied avatars (jf2 photos) (route/files "/avatars/" {:root "data/avatars"}) ;; 404 (route/not-found "Not Found")])) diff --git a/src/weepinbell/webserver/retriever.clj b/src/weepinbell/webserver/retriever.clj index e8b4485..986db8e 100644 --- a/src/weepinbell/webserver/retriever.clj +++ b/src/weepinbell/webserver/retriever.clj @@ -1,10 +1,7 @@ (ns weepinbell.webserver.retriever "Service getting webmention form storage and wrapping it in a response." (:require [weepinbell.utils.url :refer [get-domain get-path]] - [weepinbell.microformats.reducer :refer [reduce-mf]] - [weepinbell.microformats.searcher :as mfsr] - [ring.util.http-response :refer [bad-request not-found ok]] - [clojure.spec.alpha :as s])) + [ring.util.http-response :refer [bad-request not-found ok]])) (def default-page-size 12) @@ -17,63 +14,46 @@ (defn- respond-webmention-list-json [data] (cond - (false? data) (bad-request {:message "Page number is invalid. Either too large or not a number."}) + (= data :OOB) (bad-request {:message "Page number is too large."}) (empty? data) (not-found {:message "The requested webmention list does not exist."}) :else (ok data))) ;; query list of webmentions -(defn- mftype= [& types] - (apply = (map keyword types))) -(defn- filter-by-mftype - [mftype data] - (if (nil? mftype) data - (->> data - (map (fn [item] - [(get-in item [:webmention :target]) - item])) - (filter (fn [[target item]] - (->> item - :microformats - mfsr/use-items - mfsr/find-h-entry - (mfsr/search-mftype target) - (mftype= mftype)))) - (map last)))) - -(defn- paging [^Long page ^Long page-size data] - (if (nil? page) data - (let [pages (vec (partition-all - (or page-size default-page-size) - data)) - page-number (if (number? page) page - (- (count pages) 1))] - (get pages page-number)))) - -(defn- reduce-helper [wm] - (if-let [mf (:microformats wm)] - (if (empty? mf) - (dissoc wm :microformats) - (let [target (get-in wm [:webmention :target]) - reduced (reduce-mf target mf)] - (assoc wm :microformats reduced))) - wm)) -(defn- reduce-microformats [mf-opt data] - (if (= mf-opt "raw") data - (map reduce-helper data))) +(defn- filter-by-jf2type + [jf2type data] + (if (nil? jf2type) data + (filter #(= jf2type (get-in % [:jf2 :wm-property])) data))) + +(defn- paging + "Paging utility, given a full set of data, partition it and return + the requested frame. + Returns the last frame if page number is not a number, as a fallback. + Returns :OOB (Out Of Bounds) if page number is too large." + [^Long page ^Long page-size data] + (if (nil? page) + ;; if no page number, return the whole query-list + data + ;; otherwise, partition all and return the requested frame + (let [pages (->> data (partition-all page-size) vec) + npages (count pages) + page-number (if (number? page) page + (- (count pages) 1))] + (if (>= page-number npages) + :OOB ; Out Of Bounds + (get pages page-number))))) (defn query-list "Get a list of webmentions by certain filters." - {:pre [(s/keys :req-un [::domain ::path ::page ::page-size ::storage ::mftype])]} - [opts] - (let [{:keys [domain path page page-size storage mftype]} opts - ;; parse to number if possible, use original if not + [{:keys [^String domain, ^String path, ^Long page, ^Long page-size + storage mftype]}] + {:pre [(contains? storage :get-by-domain)]} + (let [;; parse to number if possible, use original if not page (try (Long/parseLong page) (catch Exception _ page)) ;; data trasformations data ((:get-by-domain storage path) domain) - data (filter-by-mftype mftype data) - data (paging page page-size data) - data (reduce-microformats (:microformats opts) data)] + data (filter-by-jf2type mftype data) + data (paging page page-size data)] (respond-webmention-list-json data))) (defn by-domain @@ -84,8 +64,7 @@ :page page :page-size default-page-size :storage storage - :mftype (:type opts) - :microformats (:microformats opts)})) + :mftype (:type opts)})) (defn by-url "Get webmention sent to a particular URL." @@ -96,8 +75,7 @@ :page page :page-size default-page-size :storage storage - :mftype (:type opts) - :microformats (:microformats opts)}) + :mftype (:type opts)}) {:status 400 :body {:message "Missing URL. Specify target URL whose webmentions you are querying."}})) @@ -106,28 +84,21 @@ (defn query-one "Get one specific webmention by id or by its source and target." [opts] - {:post [(s/keys :req-un [::identifiers ::storage ::microformats])]} - (let [{:keys [identifiers storage microformats]} opts - reduce-mf? (not= "raw" microformats) - data (apply (:get storage) identifiers) - result (if (and (:microformats data) reduce-mf?) - (assoc data :microformats - (reduce-mf (get-in (:microformats data) [:webmention :target]) - (:microformats data))) - data)] - (respond-webmention-json result))) + {:post [(vector? (:identifiers opts)) + (contains? (:storage opts) :get)]} + (let [{:keys [identifiers storage]} opts + data (apply (:get storage) identifiers)] + (respond-webmention-json data))) (defn by-id "Get one specific webmention by ID." - [id storage opts] + [id storage] (query-one {:identifiers [id] - :storage storage - :microformats (:microformats opts)})) + :storage storage})) (defn by-st-pair "Get one specific webmention by source and target." - [source target storage opts] + [source target storage] (query-one {:identifiers [source target] - :storage storage - :microformats (:microformats opts)})) + :storage storage})) -- cgit v1.2.3