diff options
Diffstat (limited to 'src/db.lisp')
| -rw-r--r-- | src/db.lisp | 82 |
1 files changed, 82 insertions, 0 deletions
diff --git a/src/db.lisp b/src/db.lisp new file mode 100644 index 0000000..9b646d2 --- /dev/null +++ b/src/db.lisp | |||
| @@ -0,0 +1,82 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | ||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | ||
| 3 | (defpackage :ukkoclot/db | ||
| 4 | (:use :c2cl :sqlite :ukkoclot/log) | ||
| 5 | (:export :get-inline-bot-type :set-inline-bot-type :with-db)) | ||
| 6 | (in-package :ukkoclot/db) | ||
| 7 | |||
| 8 | (defparameter +target-version+ 1 | ||
| 9 | "Intended DB version") | ||
| 10 | |||
| 11 | (defmacro with-db ((name path) &body body) | ||
| 12 | `(let ((,name (connect ,path))) | ||
| 13 | (unwind-protect (progn (upgrade ,name) ,@body) | ||
| 14 | (disconnect ,name)))) | ||
| 15 | |||
| 16 | (defun get-inline-bot-type (db id) | ||
| 17 | (let ((type-int (execute-single db "SELECT type FROM inline_bots WHERE id = ?" id))) | ||
| 18 | (when type-int | ||
| 19 | (integer->inline-bot-type type-int)))) | ||
| 20 | |||
| 21 | (defun set-inline-bot-type (db id type) | ||
| 22 | (execute-non-query db "INSERT OR REPLACE INTO inline_bots (id, type) VALUES (?, ?)" id (inline-bot-type->integer type))) | ||
| 23 | |||
| 24 | (defun inline-bot-type->integer (type) | ||
| 25 | (case type | ||
| 26 | (:blacklisted 0) | ||
| 27 | (:whitelisted 1) | ||
| 28 | (t (error "Unknown inline bot type ~S" type)))) | ||
| 29 | |||
| 30 | (defun integer->inline-bot-type (num) | ||
| 31 | (case num | ||
| 32 | (0 :blacklisted) | ||
| 33 | (1 :whitelisted) | ||
| 34 | (t (error "Unknown inline bot type value ~S" num)))) | ||
| 35 | |||
| 36 | (defun upgrade (db) | ||
| 37 | (execute-non-query db "CREATE TABLE IF NOT EXISTS version(id INTEGER PRIMARY KEY, version INTEGER)") | ||
| 38 | (let ((current-ver (execute-single db "SELECT version FROM version WHERE id = 0"))) | ||
| 39 | (unless current-ver | ||
| 40 | (setf current-ver 0)) | ||
| 41 | (cond | ||
| 42 | ((= current-ver +target-version+) (log-info "Database is up to date")) | ||
| 43 | |||
| 44 | ((> current-ver +target-version+) | ||
| 45 | (log-error "Database has a higher version than supported?") | ||
| 46 | (error "Corrupted Database")) | ||
| 47 | |||
| 48 | (t | ||
| 49 | (log-info "Updating database from version ~A to ~A" current-ver +target-version+) | ||
| 50 | (loop while (< current-ver +target-version+) | ||
| 51 | do (with-transaction db | ||
| 52 | (log-info "Updating database step from ~A" current-ver) | ||
| 53 | (incf current-ver) | ||
| 54 | (upgrade-step db current-ver) | ||
| 55 | (execute-non-query | ||
| 56 | db | ||
| 57 | "INSERT OR REPLACE INTO version(id, version) VALUES (0, ?)" | ||
| 58 | current-ver))) | ||
| 59 | (log-info "Database updating complete :)"))))) | ||
| 60 | |||
| 61 | (defun upgrade-step (db new-version) | ||
| 62 | (case new-version | ||
| 63 | (1 | ||
| 64 | (execute-non-query db "DROP TABLE IF EXISTS inline_bots_enum") | ||
| 65 | (execute-non-query db " | ||
| 66 | CREATE TABLE inline_bots_enum ( | ||
| 67 | id INTEGER PRIMARY KEY, | ||
| 68 | value TEXT UNIQUE | ||
| 69 | )") | ||
| 70 | (execute-non-query db " | ||
| 71 | INSERT INTO inline_bots_enum(id, value) | ||
| 72 | VALUES (?, 'blacklisted'), (?, 'whitelisted')" | ||
| 73 | (inline-bot-type->integer :blacklisted) | ||
| 74 | (inline-bot-type->integer :whitelisted)) | ||
| 75 | |||
| 76 | (execute-non-query db "DROP TABLE IF EXISTS inline_bots") | ||
| 77 | (execute-non-query db " | ||
| 78 | CREATE TABLE inline_bots ( | ||
| 79 | id INTEGER PRIMARY KEY, | ||
| 80 | type INTEGER REFERENCES inline_bots_enum(id) | ||
| 81 | )")) | ||
| 82 | (t (error "Unreachable upgrade step reached ~A" new-version)))) | ||