Extra sqlite3 backend

5 files changed, 185 insertions, 0 deletions

diff --git a/extra/sqlite/README b/extra/sqlite/README
new file mode 100644
index 0000000..a8092fd
--- /dev/null
+++ b/extra/sqlite/README
@@ -0,0 +1,14 @@
+This is an SQLITE3 backend for ERIS, implementing
+https://eris.codeberg.page/eer/sqlite.xml
+
+Due to the foreign dependency and the fact that it may not be suitable for major
+usage, it is not included in the main repo. I don't recommend using this backend for writing for two reasons:
+
+1. Since sqlite is a relational database, not a hash-table, fetching each
+reference takes O(logn) time (with indices). This might hurt compared to a
+hash-table O(1) in cases where there's millions of blocks.
+
+2. Unless your filesystem sucks at handling lots of small files, there is little
+benefit over the simple file-based backend. This might be a major motivation for
+using this backend in FAT32 (65536 max files in a directory ~ max 2GB of ERIS
+data) or NTFS (lots of small files kill it).
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)))
+
diff --git a/extra/sqlite/eris-sqlite.asd b/extra/sqlite/eris-sqlite.asd
new file mode 100644
index 0000000..bec3b0b
--- /dev/null
+++ b/extra/sqlite/eris-sqlite.asd
@@ -0,0 +1,20 @@
+(defsystem "eris-sqlite"
+  :name "eris-sqlite"
+  :author "mail@ykonai.net"
+  :license "LGPLv3 or later"
+  :depends-on ("eris" "sxql" "dbi" )
+  :components ((:file "package")
+               (:file "backend"))
+  :in-order-to ((test-op (test-op :eris-sqlite/test))))
+
+(defsystem "eris-sqlite/test"
+  :name "eris-sqlite"
+  :author "mail@ykonai.net"
+  :license "LGPLv3 or later"
+  :depends-on ("eris" "eris-sqlite" "fiveam" "ironclad" )
+  :components ((:file "tests"))
+  :perform (test-op (op c)
+                    (symbol-call
+                     :fiveam :run!
+                     (find-symbol* :eris-sqlite-tests :eris-sqlite/test))))
+
diff --git a/extra/sqlite/package.lisp b/extra/sqlite/package.lisp
new file mode 100644
index 0000000..6548288
--- /dev/null
+++ b/extra/sqlite/package.lisp
@@ -0,0 +1,3 @@
+(defpackage #:eris-sqlite
+  (:use #:common-lisp #:eris)
+  (:export #:sqlite-backend))
diff --git a/extra/sqlite/tests.lisp b/extra/sqlite/tests.lisp
new file mode 100644
index 0000000..2abab64
--- /dev/null
+++ b/extra/sqlite/tests.lisp
@@ -0,0 +1,71 @@
+;; 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/>.
+
+(defpackage eris-sqlite/test
+  (:use #:common-lisp #:eris-sqlite #:fiveam #:eris))
+
+(in-package :eris-sqlite/test)
+
+(def-suite eris-sqlite-tests
+  :description "Root test suite for eris-sqlite.")
+
+(in-suite eris-sqlite-tests)
+
+
+(defun make-temporary-dir ()
+  (let* ((tmpdir (uiop:temporary-directory))
+         (tmp-tmpdir (make-pathname :directory (serapeum:append1
+                                     (pathname-directory tmpdir)
+                                     (ironclad:byte-array-to-hex-string (ironclad:random-data 10)))
+                         :defaults tmpdir)))
+    (ensure-directories-exist tmp-tmpdir)
+    tmp-tmpdir))
+
+(defun make-octets (len &key (element 0))
+  (make-array len :element-type '(unsigned-byte 8) :initial-element element))
+
+
+(defmacro test-file-backend (array &optional (secret null-secret))
+  `(let ((tmpdir (make-temporary-dir)))
+     (unwind-protect
+          (let* ((backend (make-instance 'sqlite-backend
+                                         :db (make-pathname :name "sqltest" :defaults tmpdir)))
+                 (array ,array))
+            (is (equalp (alexandria:read-stream-content-into-byte-vector
+                         (fetch-data
+                          (store-data array backend :secret ,secret) backend))
+                        array)))
+       (uiop:delete-directory-tree tmpdir :validate t))))
+
+(test simple-file-backend-tests
+  (test-file-backend (make-octets 1023 :element 1))
+  (test-file-backend (make-octets 1025 :element 2))
+  (test-file-backend (make-octets 16383 :element 3))
+  (test-file-backend (make-octets 16384 :element 4))
+  (test-file-backend (make-octets 1 :element 5))
+  (test-file-backend (make-octets 16834 :element 5))
+  (test-file-backend (make-octets 96000 :element 5)))
+
+
+(test simple-file-backend-tests-secret
+  (test-file-backend (make-octets 1023 :element 1) (crypto:random-data 32))
+  (test-file-backend (make-octets 1025 :element 2)  (crypto:random-data 32))
+  (test-file-backend (make-octets 16383 :element 3) (crypto:random-data 32))
+  (test-file-backend (make-octets 16384 :element 4)  (crypto:random-data 32))
+  (test-file-backend (make-octets 1 :element 5)  (crypto:random-data 32))
+  (test-file-backend (make-octets 16834 :element 5) (crypto:random-data 32))
+  (test-file-backend (make-octets 96000 :element 5)  (crypto:random-data 32)))
+
+