diff options
| -rw-r--r-- | ocicl.csv | 1 | ||||
| -rw-r--r-- | src/inline-bots.lisp | 35 | ||||
| -rw-r--r-- | src/main.lisp | 19 | ||||
| -rw-r--r-- | src/tg/method-macros.lisp | 9 | ||||
| -rw-r--r-- | src/tg/type-macros.lisp | 6 |
5 files changed, 46 insertions, 24 deletions
| @@ -25,6 +25,7 @@ cl-utilities, ghcr.io/ocicl/cl-utilities@sha256:e5e0676a4e0627332a0fe64d56ed4f18 | |||
| 25 | cl_plus_ssl, ghcr.io/ocicl/cl_plus_ssl@sha256:6caf4d428b898176fb23f33a007a2c51e8f5bc4d800539951560262419fed5ed, cl-plus-ssl-20250815-c02cba2/cl+ssl.asd | 25 | cl_plus_ssl, ghcr.io/ocicl/cl_plus_ssl@sha256:6caf4d428b898176fb23f33a007a2c51e8f5bc4d800539951560262419fed5ed, cl-plus-ssl-20250815-c02cba2/cl+ssl.asd |
| 26 | cl_plus_ssl.test, ghcr.io/ocicl/cl_plus_ssl@sha256:6caf4d428b898176fb23f33a007a2c51e8f5bc4d800539951560262419fed5ed, cl-plus-ssl-20250815-c02cba2/cl+ssl.test.asd | 26 | cl_plus_ssl.test, ghcr.io/ocicl/cl_plus_ssl@sha256:6caf4d428b898176fb23f33a007a2c51e8f5bc4d800539951560262419fed5ed, cl-plus-ssl-20250815-c02cba2/cl+ssl.test.asd |
| 27 | closer-mop, ghcr.io/ocicl/closer-mop@sha256:ac3136d628a0958c9d8d56840d6d77eec0d5064c53faa38c8af3398cadc69bf6, closer-mop-20250930-205ce73/closer-mop.asd | 27 | closer-mop, ghcr.io/ocicl/closer-mop@sha256:ac3136d628a0958c9d8d56840d6d77eec0d5064c53faa38c8af3398cadc69bf6, closer-mop-20250930-205ce73/closer-mop.asd |
| 28 | com.dieggsy.f-string, ghcr.io/ocicl/com.dieggsy.f-string@sha256:7ce7b25e4a6692824639582b1900a08b7a395838cc84ba508e74014afc2d0580, f-string-20250925-adbb1d5/com.dieggsy.f-string.asd | ||
| 28 | com.inuoe.jzon, ghcr.io/ocicl/com.inuoe.jzon@sha256:c1977360048edc7cc7a2e7dee44b27097f3349cd53a2eb7f8114d1cae537223a, jzon-20250909-f05afbb/com.inuoe.jzon.asd | 29 | com.inuoe.jzon, ghcr.io/ocicl/com.inuoe.jzon@sha256:c1977360048edc7cc7a2e7dee44b27097f3349cd53a2eb7f8114d1cae537223a, jzon-20250909-f05afbb/com.inuoe.jzon.asd |
| 29 | com.inuoe.jzon-tests, ghcr.io/ocicl/com.inuoe.jzon@sha256:c1977360048edc7cc7a2e7dee44b27097f3349cd53a2eb7f8114d1cae537223a, jzon-20250909-f05afbb/com.inuoe.jzon-tests.asd | 30 | com.inuoe.jzon-tests, ghcr.io/ocicl/com.inuoe.jzon@sha256:c1977360048edc7cc7a2e7dee44b27097f3349cd53a2eb7f8114d1cae537223a, jzon-20250909-f05afbb/com.inuoe.jzon-tests.asd |
| 30 | dexador, ghcr.io/ocicl/dexador@sha256:defc8d669790e22ac9a9eccf52fe14b10cf986402c7b32c0049df45f64a039e1, dexador-20250825-4db4b93/dexador.asd | 31 | dexador, ghcr.io/ocicl/dexador@sha256:defc8d669790e22ac9a9eccf52fe14b10cf986402c7b32c0049df45f64a039e1, dexador-20250825-4db4b93/dexador.asd |
diff --git a/src/inline-bots.lisp b/src/inline-bots.lisp index 94ed478..6001cb2 100644 --- a/src/inline-bots.lisp +++ b/src/inline-bots.lisp | |||
| @@ -1,7 +1,9 @@ | |||
| 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/inline-bots | 3 | (defpackage :ukkoclot/inline-bots |
| 4 | (:documentation "This package deals with removing unwanted inline bot usage") | ||
| 4 | (:use :c2cl :ukkoclot/config :ukkoclot/tg) | 5 | (:use :c2cl :ukkoclot/config :ukkoclot/tg) |
| 6 | (:import-from :com.dieggsy.f-string :enable-f-strings) | ||
| 5 | (:import-from :log) | 7 | (:import-from :log) |
| 6 | (:import-from :ukkoclot/tg :send-message :try-delete-message) | 8 | (:import-from :ukkoclot/tg :send-message :try-delete-message) |
| 7 | (:import-from :ukkoclot/state :bot-config :bot-db) | 9 | (:import-from :ukkoclot/state :bot-config :bot-db) |
| @@ -9,10 +11,18 @@ | |||
| 9 | (:export :blacklist-inline-bot :on-inline-bot :whitelist-inline-bot)) | 11 | (:export :blacklist-inline-bot :on-inline-bot :whitelist-inline-bot)) |
| 10 | (in-package :ukkoclot/inline-bots) | 12 | (in-package :ukkoclot/inline-bots) |
| 11 | 13 | ||
| 14 | (enable-f-strings) | ||
| 15 | |||
| 12 | (defun blacklist-inline-bot (bot inline-bot-id) | 16 | (defun blacklist-inline-bot (bot inline-bot-id) |
| 17 | "Blacklist the given bot. | ||
| 18 | |||
| 19 | No more messages about deleting its messages will be sent." | ||
| 13 | (db:set-inline-bot-type (bot-db bot) inline-bot-id :blacklisted)) | 20 | (db:set-inline-bot-type (bot-db bot) inline-bot-id :blacklisted)) |
| 14 | 21 | ||
| 15 | (defun whitelist-inline-bot (bot inline-bot-id) | 22 | (defun whitelist-inline-bot (bot inline-bot-id) |
| 23 | "Whitelist the given bot. | ||
| 24 | |||
| 25 | Its messages will no longer be deleted." | ||
| 16 | (db:set-inline-bot-type (bot-db bot) inline-bot-id :whitelisted)) | 26 | (db:set-inline-bot-type (bot-db bot) inline-bot-id :whitelisted)) |
| 17 | 27 | ||
| 18 | (defun on-inline-bot (bot msg via) | 28 | (defun on-inline-bot (bot msg via) |
| @@ -26,17 +36,16 @@ | |||
| 26 | (unless (eql ty :blacklisted) | 36 | (unless (eql ty :blacklisted) |
| 27 | ;; Not explicitly blacklisted, notify dev group | 37 | ;; Not explicitly blacklisted, notify dev group |
| 28 | (let ((whitelist (make-inline-keyboard-button :text "Whitelist" | 38 | (let ((whitelist (make-inline-keyboard-button :text "Whitelist" |
| 29 | :callback-data (format nil "bwl:~A" (user-id via)))) | 39 | :callback-data #f"bwl:{(user-id via)}")) |
| 30 | (blacklist (make-inline-keyboard-button :text "Blacklist" | 40 | (blacklist (make-inline-keyboard-button :text "Blacklist" |
| 31 | :callback-data (format nil "bbl:~A" (user-id via))))) | 41 | :callback-data #f"bbl:{(user-id via)}"))) |
| 32 | (send-message bot | 42 | (send-message |
| 33 | :chat-id (config-dev-group (bot-config bot)) | 43 | bot |
| 34 | :text (format nil "Deleted a message sent via inline bot @~A <code>~A</code>" | 44 | :chat-id (config-dev-group (bot-config bot)) |
| 35 | (user-username via) | 45 | :text #f"Deleted a message sent via inline bot @{(user-username via)} <code>{(user-id via)}</code>" |
| 36 | (user-id via)) | 46 | :parse-mode html |
| 37 | :parse-mode html | 47 | :reply-markup (make-inline-keyboard-markup |
| 38 | :reply-markup (make-inline-keyboard-markup | 48 | :inline-keyboard |
| 39 | :inline-keyboard | 49 | (make-array '(1 2) |
| 40 | (make-array '(1 2) | 50 | :initial-contents |
| 41 | :initial-contents | 51 | (list (list whitelist blacklist))))))))))) |
| 42 | (list (list whitelist blacklist))))))))))) | ||
diff --git a/src/main.lisp b/src/main.lisp index f9720c9..cd9e755 100644 --- a/src/main.lisp +++ b/src/main.lisp | |||
| @@ -4,6 +4,7 @@ | |||
| 4 | (:nicknames :ukkoclot) | 4 | (:nicknames :ukkoclot) |
| 5 | (:use :c2cl :ukkoclot/config :ukkoclot/inline-bots :ukkoclot/tg) | 5 | (:use :c2cl :ukkoclot/config :ukkoclot/inline-bots :ukkoclot/tg) |
| 6 | (:import-from :anaphora :acond :awhen :it) | 6 | (:import-from :anaphora :acond :awhen :it) |
| 7 | (:import-from :com.dieggsy.f-string :enable-f-strings) | ||
| 7 | (:import-from :log) | 8 | (:import-from :log) |
| 8 | (:import-from :ukkoclot/db :with-db) | 9 | (:import-from :ukkoclot/db :with-db) |
| 9 | (:import-from :ukkoclot/serializing :fixup-value) | 10 | (:import-from :ukkoclot/serializing :fixup-value) |
| @@ -15,6 +16,8 @@ | |||
| 15 | (:export :main)) | 16 | (:export :main)) |
| 16 | (in-package :ukkoclot/main) | 17 | (in-package :ukkoclot/main) |
| 17 | 18 | ||
| 19 | (enable-f-strings) | ||
| 20 | |||
| 18 | (defvar *in-prod* t) | 21 | (defvar *in-prod* t) |
| 19 | 22 | ||
| 20 | (defmacro reporty ((evt) &body body) | 23 | (defmacro reporty ((evt) &body body) |
| @@ -240,7 +243,9 @@ | |||
| 240 | ;; TODO: Replace this cond with a nicer dispatch. Something like string-case? | 243 | ;; TODO: Replace this cond with a nicer dispatch. Something like string-case? |
| 241 | (acond | 244 | (acond |
| 242 | ((equal simple-cmd "chatid") | 245 | ((equal simple-cmd "chatid") |
| 243 | (reply-message bot msg (format nil "<code>~A</code>" (message-chat-id msg)) :parse-mode html)) | 246 | (reply-message bot msg |
| 247 | #f"<code>{(message-chat-id msg)}</code>" | ||
| 248 | :parse-mode html)) | ||
| 244 | 249 | ||
| 245 | ((and (equal simple-cmd "msginfo") | 250 | ((and (equal simple-cmd "msginfo") |
| 246 | (message-reply-to-message msg)) | 251 | (message-reply-to-message msg)) |
| @@ -248,15 +253,14 @@ | |||
| 248 | 253 | ||
| 249 | ((equal simple-cmd "ping") | 254 | ((equal simple-cmd "ping") |
| 250 | (let* ((start-time (get-internal-real-time)) | 255 | (let* ((start-time (get-internal-real-time)) |
| 251 | (reply (reply-message bot msg "Pong! | 256 | (reply (reply-message bot msg #f"Pong!{;~2%}Send time: ...")) |
| 252 | Send time: ...")) | ||
| 253 | (end-time (get-internal-real-time)) | 257 | (end-time (get-internal-real-time)) |
| 254 | (time-elapsed (* (/ (- end-time start-time) internal-time-units-per-second) | 258 | (time-elapsed (* (/ (- end-time start-time) internal-time-units-per-second) |
| 255 | 1000))) | 259 | 1000))) |
| 256 | (edit-message-text bot | 260 | (edit-message-text bot |
| 257 | :chat-id (message-chat-id reply) | 261 | :chat-id (message-chat-id reply) |
| 258 | :message-id (message-id reply) | 262 | :message-id (message-id reply) |
| 259 | :text (format nil "Pong!~2%Send time: ~Gms" time-elapsed)))) | 263 | :text #f"Pong!{;~2%}Send time: {time-elapsed;~G}ms"))) |
| 260 | 264 | ||
| 261 | ((and (equal simple-cmd "shutdown") | 265 | ((and (equal simple-cmd "shutdown") |
| 262 | (message-from msg) | 266 | (message-from msg) |
| @@ -264,11 +268,12 @@ Send time: ...")) | |||
| 264 | (setf (bot-power-on bot) nil) | 268 | (setf (bot-power-on bot) nil) |
| 265 | (reply-message bot msg "Initialising shutdown..." :allow-sending-without-reply t))))) | 269 | (reply-message bot msg "Initialising shutdown..." :allow-sending-without-reply t))))) |
| 266 | 270 | ||
| 271 | (defun escape-xml-obj (obj) | ||
| 272 | (escape-xml #f"{obj}")) | ||
| 273 | |||
| 267 | (defun report-error (bot evt err) | 274 | (defun report-error (bot evt err) |
| 268 | (log:error "While handling ~A: ~A" evt err) | 275 | (log:error "While handling ~A: ~A" evt err) |
| 269 | (let ((msg (format nil "<code>~A</code> while handling ~&<pre>~A</pre>" | 276 | (let ((msg #f"<code>{(escape-xml-obj err)}</code> while handling{;~%}<pre>{(escape-xml-obj evt)}</pre>")) |
| 270 | (escape-xml (format nil "~A" err)) | ||
| 271 | (escape-xml (format nil "~A" evt))))) | ||
| 272 | (send-message bot | 277 | (send-message bot |
| 273 | :chat-id (config-dev-group (bot-config bot)) | 278 | :chat-id (config-dev-group (bot-config bot)) |
| 274 | :text msg | 279 | :text msg |
diff --git a/src/tg/method-macros.lisp b/src/tg/method-macros.lisp index e614db9..817a3e3 100644 --- a/src/tg/method-macros.lisp +++ b/src/tg/method-macros.lisp | |||
| @@ -1,7 +1,9 @@ | |||
| 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/tg/method-macros | 3 | (defpackage :ukkoclot/tg/method-macros |
| 4 | (:documentation "Macros for easy defining TG methods." | ||
| 4 | (:use :c2cl :iterate) | 5 | (:use :c2cl :iterate) |
| 6 | (:import-from :com.dieggsy.f-string :enable-f-strings) | ||
| 5 | (:import-from :serapeum :take) | 7 | (:import-from :serapeum :take) |
| 6 | (:import-from :ukkoclot/state :bot) | 8 | (:import-from :ukkoclot/state :bot) |
| 7 | (:import-from :ukkoclot/strings :ends-with :lisp->camel-case) | 9 | (:import-from :ukkoclot/strings :ends-with :lisp->camel-case) |
| @@ -9,6 +11,8 @@ | |||
| 9 | (:export :define-tg-method)) | 11 | (:export :define-tg-method)) |
| 10 | (in-package :ukkoclot/tg/method-macros) | 12 | (in-package :ukkoclot/tg/method-macros) |
| 11 | 13 | ||
| 14 | (enable-f-strings) | ||
| 15 | |||
| 12 | (eval-when (:compile-toplevel :load-toplevel :execute) | 16 | (eval-when (:compile-toplevel :load-toplevel :execute) |
| 13 | (defstruct (param (:constructor make-param%)) name type default skip-if-default) | 17 | (defstruct (param (:constructor make-param%)) name type default skip-if-default) |
| 14 | 18 | ||
| @@ -19,7 +23,7 @@ | |||
| 19 | &optional (default +unique+) | 23 | &optional (default +unique+) |
| 20 | &key (skip-if-default (not (eq default +unique+)))) | 24 | &key (skip-if-default (not (eq default +unique+)))) |
| 21 | (let ((default (if (eq default +unique+) | 25 | (let ((default (if (eq default +unique+) |
| 22 | `(error ,(format nil "No value given for ~A" name)) | 26 | `(error ,#f"No value given for {name}") |
| 23 | default))) | 27 | default))) |
| 24 | (make-param% :name name | 28 | (make-param% :name name |
| 25 | :type type | 29 | :type type |
| @@ -67,8 +71,7 @@ | |||
| 67 | ,return-type) | 71 | ,return-type) |
| 68 | ,name)))) | 72 | ,name)))) |
| 69 | 73 | ||
| 70 | (defmacro define-tg-method ( | 74 | (defmacro define-tg-method ((name type &optional (method :POST)) |
| 71 | (name type &optional (method :POST)) | ||
| 72 | &body param-specs) | 75 | &body param-specs) |
| 73 | (let ((params (parse-param-specs param-specs))) | 76 | (let ((params (parse-param-specs param-specs))) |
| 74 | `(progn | 77 | `(progn |
diff --git a/src/tg/type-macros.lisp b/src/tg/type-macros.lisp index b9d649c..390781f 100644 --- a/src/tg/type-macros.lisp +++ b/src/tg/type-macros.lisp | |||
| @@ -1,7 +1,9 @@ | |||
| 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/tg/type-macros | 3 | (defpackage :ukkoclot/tg/type-macros |
| 4 | (:documentation "Macros for easy defining TG types.") | ||
| 4 | (:use :c2cl :iterate) | 5 | (:use :c2cl :iterate) |
| 6 | (:import-from :com.dieggsy.f-string :enable-f-strings) | ||
| 5 | (:import-from :ukkoclot/serializing :parse-value) | 7 | (:import-from :ukkoclot/serializing :parse-value) |
| 6 | (:import-from :ukkoclot/hash-tables :gethash-lazy) | 8 | (:import-from :ukkoclot/hash-tables :gethash-lazy) |
| 7 | (:import-from :ukkoclot/strings :lisp->snake-case) | 9 | (:import-from :ukkoclot/strings :lisp->snake-case) |
| @@ -10,6 +12,8 @@ | |||
| 10 | (:export :define-tg-type)) | 12 | (:export :define-tg-type)) |
| 11 | (in-package :ukkoclot/tg/type-macros) | 13 | (in-package :ukkoclot/tg/type-macros) |
| 12 | 14 | ||
| 15 | (enable-f-strings) | ||
| 16 | |||
| 13 | (eval-when (:compile-toplevel :load-toplevel :execute) | 17 | (eval-when (:compile-toplevel :load-toplevel :execute) |
| 14 | (defstruct (field (:constructor make-field%)) name type default skip-if-default) | 18 | (defstruct (field (:constructor make-field%)) name type default skip-if-default) |
| 15 | 19 | ||
| @@ -20,7 +24,7 @@ | |||
| 20 | &optional (default +unique+) | 24 | &optional (default +unique+) |
| 21 | &key (skip-if-default (not (eq default +unique+)))) | 25 | &key (skip-if-default (not (eq default +unique+)))) |
| 22 | (let ((default (if (eq default +unique+) | 26 | (let ((default (if (eq default +unique+) |
| 23 | `(error ,(format nil "No value given for ~A" name)) | 27 | `(error ,#f"No value given for {name}") |
| 24 | default))) | 28 | default))) |
| 25 | (make-field% :name name | 29 | (make-field% :name name |
| 26 | :type type | 30 | :type type |