Implement SQLite storage #7 (#73)

- new config `:storage-type` (default `:edn`, also support `:sqlite`)
- `LICENSE` change: add exceptions to `next.jdbc` (which uses EPL)

Reviewed-on: https://codeberg.org/eltrac/weepinbell/pulls/73

8 files changed, 193 insertions, 6 deletions

diff --git a/.gitignore b/.gitignore
index ba927a6..560ecec 100644
--- a/.gitignore
+++ b/.gitignore
@@ -21,3 +21,4 @@ pom.xml.asc
 /bellsprout/.lsp/.cache
 /bellsprout/resources/public/css/pico.purged.css
 /bellsprout/node_modules
+*.db
diff --git a/LICENSE b/LICENSE
index bb3effd..630e79a 100644
--- a/LICENSE
+++ b/LICENSE
@@ -669,3 +669,4 @@ If you modify this Program, or any covered work, by linking or combining it with
 * compojure
 * com.taoensso/timbre
 * clj-rss
+* com.github.seancorfield/next.jdbc
diff --git a/project.clj b/project.clj
index a646186..f6b36cc 100644
--- a/project.clj
+++ b/project.clj
@@ -20,10 +20,15 @@
                  [com.taoensso/timbre "6.8.0"]
                  [clj-rss "0.4.0"]
                  [org.nibor.autolink/autolink "0.12.0"]
-                 [io.github.tonsky/fast-edn "1.2.0"]]
+                 [io.github.tonsky/fast-edn "1.2.0"]
+                 [com.github.seancorfield/next.jdbc "1.3.828"]
+                 [org.xerial/sqlite-jdbc "3.53.4.0"]]
   :managed-dependencies [[org.clojure/tools.reader "1.6.0"]
                          [org.ow2.asm/asm "9.11"]]
