1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
;; SPDX-License-Identifier: EUPL-1.2
;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com>
(defpackage :ukkoclot/src/db
(:use :c2cl :sqlite)
(:import-from :log)
(:import-from :serapeum :-> :defunion :with-thunk)
(:export :inline-bot-type :blacklisted :whitelisted :get-inline-bot-type :set-inline-bot-type :call-with-db :with-db))
(in-package :ukkoclot/src/db)
(defconstant +target-version+ 1
"Intended DB version")
(deftype db ()
'sqlite-handle)
(-> call-with-db (pathname (function (db) t)) t)
(defun call-with-db (path fn)
"Similar to `with-db', but instead of binding the database in a macro body,
calls the function `fn' with it as an argument."
(let ((db (connect path)))
(unwind-protect (progn (upgrade db)
(funcall fn db))
(disconnect db))))
(defmacro with-db ((name path) &body body)
"Open database specified by `path' and bind it to `name' for the duration of the `body'."
(with-thunk (body name)
`(call-with-db ,path ,body)))
(defunion inline-bot-type
blacklisted
whitelisted)
(-> get-inline-bot-type (db integer) (or inline-bot-type null))
(defun get-inline-bot-type (db id)
(let ((type-int (execute-single db "SELECT type FROM inline_bots WHERE id = ?" id)))
(when type-int
(integer->inline-bot-type type-int))))
(-> set-inline-bot-type (db integer inline-bot-type) (values &optional))
(defun set-inline-bot-type (db id type)
(execute-non-query db
"INSERT OR REPLACE INTO inline_bots (id, type) VALUES (?, ?)"
id
(inline-bot-type->integer type)))
(-> inline-bot-type->integer (inline-bot-type) integer)
(defun inline-bot-type->integer (type)
(etypecase type
(blacklisted 0)
(whitelisted 1)))
(-> integer->inline-bot-type (integer) inline-bot-type)
(defun integer->inline-bot-type (num)
(ecase num
(0 blacklisted)
(1 whitelisted)))
(-> upgrade (db) (values &optional))
(defun upgrade (db)
(execute-non-query db "CREATE TABLE IF NOT EXISTS version(id INTEGER PRIMARY KEY, version INTEGER)")
(let ((current-ver (execute-single db "SELECT version FROM version WHERE id = 0")))
(unless current-ver
(setf current-ver 0))
(cond
((= current-ver +target-version+) (log:info "Database is up to date"))
((> current-ver +target-version+)
(log:error "Database has a higher version than supported?")
(error "Corrupted Database"))
(t
(log:info "Updating database from version ~A to ~A" current-ver +target-version+)
(loop while (< current-ver +target-version+)
do (with-transaction db
(log:info "Updating database step from ~A" current-ver)
(incf current-ver)
(upgrade-step db current-ver)
(execute-non-query
db
"INSERT OR REPLACE INTO version(id, version) VALUES (0, ?)"
current-ver)))
(log:info "Database updating complete :)")))))
(-> upgrade-step (db integer) (values &optional))
(defun upgrade-step (db new-version)
(case new-version
(1
(execute-non-query db "DROP TABLE IF EXISTS inline_bots_enum")
(execute-non-query db "
CREATE TABLE inline_bots_enum (
id INTEGER PRIMARY KEY,
value TEXT UNIQUE)")
(execute-non-query db "
INSERT INTO inline_bots_enum(id, value)
VALUES (?, 'blacklisted'), (?, 'whitelisted')"
(inline-bot-type->integer blacklisted)
(inline-bot-type->integer whitelisted))
(execute-non-query db "DROP TABLE IF EXISTS inline_bots")
(execute-non-query db "
CREATE TABLE inline_bots (
id INTEGER PRIMARY KEY,
type INTEGER REFERENCES inline_bots_enum(id))"))
(otherwise (error "Unreachable upgrade step reached ~A" new-version))))
|
