diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/weepinbell/core.clj | 1 | ||||
| -rw-r--r-- | src/weepinbell/metadata/html_head.clj | 91 | ||||
| -rw-r--r-- | src/weepinbell/metadata/jf2.clj | 32 | ||||
| -rw-r--r-- | src/weepinbell/metadata/jf2_spec.clj | 42 | ||||
| -rw-r--r-- | src/weepinbell/metadata/json_ld.clj | 33 | ||||
| -rw-r--r-- | src/weepinbell/metadata/microformats.clj | 132 | ||||
| -rw-r--r-- | src/weepinbell/microformats/reducer.clj | 26 | ||||
| -rw-r--r-- | src/weepinbell/microformats/searcher.clj | 91 | ||||
| -rw-r--r-- | src/weepinbell/migration.clj | 49 | ||||
| -rw-r--r-- | src/weepinbell/processor/wrapper.clj | 126 | ||||
| -rw-r--r-- | src/weepinbell/processor/writer.clj | 6 | ||||
| -rw-r--r-- | src/weepinbell/storage/h2.clj | 41 | ||||
| -rw-r--r-- | src/weepinbell/storage/spec.clj | 36 | ||||
| -rw-r--r-- | src/weepinbell/utils/url.clj | 4 | ||||
| -rw-r--r-- | src/weepinbell/webserver/handler.clj | 24 | ||||
| -rw-r--r-- | src/weepinbell/webserver/retriever.clj | 111 |
16 files changed, 537 insertions, 308 deletions
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 <head> parser that takes a hickory document, then tries
+ to gather information from basic <meta> properties, Open Graph
+ protocol, Twitter <meta> tags and <link> 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 <meta> 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 <link> 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 <meta> 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 <title>."
+ [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})) |