diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/config.lisp | 97 | ||||
| -rw-r--r-- | src/inline-bots.lisp | 7 | ||||
| -rw-r--r-- | src/main.lisp | 38 | ||||
| -rw-r--r-- | src/state.lisp | 17 |
4 files changed, 103 insertions, 56 deletions
diff --git a/src/config.lisp b/src/config.lisp index 55575bb..03ded98 100644 --- a/src/config.lisp +++ b/src/config.lisp | |||
| @@ -1,33 +1,76 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | 1 | ;; SPDX-License-Identifier: EUPL-1.2 |
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> |
| 3 | (defpackage :ukkoclot/config | 3 | (defpackage :ukkoclot/config |
| 4 | (:use :c2cl :ukkoclot/hash-tables) | 4 | (:documentation "Stuff for loading the configuration of the bot") |
| 5 | (:documentation | 5 | (:nicknames :conf) |
| 6 | "Stuff for loading the configuration of the bot") | 6 | (:use :c2cl :iterate) |
| 7 | (:export | 7 | (:export |
| 8 | :config-load :config-merge | 8 | #:*config* |
| 9 | :config-p | 9 | #:config |
| 10 | :config-bot-name :config-bot-token :config-db-path :config-dev-group :config-owner)) | 10 | #:make-config |
| 11 | #:config-p | ||
| 12 | #:copy-config | ||
| 13 | #:load-config | ||
| 14 | #:print-default | ||
| 15 | #:bot-name | ||
| 16 | #:bot-token | ||
| 17 | #:db-path | ||
| 18 | #:dev-group | ||
| 19 | #:owner)) | ||
| 11 | (in-package :ukkoclot/config) | 20 | (in-package :ukkoclot/config) |
| 12 | 21 | ||
| 13 | (defmacro defconfig (&rest slots-and-types) | 22 | (defstruct config |
| 14 | "Macro to make the config struct creation easier." | 23 | (bot-name "Ukko's Clot" :type string) |
| 15 | `(defstruct config | 24 | (bot-token "123456789:ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghi" :type string) |
| 16 | ,@(loop for (name type) on slots-and-types by #'cddr | 25 | (db-path #P"./data.db" :type (or pathname string)) |
| 17 | collect `(,(intern (symbol-name name)) (error "No value given for ~A" ,name) :type ,type :read-only t)))) | 26 | (dev-group -1001234567890 :type integer) |
| 18 | 27 | (owner 12345678 :type integer)) | |
| 19 | (defconfig | 28 | |
| 20 | :bot-name string | 29 | (defvar *config* (make-config) |
| 21 | :bot-token string | 30 | "Bot's configuration") |
| 22 | :db-path string | 31 | |
| 23 | :dev-group integer | 32 | (defun bot-name (&optional (config *config*)) |
| 24 | :owner integer) | 33 | "Get the desired name for the bot" |
| 25 | 34 | (config-bot-name config)) | |
| 26 | (defun config-load (filename) | 35 | |
| 27 | "Load the config from the given `filename'. All entries must be specified." | 36 | (defun bot-token (&optional (config *config*)) |
| 28 | (apply #'make-config (with-open-file (f filename) (read f)))) | 37 | "Get the API token for the bot" |
| 29 | 38 | (config-bot-token config)) | |
| 30 | (defun config-merge (config filename) | 39 | |
| 31 | "Merge the current config with new entries from `filename'." | 40 | (defun db-path (&optional (config *config*)) |
| 32 | (loop for (name value) on (with-open-file (f filename) (read f)) by #'cddr do | 41 | "Get the path to the bot's database" |
| 33 | (setf (slot-value config (intern (symbol-name name) :ukkoclot/config)) value))) | 42 | (config-db-path config)) |
| 43 | |||
| 44 | (defun dev-group (&optional (config *config*)) | ||
| 45 | "Get the ID of the dev/testing group" | ||
| 46 | (config-dev-group config)) | ||
| 47 | |||
| 48 | (defun owner (&optional (config *config*)) | ||
| 49 | "Get the ID of the bot's owner" | ||
| 50 | (config-owner config)) | ||
| 51 | |||
| 52 | (defun load-config (filename &optional (config *config*)) | ||
| 53 | "Load config from the given `filename'." | ||
| 54 | (prog1 config | ||
| 55 | (let ((data (with-open-file (f filename) (read f)))) | ||
| 56 | (iter | ||
| 57 | (for (kw-name value) on data by #'cddr) | ||
| 58 | (let ((name (intern (symbol-name kw-name) :ukkoclot/config))) | ||
| 59 | (setf (slot-value config name) value)))))) | ||
| 60 | |||
| 61 | (defun serialize (config) | ||
| 62 | "Serializes the config to a plist." | ||
| 63 | (iter | ||
| 64 | (for slot in (class-direct-slots (class-of config))) | ||
| 65 | (appending | ||
| 66 | (let* ((name (slot-definition-name slot)) | ||
| 67 | (kw-name (intern (symbol-name name) :keyword))) | ||
| 68 | (list kw-name (slot-value config name)))))) | ||
| 69 | |||
| 70 | (defun print-default (filename) | ||
| 71 | "Prints the default config to the given `filename'." | ||
| 72 | (with-open-file (f filename :direction :output :if-exists :supersede) | ||
| 73 | (format f ";; lint:suppress in-package spdx-license-identifier~%") | ||
| 74 | (format f ";; Copy this file to config.lisp and modify it there~%") | ||
| 75 | (let ((data (serialize (make-config)))) | ||
| 76 | (format f "~<(~;~@{~(~W~) ~W~^ ~_~}~;)~:>~%" data)))) | ||
diff --git a/src/inline-bots.lisp b/src/inline-bots.lisp index 6001cb2..47dd81b 100644 --- a/src/inline-bots.lisp +++ b/src/inline-bots.lisp | |||
| @@ -2,11 +2,12 @@ | |||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> |
| 3 | (defpackage :ukkoclot/inline-bots | 3 | (defpackage :ukkoclot/inline-bots |
| 4 | (:documentation "This package deals with removing unwanted inline bot usage") | 4 | (:documentation "This package deals with removing unwanted inline bot usage") |
| 5 | (:use :c2cl :ukkoclot/config :ukkoclot/tg) | 5 | (:use :c2cl :ukkoclot/tg) |
| 6 | (:import-from :com.dieggsy.f-string :enable-f-strings) | 6 | (:import-from :com.dieggsy.f-string :enable-f-strings) |
| 7 | (:import-from :conf) | ||
| 7 | (:import-from :log) | 8 | (:import-from :log) |
| 8 | (:import-from :ukkoclot/tg :send-message :try-delete-message) | 9 | (:import-from :ukkoclot/tg :send-message :try-delete-message) |
| 9 | (:import-from :ukkoclot/state :bot-config :bot-db) | 10 | (:import-from :ukkoclot/state :bot-db) |
| 10 | (:local-nicknames (:db :ukkoclot/db)) | 11 | (:local-nicknames (:db :ukkoclot/db)) |
| 11 | (:export :blacklist-inline-bot :on-inline-bot :whitelist-inline-bot)) | 12 | (:export :blacklist-inline-bot :on-inline-bot :whitelist-inline-bot)) |
| 12 | (in-package :ukkoclot/inline-bots) | 13 | (in-package :ukkoclot/inline-bots) |
| @@ -41,7 +42,7 @@ Its messages will no longer be deleted." | |||
| 41 | :callback-data #f"bbl:{(user-id via)}"))) | 42 | :callback-data #f"bbl:{(user-id via)}"))) |
| 42 | (send-message | 43 | (send-message |
| 43 | bot | 44 | bot |
| 44 | :chat-id (config-dev-group (bot-config bot)) | 45 | :chat-id (conf:dev-group) |
| 45 | :text #f"Deleted a message sent via inline bot @{(user-username via)} <code>{(user-id via)}</code>" | 46 | :text #f"Deleted a message sent via inline bot @{(user-username via)} <code>{(user-id via)}</code>" |
| 46 | :parse-mode html | 47 | :parse-mode html |
| 47 | :reply-markup (make-inline-keyboard-markup | 48 | :reply-markup (make-inline-keyboard-markup |
diff --git a/src/main.lisp b/src/main.lisp index 5d3cf76..be17168 100644 --- a/src/main.lisp +++ b/src/main.lisp | |||
| @@ -2,15 +2,16 @@ | |||
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> |
| 3 | (defpackage :ukkoclot/main | 3 | (defpackage :ukkoclot/main |
| 4 | (:nicknames :ukkoclot) | 4 | (:nicknames :ukkoclot) |
| 5 | (:use :c2cl :iterate :ukkoclot/config :ukkoclot/inline-bots :ukkoclot/tg) | 5 | (:use :c2cl :iterate :ukkoclot/inline-bots :ukkoclot/tg) |
| 6 | (:import-from :alexandria :when-let) | 6 | (:import-from :alexandria :when-let) |
| 7 | (:import-from :com.dieggsy.f-string :enable-f-strings) | 7 | (:import-from :com.dieggsy.f-string :enable-f-strings) |
| 8 | (:import-from :conf) | ||
| 8 | (:import-from :log) | 9 | (:import-from :log) |
| 9 | (:import-from :serapeum :drop) | 10 | (:import-from :serapeum :drop) |
| 10 | (:import-from :str) | 11 | (:import-from :str) |
| 11 | (:import-from :ukkoclot/db :with-db) | 12 | (:import-from :ukkoclot/db :with-db) |
| 12 | (:import-from :ukkoclot/serializing :fixup-value) | 13 | (:import-from :ukkoclot/serializing :fixup-value) |
| 13 | (:import-from :ukkoclot/state :make-bot :bot-config :bot-power-on) | 14 | (:import-from :ukkoclot/state :make-bot :bot-power-on) |
| 14 | (:import-from :ukkoclot/strings :escape-xml :is-tg-whitespace :is-tg-whitespace-str) | 15 | (:import-from :ukkoclot/strings :escape-xml :is-tg-whitespace :is-tg-whitespace-str) |
| 15 | (:local-nicknames | 16 | (:local-nicknames |
| 16 | (:jzon :com.inuoe.jzon)) | 17 | (:jzon :com.inuoe.jzon)) |
| @@ -31,25 +32,26 @@ | |||
| 31 | (defun main () | 32 | (defun main () |
| 32 | (log:config :debug) | 33 | (log:config :debug) |
| 33 | (unwind-protect | 34 | (unwind-protect |
| 34 | (let ((config (config-load #P"config.default.lisp"))) | 35 | (progn |
| 35 | (config-merge config #P"config.lisp") | 36 | (conf:print-default #P"config.default.lisp") |
| 36 | (log:info "Starting up ~A" (config-bot-name config)) | 37 | (conf:load-config #P"config.lisp") |
| 37 | (main-with-config config) | 38 | (log:info "Starting up ~A" (conf:bot-name)) |
| 39 | (main-with-config) | ||
| 38 | nil) | 40 | nil) |
| 39 | (log:info "Quitting!"))) | 41 | (log:info "Quitting!"))) |
| 40 | 42 | ||
| 41 | (defun main-with-config (config) | 43 | (defun main-with-config () |
| 42 | (unwind-protect | 44 | (unwind-protect |
| 43 | (with-db (db (config-db-path config)) | 45 | (with-db (db (conf:db-path)) |
| 44 | (let ((bot (make-bot config db))) | 46 | (let ((bot (make-bot db))) |
| 45 | ;; TODO: Catch fatal errors & report them | 47 | ;; TODO: Catch fatal errors & report them |
| 46 | (wrapped-main bot config))) | 48 | (wrapped-main bot))) |
| 47 | (log:info "We're done!"))) | 49 | (log:info "We're done!"))) |
| 48 | 50 | ||
| 49 | (defun wrapped-main (bot config) | 51 | (defun wrapped-main (bot) |
| 50 | (when *in-prod* | 52 | (when *in-prod* |
| 51 | (send-message bot :chat-id (config-dev-group config) :text "Initializing...")) | 53 | (send-message bot :chat-id (conf:dev-group) :text "Initializing...")) |
| 52 | (set-my-name bot :name (config-bot-name config)) | 54 | (set-my-name bot :name (conf:bot-name)) |
| 53 | (let ((gup-offset 0)) | 55 | (let ((gup-offset 0)) |
| 54 | (loop while (bot-power-on bot) do | 56 | (loop while (bot-power-on bot) do |
| 55 | (let ((updates (get-updates bot :timeout 60 :offset gup-offset))) | 57 | (let ((updates (get-updates bot :timeout 60 :offset gup-offset))) |
| @@ -65,14 +67,14 @@ | |||
| 65 | (setf gup-offset (1+ (update-update-id update))))))) | 67 | (setf gup-offset (1+ (update-update-id update))))))) |
| 66 | ;; One last getUpdates to make sure offset is stored on server | 68 | ;; One last getUpdates to make sure offset is stored on server |
| 67 | (get-updates bot :timeout 0 :limit 1 :offset gup-offset)) | 69 | (get-updates bot :timeout 0 :limit 1 :offset gup-offset)) |
| 68 | (send-message bot :chat-id (config-dev-group config) :text "Shutting down...")) | 70 | (send-message bot :chat-id (conf:dev-group) :text "Shutting down...")) |
| 69 | 71 | ||
| 70 | (defun on-callback-query (bot cb) | 72 | (defun on-callback-query (bot cb) |
| 71 | (let ((data (callback-query-data cb))) | 73 | (let ((data (callback-query-data cb))) |
| 72 | (cond ((and data | 74 | (cond ((and data |
| 73 | (str:starts-with-p "bbl:" data :ignore-case nil) | 75 | (str:starts-with-p "bbl:" data :ignore-case nil) |
| 74 | (= (user-id (callback-query-from cb)) | 76 | (= (user-id (callback-query-from cb)) |
| 75 | (config-owner (bot-config bot)))) | 77 | (conf:owner))) |
| 76 | (let ((bot-id (read-from-string data t nil :start 4))) | 78 | (let ((bot-id (read-from-string data t nil :start 4))) |
| 77 | (blacklist-inline-bot bot bot-id)) | 79 | (blacklist-inline-bot bot bot-id)) |
| 78 | (when-let (msg (callback-query-message cb)) | 80 | (when-let (msg (callback-query-message cb)) |
| @@ -85,7 +87,7 @@ | |||
| 85 | ((and data | 87 | ((and data |
| 86 | (str:starts-with-p "bwl:" data :ignore-case nil) | 88 | (str:starts-with-p "bwl:" data :ignore-case nil) |
| 87 | (= (user-id (callback-query-from cb)) | 89 | (= (user-id (callback-query-from cb)) |
| 88 | (config-owner (bot-config bot)))) | 90 | (conf:owner))) |
| 89 | (let ((bot-id (read-from-string data t nil :start 4))) | 91 | (let ((bot-id (read-from-string data t nil :start 4))) |
| 90 | (whitelist-inline-bot bot bot-id)) | 92 | (whitelist-inline-bot bot bot-id)) |
| 91 | (when-let (msg (callback-query-message cb)) | 93 | (when-let (msg (callback-query-message cb)) |
| @@ -269,7 +271,7 @@ | |||
| 269 | 271 | ||
| 270 | ((and (equal simple-cmd "shutdown") | 272 | ((and (equal simple-cmd "shutdown") |
| 271 | (message-from msg) | 273 | (message-from msg) |
| 272 | (= (user-id (message-from msg)) (config-owner (bot-config bot)))) | 274 | (= (user-id (message-from msg)) (conf:owner))) |
| 273 | (setf (bot-power-on bot) nil) | 275 | (setf (bot-power-on bot) nil) |
| 274 | (reply-message bot msg "Initialising shutdown..." :allow-sending-without-reply t))))) | 276 | (reply-message bot msg "Initialising shutdown..." :allow-sending-without-reply t))))) |
| 275 | 277 | ||
| @@ -280,6 +282,6 @@ | |||
| 280 | (log:error "While handling ~A: ~A" evt err) | 282 | (log:error "While handling ~A: ~A" evt err) |
| 281 | (let ((msg #f"<code>{(escape-xml-obj err)}</code> while handling{;~%}<pre>{(escape-xml-obj evt)}</pre>")) | 283 | (let ((msg #f"<code>{(escape-xml-obj err)}</code> while handling{;~%}<pre>{(escape-xml-obj evt)}</pre>")) |
| 282 | (send-message bot | 284 | (send-message bot |
| 283 | :chat-id (config-dev-group (bot-config bot)) | 285 | :chat-id (conf:dev-group) |
| 284 | :text msg | 286 | :text msg |
| 285 | :parse-mode html))) | 287 | :parse-mode html))) |
diff --git a/src/state.lisp b/src/state.lisp index 98e2048..597f0a8 100644 --- a/src/state.lisp +++ b/src/state.lisp | |||
| @@ -1,13 +1,15 @@ | |||
| 1 | ;; SPDX-License-Identifier: EUPL-1.2 | 1 | ;; SPDX-License-Identifier: EUPL-1.2 |
| 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> | 2 | ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs <perkontevs@gmail.com> |
| 3 | (defpackage :ukkoclot/state | 3 | (defpackage :ukkoclot/state |
| 4 | (:use :c2cl :ukkoclot/config) | 4 | (:documentation "Holds the global state") |
| 5 | (:use :c2cl) | ||
| 6 | (:import-from :com.dieggsy.f-string :enable-f-strings) | ||
| 7 | (:import-from :conf :bot-token) | ||
| 5 | (:export | 8 | (:export |
| 6 | #:bot | 9 | #:bot |
| 7 | #:make-bot | 10 | #:make-bot |
| 8 | #:bot-p | 11 | #:bot-p |
| 9 | #:copy-bot | 12 | #:copy-bot |
| 10 | #:bot-config | ||
| 11 | #:bot-db | 13 | #:bot-db |
| 12 | #:bot-base-uri | 14 | #:bot-base-uri |
| 13 | #:bot-power-on | 15 | #:bot-power-on |
| @@ -15,16 +17,15 @@ | |||
| 15 | #:bot-id%)) | 17 | #:bot-id%)) |
| 16 | (in-package :ukkoclot/state) | 18 | (in-package :ukkoclot/state) |
| 17 | 19 | ||
| 20 | (enable-f-strings) | ||
| 21 | |||
| 18 | (defstruct (bot (:constructor make-bot%)) | 22 | (defstruct (bot (:constructor make-bot%)) |
| 19 | (config (error "No value given for config") :read-only t) | ||
| 20 | (db (error "No value given for DB") :read-only t) | 23 | (db (error "No value given for DB") :read-only t) |
| 21 | (base-uri (error "No value given for base-uri") :read-only t) | 24 | (base-uri (error "No value given for base-uri") :read-only t) |
| 22 | (power-on t :type boolean) | 25 | (power-on t :type boolean) |
| 23 | (username% nil :type (or string null)) | 26 | (username% nil :type (or string null)) |
| 24 | (id% nil :type (or integer null))) | 27 | (id% nil :type (or integer null))) |
| 25 | 28 | ||
| 26 | (defun make-bot (config db) | 29 | (defun make-bot (db) |
| 27 | (let ((base-uri (concatenate 'string | 30 | (let ((base-uri #f"https://api.telegram.org/bot{(bot-token)}/")) |
| 28 | "https://api.telegram.org/bot" | 31 | (make-bot% :db db :base-uri base-uri))) |
| 29 | (config-bot-token config) "/"))) | ||
| 30 | (make-bot% :config config :db db :base-uri base-uri))) | ||