Extra sqlite3 backend

1 files changed, 77 insertions, 0 deletions

diff --git a/extra/sqlite/backend.lisp b/extra/sqlite/backend.lisp
new file mode 100644
index 0000000..04d16bc
--- /dev/null
+++ b/extra/sqlite/backend.lisp
@@ -0,0 +1,77 @@
+;; This file is part of eris-cl.
+;; Copyright (C) 2023 Piotr Szarmański
+
+;; eris-cl is free software: you can redistribute it and/or modify it under the
+;; terms of the GNU Lesser General Public License as published by the Free
+;; Software Foundation, either version 3 of the License, or (at your option) any
+;; later version.
+
+;; eris-cl 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
+;; eris-cl. If not, see <https://www.gnu.org/licenses/>.
+
+(in-package :eris-sqlite)
+
+(defclass sqlite-backend (encoding-backend decoding-backend)
+  ((db :initarg :db :type (or string pathname)
+       :documentation
+       "Pathname to the SQLITE database. After initialization, contains a
+DBI:CONNECTION object.")))
+
+(defmethod initialize-instance
+    :after ((sqlite-backend sqlite-backend) &rest initargs &key (db nil db-p) &allow-other-keys)
+  (declare (ignore initargs))
+
+  (when (or (null db-p) (null (pathname-directory db)))
+    (error 'eris::directory-error :message "Incorrectly specified directory."))
+
+  (with-slots ((output-function output-function)
+               (fetch-function fetch-function)
+               (db-slot db)) sqlite-backend
+
+    ;; This means that we never close the connection. Might potentially be a
+    ;; memory leak issue if it's backed up by a foreign memory allocation.
+    (setf db-slot (dbi:connect-cached :sqlite3 :database-name db))
+
+    ;; ensure table exists
+    (dbi:do-sql db-slot
+      "CREATE TABLE IF NOT EXISTS eris_block (
+              block_id INTEGER PRIMARY KEY,
+              ref BLOB UNIQUE,
+              block BLOB
+);")
+
+    ;; ensure index exists
+
+    (dbi:do-sql db-slot
+      "CREATE INDEX IF NOT EXISTS eris_block_index ON eris_block (ref);")
+    
+    (setf fetch-function
+          (lambda (reference)
+            ;; This is slow. Much worse than a proper hash-table. Not sure how
+            ;; to improve on this besides indexing. The spec suggests that
+            ;; foreign keys should be used to reference blocks but I don't see
+            ;; how it could be implemented here.
+
+            (cadr
+             (dbi:fetch
+              (dbi:execute
+               (dbi:prepare
+                db-slot
+                "SELECT block FROM eris_block WHERE (ref = ?)")
+               (list reference)))))
+          output-function
+          (lambda (block reference)
+            (dbi:do-sql db-slot
+              "INSERT OR IGNORE INTO eris_block (ref,block) VALUES (?,?)"
+              (list reference block))
+            block))))
+
+;; Use transactions for block insertion.
+(defmethod store-data (input (backend sqlite-backend) &key (secret null-secret) &allow-other-keys)
+  (dbi:with-transaction (slot-value backend 'db)
+    (call-next-method)))
+