-  :profiles {:uberjar {:aot :all}
+  :profiles {:uberjar {:aot :all
+                       :uberjar-exclusions [#"^org/sqlite/native/Mac/"
+                                            #"^org/sqlite/native/Windows/"
+                                            #"^org/sqlite/native/Linux-Android/"]}
              :test {:dependencies [[ring/ring-mock "0.6.2"]]}
              :dev {:source-paths ["dev"]
                    :repl-options {:init-ns user
diff --git a/resources/config.edn b/resources/config.edn
index e45eb8a..f73758a 100644
--- a/resources/config.edn
+++ b/resources/config.edn
@@ -2,6 +2,7 @@
  :base-url "http://localhost:3000"
  :endpoint "/endpoint"
  :allowed-target-domains ["example.com"]
+ :storage-type :edn
  :data-path "data/webmention.edn"
  :webhook {:on-receive []
            :on-create []
diff --git a/resources/sql/sqlite_init.sql b/resources/sql/sqlite_init.sql
new file mode 100644
index 0000000..012e9c6
--- /dev/null
+++ b/resources/sql/sqlite_init.sql
@@ -0,0 +1,32 @@
+create table if not exists webmention (
+  id integer primary key autoincrement,
+  hash text not null unique,
+  wm_source text not null,
+  wm_target text not null,
+  wm_source_domain text not null,
+  wm_target_domain text not null,
+  wm_source_path text not null,
+  wm_target_path text not null,
+  lastmod integer not null
+);
+
+create table if not exists microformats (
+  id integer primary key autoincrement,
+  wm_id integer not null,
+  mf_type text not null,
+  mf_data text not null, /* schema on read, store EDN string here */
+
+  FOREIGN KEY (wm_id)
+    references webmention(id)
+    on delete cascade
+);
+
+create table if not exists proxied_photo (
+  id integer primary key autoincrement,
+  wm_id integer not null,
+  url text not null,
+
+  FOREIGN KEY (wm_id)
+    references webmention(id)
+    on delete cascade
+);
diff --git a/src/weepinbell/core.clj b/src/weepinbell/core.clj
index 9082c36..25b1f16 100644
--- a/src/weepinbell/core.clj
+++ b/src/weepinbell/core.clj
@@ -4,6 +4,7 @@
             [weepinbell.config :refer [load-config]]
             [weepinbell.webhook :as webhook]
             [weepinbell.storage.edn-storage :as edn]
+            [weepinbell.storage.sqlite :as sqlite]
             [weepinbell.storage.worker :as worker]
             [clojure.core.async :refer [chan >!! <!!]]
             [taoensso.timbre :as timbre]
@@ -26,7 +27,10 @@
         wmc (chan)
         ;; Storage middle layer, a map of data-manipulating functions.
         ;; Supports various storage as long as the map conforms storage.spec.
-        bare-store (edn/use-store (:data-path config))
+        data-path (:data-path config)
+        bare-store (case (:storage-type config)
+                     :edn (edn/use-store data-path)
+                     :sqlite (sqlite/use-store data-path))
         [stop-worker async-store] (worker/start bare-store)
         ;; Hooks, a map of callback functions that processor calls 
         ;; on certain events. Can be used for webhooks and more.
diff --git a/src/weepinbell/storage/sqlite.clj b/src/weepinbell/storage/sqlite.clj
new file mode 100644
index 0000000..87c475a
--- /dev/null
+++ b/src/weepinbell/storage/sqlite.clj
@@ -0,0 +1,135 @@
+(ns weepinbell.storage.sqlite
+  (:require [clojure.string :refer [blank? split]]
+            [next.jdbc :as jdbc]
+            [next.jdbc.result-set :refer [as-unqualified-lower-maps]]
+            [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]]))
+
+;; data trasnformation utilities
+
+(defn schema->map
+  [{:keys [wm_source wm_target hash lastmod]} mf-row photo-row]
+  (let [parse #(if (string? %) (edn/read-string %) %)
+        mf (parse (:mf_data mf-row))
+        photo (:url photo-row)]
+    (cond-> {:webmention {:source wm_source
+                          :target wm_target
+                          :id hash
+                          :modified lastmod}}
+      (some? mf)    (assoc :microformats mf)
+      (some? photo) (assoc :extra {:proxied-photo photo}))))
+
+(defn wm->schema [data]
+  (let [{:keys [webmention]} data
+        {:keys [id modified source target]} webmention]
+    {:hash id ;; weepinbell's id is hash in sqlite
+     :wm_source source
+     :wm_target target
+     :wm_target_domain (get-domain target)
+     :wm_source_domain (get-domain source)
+     :wm_source_path (get-path source)
+     :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])]
+    {:wm_id wm_id
+     :mf_type (->> mf use-items find-h-entry (search-mftype target) name)
+     ;; conver EDN to raw string
+     :mf_data (pr-str mf)}))
+
+(defn- row->wrapped [ds wm-row]
+  (when wm-row
+    (let [wm_id (:id wm-row)]
+      (schema->map wm-row 
+                   (first (sql/find-by-keys ds :microformats {:wm_id wm_id})) 
+                   (first (sql/find-by-keys ds :proxied_photo {:wm_id wm_id}))))))
+
+;; sql
+
+(defn insert-webmention [ds data]
+  (let [mf (:microformats data)
+        photo (get-in data [:extra :proxied-photo])
+        wm_result (sql/insert! ds :webmention (wm->schema data))
+        wm_id (get wm_result (keyword "last_insert_rowid()"))]
+    (when mf
+      (sql/insert! ds :microformats (mf->schema wm_id data)))
+    (when photo
+      (sql/insert! ds :proxied_photo
+                   {:wm_id wm_id
+                    :url photo}))))
+
+(defn delete-webmention [ds hashcode]
+  ;; microformats and photo will be deleted by
+  ;; cascade rule by SQL, no need to handle it
+  (sql/delete! ds :webmention {:hash hashcode}))
+
+(defn get-webmention-by-hash [ds hashcode]
+  (first (sql/find-by-keys ds :webmention {:hash hashcode})))
+
+(defn get-webmention-by-pair [ds source target]
+  (first (sql/find-by-keys ds :webmention {:wm_source source
+                                           :wm_target target})))
+(defn get-webmention
+  ([ds hashcode]
+   (some->> (get-webmention-by-hash ds hashcode)
+            (row->wrapped ds)))
+  ([ds source target]
+   (some->> (get-webmention-by-pair ds source target)
+            (row->wrapped ds))))
+
+(defn get-webmentions-by-domain
+  ([ds domain]
+   (get-webmentions-by-domain ds domain nil))
+  ([ds domain path]
+   (let [keys (cond-> {:wm_target_domain domain}
+                (some? path) (assoc :wm_target_path path))]
+     (->> (sql/find-by-keys ds :webmention keys)
+          (map (partial row->wrapped ds))))))
+
+(defn- update-related! [ds wm_id data]
+  (let [mf (:microformats 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 :proxied_photo {:wm_id wm_id})
+    (when photo
+      (sql/insert! ds :proxied_photo {:wm_id wm_id :url photo}))))
+
+(defn update-webmention
+  ([ds hashcode new]
+   (when-let [wm (get-webmention-by-hash ds hashcode)]
+     (sql/update! ds :webmention (wm->schema new) {:id (:id wm)})
+     (update-related! ds (:id wm) new)))
+  ([ds source target new]
+   (when-let [wm (get-webmention-by-pair ds source target)]
+     (sql/update! ds :webmention (wm->schema new) {:id (:id wm)})
+     (update-related! ds (:id wm) new))))
+
+(defn make-db [db-file]
+  {:dbtype "sqlite" :dbname db-file})
+(defn make-ds [db]
+  (jdbc/get-datasource db))
+(defn make-datasource [db-file]
+  (jdbc/with-options (make-ds (make-db db-file))
+                     {:builder-fn as-unqualified-lower-maps}))
+
+(def init-sql-script (io/resource "sql/sqlite_init.sql"))
+(defn create-tables [ds]
+  (doseq [:let [statements (-> init-sql-script slurp (split #";"))]
+          statement (remove blank? statements)]
+    (jdbc/execute! ds [statement])))
+
+(defn use-store [db-file]
+  (let [ds (make-datasource db-file)]
+    (create-tables ds)
+    {:append (partial insert-webmention ds)
+     :update (partial update-webmention ds)
+     :delete (partial delete-webmention ds)
+     :get    (partial get-webmention ds)
+     :get-by-domain (partial get-webmentions-by-domain ds)}))
diff --git a/test/weepinbell/storage_test.clj b/test/weepinbell/storage_test.clj
index 91b4ec0..b0df532 100644
--- a/test/weepinbell/storage_test.clj
+++ b/test/weepinbell/storage_test.clj
@@ -1,6 +1,7 @@
 (ns weepinbell.storage-test

   (:require [clojure.test :refer [testing is deftest]]

             [weepinbell.storage.edn-storage :as edns]

+            [weepinbell.storage.sqlite :as sqlite]

             [weepinbell.storage.worker :as worker]

             [clojure.java.io :as io]

             [clojure.spec.alpha :as s]

@@ -11,9 +12,15 @@
 (def test-edn-file "tmp/testfile")

 (when (.exists (io/file test-edn-file))

   (io/delete-file test-edn-file))

+(def test-sqlite-db "tmp/testsqlite.db")

+(when (.exists (io/file test-sqlite-db))

+  (io/delete-file test-sqlite-db))

 

 (def edn-storage (edns/use-store test-edn-file))

+(def sqlite-storage (sqlite/use-store test-sqlite-db))

 (def storages [edn-storage

+               sqlite-storage

+               (last (worker/start sqlite-storage))

                (last (worker/start edn-storage))])

 

 ;; check if storages conform spec

@@ -22,7 +29,8 @@
 (deftest storage-conformity-test

   (testing "edn-storage should conform storage spec."

     (with-redefs [weepinbell.storage.edn-storage/file-exists? (fn [_] true)]

-      (is (spec-check (edns/use-store "source.edn")))))

+      (doseq [storage storages]

+        (is (spec-check storage)))))

   (testing "spec-check invalid storage vtables"

     (doseq [check [{:get-by-domain (fn [_])}

                    {:append (fn [_]) :get (fn [_])}

@@ -64,11 +72,11 @@
 

 (defn- test-append-and-get-list [storage]

   (let [domain "target.com"

-        data [{:webmention {:source "source"

+        data [{:webmention {:source "https://source.net"

                             :target (str "https://" domain "/a")

                             :id "1"

                             :modified (System/currentTimeMillis)}}

-              {:webmention {:source "source"

+              {:webmention {:source "https://source.net"

                             :target (str "https://" domain "/b")

                             :id "2"

                             :modified (System/currentTimeMillis)}}]