diff options
| -rw-r--r-- | extra/sqlite/README | 14 | ||||
| -rw-r--r-- | extra/sqlite/backend.lisp | 77 | ||||
| -rw-r--r-- | extra/sqlite/eris-sqlite.asd | 20 | ||||
| -rw-r--r-- | extra/sqlite/package.lisp | 3 | ||||
| -rw-r--r-- | extra/sqlite/tests.lisp | 71 |
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))) + + |