diff options
Diffstat (limited to 'src/main.lisp')
| -rw-r--r-- | src/main.lisp | 38 |
1 files changed, 20 insertions, 18 deletions
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))) |