From 6b3457b35cbcea4e28d3482263a36ae6db39fc8f Mon Sep 17 00:00:00 2001
From: Piotr Szarmanski
Date: Fri, 4 Aug 2023 18:37:51 +0200
Subject: Extra sqlite3 backend
---
extra/sqlite/README | 14 ++++++++
extra/sqlite/backend.lisp | 77 ++++++++++++++++++++++++++++++++++++++++++++
extra/sqlite/eris-sqlite.asd | 20 ++++++++++++
extra/sqlite/package.lisp | 3 ++
extra/sqlite/tests.lisp | 71 ++++++++++++++++++++++++++++++++++++++++
5 files changed, 185 insertions(+)
create mode 100644 extra/sqlite/README
create mode 100644 extra/sqlite/backend.lisp
create mode 100644 extra/sqlite/eris-sqlite.asd
create mode 100644 extra/sqlite/package.lisp
create mode 100644 extra/sqlite/tests.lisp
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 .
+
+(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 .
+
+(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)))
+
+
--
cgit v1.2.3