From 6c4a545b30c601047091ac9439741ba52a3334d2 Mon Sep 17 00:00:00 2001 From: Uko Kokņevičs Date: Sun, 19 Oct 2025 08:50:52 +0300 Subject: Make state be a global special variable --- src/config.lisp | 2 +- src/inline-bots.lisp | 18 +++---- src/main.lisp | 126 +++++++++++++++++++++------------------------ src/state.lisp | 99 +++++++++++++++++++++++++++++------ src/tg/delete-message.lisp | 9 ++-- src/tg/get-me.lisp | 30 ++++++----- src/tg/method-macros.lisp | 14 ++--- src/tg/send-animation.lisp | 7 +-- src/tg/send-message.lisp | 7 +-- src/tg/set-my-name.lisp | 10 ++-- src/transport.lisp | 6 +-- 11 files changed, 196 insertions(+), 132 deletions(-) (limited to 'src') diff --git a/src/config.lisp b/src/config.lisp index 7d841a2..1a139c1 100644 --- a/src/config.lisp +++ b/src/config.lisp @@ -20,7 +20,7 @@ (in-package :ukkoclot/src/config) (defstruct config - (lock (make-rw-lock :name "config's lock") :type rw-lock) + (lock (make-rw-lock :name "config's lock") :type rw-lock :read-only t) (bot-name "Ukko's Clot" :type string) (bot-token "123456789:ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghi" :type string) (db-path #P"./data.db" :type (or pathname string)) diff --git a/src/inline-bots.lisp b/src/inline-bots.lisp index 4f6a679..4361adb 100644 --- a/src/inline-bots.lisp +++ b/src/inline-bots.lisp @@ -6,34 +6,33 @@ (:import-from :com.dieggsy.f-string :enable-f-strings) (:import-from :conf) (:import-from :log) - (:import-from :ukkoclot/src/tg :send-message :try-delete-message) - (:import-from :ukkoclot/src/state :bot-db) + (:import-from :state) (:local-nicknames (:db :ukkoclot/src/db)) (:export :blacklist-inline-bot :on-inline-bot :whitelist-inline-bot)) (in-package :ukkoclot/src/inline-bots) (enable-f-strings) -(defun blacklist-inline-bot (bot inline-bot-id) +(defun blacklist-inline-bot (inline-bot-id) "Blacklist the given bot. No more messages about deleting its messages will be sent." - (db:set-inline-bot-type (bot-db bot) inline-bot-id :blacklisted)) + (db:set-inline-bot-type (state:db) inline-bot-id :blacklisted)) -(defun whitelist-inline-bot (bot inline-bot-id) +(defun whitelist-inline-bot (inline-bot-id) "Whitelist the given bot. Its messages will no longer be deleted." - (db:set-inline-bot-type (bot-db bot) inline-bot-id :whitelisted)) + (db:set-inline-bot-type (state:db) inline-bot-id :whitelisted)) -(defun on-inline-bot (bot msg via) - (let ((ty (db:get-inline-bot-type (bot-db bot) (user-id via)))) +(defun on-inline-bot (msg via) + (let ((ty (db:get-inline-bot-type (state:db) (user-id via)))) (or (eql ty :whitelisted) (prog1 nil (log:info "Deleting an unallowed inline bot message from ~A ~A" (user-username via) (user-id via)) - (try-delete-message bot msg) + (try-delete-message msg) (unless (eql ty :blacklisted) ;; Not explicitly blacklisted, notify dev group (let ((whitelist (make-inline-keyboard-button :text "Whitelist" @@ -41,7 +40,6 @@ Its messages will no longer be deleted." (blacklist (make-inline-keyboard-button :text "Blacklist" :callback-data #f"bbl:{(user-id via)}"))) (send-message - bot :chat-id (conf:dev-group) :text #f"Deleted a message sent via inline bot @{(user-username via)} {(user-id via)}" :parse-mode html diff --git a/src/main.lisp b/src/main.lisp index caef651..fa7fab0 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -8,10 +8,10 @@ (:import-from :conf) (:import-from :log) (:import-from :serapeum :drop) + (:import-from :state :*state* :make-state) (:import-from :str) (:import-from :ukkoclot/src/db :with-db) (:import-from :ukkoclot/src/serializing :fixup-value) - (:import-from :ukkoclot/src/state :make-bot :bot-power-on) (:import-from :ukkoclot/src/strings :escape-xml :is-tg-whitespace :is-tg-whitespace-str) (:local-nicknames (:jzon :com.inuoe.jzon)) @@ -26,7 +26,7 @@ `(cond (*in-prod* (handler-case (progn ,@body) ; lint:suppress redundant-progn - (error (err) (report-error bot ,evt err)))) + (error (err) (report-error ,evt err)))) (t ,@body))) (defun main () @@ -43,87 +43,82 @@ (defun main-with-config () (unwind-protect (with-db (db (conf:db-path)) - (let ((bot (make-bot db))) - ;; TODO: Catch fatal errors & report them - (wrapped-main bot))) + (setf *state* (make-state db)) + ;; TODO: Catch fatal errors & report them + (wrapped-main)) (log:info "We're done!"))) -(defun wrapped-main (bot) +(defun wrapped-main () (when *in-prod* - (send-message bot :chat-id (conf:dev-group) :text "Initializing...")) - (set-my-name bot :name (conf:bot-name)) + (send-message :chat-id (conf:dev-group) :text "Initializing...")) + (set-my-name :name (conf:bot-name)) (let ((gup-offset 0)) - (loop while (bot-power-on bot) do - (let ((updates (get-updates bot :timeout 60 :offset gup-offset))) + (loop while (state:power-on) do + (let ((updates (get-updates :timeout 60 :offset gup-offset))) (loop for update across updates do (unwind-protect (progn (when-let (msg (update-message update)) (reporty (msg) - (on-message bot msg))) + (on-message msg))) (when-let (cbq (update-callback-query update)) (reporty (cbq) - (on-callback-query bot cbq)))) + (on-callback-query cbq)))) (setf gup-offset (1+ (update-update-id update))))))) ;; One last getUpdates to make sure offset is stored on server - (get-updates bot :timeout 0 :limit 1 :offset gup-offset)) - (send-message bot :chat-id (conf:dev-group) :text "Shutting down...")) + (get-updates :timeout 0 :limit 1 :offset gup-offset)) + (send-message :chat-id (conf:dev-group) :text "Shutting down...")) -(defun on-callback-query (bot cb) +(defun on-callback-query (cb) (let ((data (callback-query-data cb))) (cond ((and data (str:starts-with-p "bbl:" data :ignore-case nil) (= (user-id (callback-query-from cb)) (conf:owner))) (let ((bot-id (read-from-string data t nil :start 4))) - (blacklist-inline-bot bot bot-id)) + (blacklist-inline-bot bot-id)) (when-let (msg (callback-query-message cb)) - (delete-message bot - :chat-id (message-chat-id msg) + (delete-message :chat-id (message-chat-id msg) :message-id (message-id msg))) - (answer-callback-query bot - :callback-query-id (callback-query-id cb) + (answer-callback-query :callback-query-id (callback-query-id cb) :text "OK")) ((and data (str:starts-with-p "bwl:" data :ignore-case nil) (= (user-id (callback-query-from cb)) (conf:owner))) (let ((bot-id (read-from-string data t nil :start 4))) - (whitelist-inline-bot bot bot-id)) + (whitelist-inline-bot bot-id)) (when-let (msg (callback-query-message cb)) - (delete-message bot - :chat-id (message-chat-id msg) + (delete-message :chat-id (message-chat-id msg) :message-id (message-id msg))) - (answer-callback-query bot - :callback-query-id (callback-query-id cb) + (answer-callback-query :callback-query-id (callback-query-id cb) :text "OK")) (t (log:info "Unrecognised callback query data: ~A" data) - (answer-callback-query bot - :callback-query-id (callback-query-id cb) + (answer-callback-query :callback-query-id (callback-query-id cb) :text "Unallowed callback query, don't press the button again" :show-alert t))))) -(defun on-message (bot msg) +(defun on-message (msg) (block nil (when-let (inline-bot (message-via-bot msg)) - (unless (on-inline-bot bot msg inline-bot) + (unless (on-inline-bot msg inline-bot) (return))) (when-let (text (message-text msg)) - (on-text-message bot msg text)) + (on-text-message msg text)) (when-let (new-chat-members (message-new-chat-members msg)) (iter (for new-chat-member in-vector new-chat-members) - (on-new-member bot msg new-chat-member))))) + (on-new-member msg new-chat-member))))) -(defun on-new-member (bot msg new-member) - (if (= (user-id new-member) (bot-id bot)) - (reply-animation bot msg #P"blob/rule-11.mp4" +(defun on-new-member (msg new-member) + (if (= (user-id new-member) (bot-id)) + (reply-animation msg #P"blob/rule-11.mp4" :allow-sending-without-reply t) - (reply-animation bot msg #P"blob/rule-10.mp4" + (reply-animation msg #P"blob/rule-10.mp4" :text (concatenate 'string "Hello there, " (user-format-name new-member) "! Be on your bestest behaviour now!!") @@ -136,7 +131,7 @@ ;; TODO: nil) -(defun on-text-message (bot msg text) +(defun on-text-message (msg text) (block nil (when (is-bad-text text) ;; TODO: Delete message, mute & warn user @@ -155,19 +150,19 @@ (for entity in-vector entities) (when (and (eql (message-entity-type entity) bot-command) (zerop (message-entity-offset entity))) - (on-text-command bot msg text (message-entity-extract entity text))))) + (on-text-command msg text (message-entity-extract entity text))))) ;; TODO: Replace this cond with a nicer dispatch. Something like string-case? (cond ((equal text ":3") - (reply-message bot msg ">:3")) + (reply-message msg ">:3")) ((equal text ">:3") - (reply-message bot msg ">:3" :parse-mode html)) + (reply-message msg ">:3" :parse-mode html)) ((str:starts-with-p "big " text) (let ((the-text (drop 4 text))) (unless (is-tg-whitespace-str the-text) - (reply-message bot msg + (reply-message msg (concatenate 'string "" (escape-xml (string-upcase the-text)) @@ -175,33 +170,31 @@ :parse-mode html)))) ((string-equal text "dio cane") - (reply-message bot - (or (message-reply-to-message msg) msg) + (reply-message (or (message-reply-to-message msg) msg) "porco dio")) ((string-equal text "forgor") - (reply-message bot msg "💀")) + (reply-message msg "💀")) ((string-equal text "huh") - (reply-message bot msg "idgi")) + (reply-message msg "idgi")) ((string= text "H") - (reply-message bot msg "Randomly selected reminder that h > H." :parse-mode html)) + (reply-message msg "Randomly selected reminder that h > H." :parse-mode html)) ((string-equal text "porco dio") - (reply-message bot - (or (message-reply-to-message msg) msg) + (reply-message (or (message-reply-to-message msg) msg) "dio cane")) ((str:starts-with-p "say " text) (let ((the-text (drop 4 text))) (unless (is-tg-whitespace-str the-text) - (reply-message bot msg the-text)))) + (reply-message msg the-text)))) ((str:starts-with-p "tiny " text) (let ((the-text (drop 5 text))) (unless (is-tg-whitespace-str the-text) - (reply-message bot msg + (reply-message msg (map 'string #'(lambda (ch) (if (is-tg-whitespace ch) ch @@ -209,16 +202,15 @@ the-text))))) ((string-equal text "uwu") - (reply-message bot msg "OwO")) + (reply-message msg "OwO")) ((string-equal text "waow") (reply-message - bot (or (message-reply-to-message msg) msg) "BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED BASED")) ((string-equal text "what") - (reply-message bot msg + (reply-message msg (with-output-to-string (s) (if (char= (elt text 0) #\w) (write-char #\g s) @@ -235,55 +227,53 @@ (t nil)))) -(defun simplify-cmd (bot cmd) +(defun simplify-cmd (cmd) (let ((at-idx (position #\@ cmd))) (if (null at-idx) (drop 1 cmd) (let ((username (drop (1+ at-idx) cmd)) - (my-username (bot-username bot))) + (my-username (bot-username))) (if (equal username my-username) (subseq cmd 1 at-idx) nil))))) -(defun on-text-command (bot msg text cmd) +(defun on-text-command (msg text cmd) (declare (ignore text)) - (let ((simple-cmd (simplify-cmd bot cmd))) + (let ((simple-cmd (simplify-cmd cmd))) (log:debug "text-command: ~A AKA ~A" cmd simple-cmd) ;; TODO: Replace this cond with a nicer dispatch. Something like string-case? (cond ((equal simple-cmd "chatid") - (reply-message bot msg + (reply-message msg #f"{(message-chat-id msg)}" :parse-mode html)) ((equal simple-cmd "msginfo") (when-let (replied (message-reply-to-message msg)) - (reply-message bot replied (let ((*print-pretty* t)) (fixup-value replied))))) + (reply-message replied (let ((*print-pretty* t)) (fixup-value replied))))) ((equal simple-cmd "ping") (let* ((start-time (get-internal-real-time)) - (reply (reply-message bot msg #f"Pong!{;~2%}Send time: ...")) + (reply (reply-message msg #f"Pong!{;~2%}Send time: ...")) (end-time (get-internal-real-time)) (time-elapsed (* (/ (- end-time start-time) internal-time-units-per-second) 1000))) - (edit-message-text bot - :chat-id (message-chat-id reply) + (edit-message-text :chat-id (message-chat-id reply) :message-id (message-id reply) :text #f"Pong!{;~2%}Send time: {time-elapsed;~G}ms"))) ((and (equal simple-cmd "shutdown") (message-from msg) (= (user-id (message-from msg)) (conf:owner))) - (setf (bot-power-on bot) nil) - (reply-message bot msg "Initialising shutdown..." :allow-sending-without-reply t))))) + (setf (state:power-on) nil) + (reply-message msg "Initialising shutdown..." :allow-sending-without-reply t))))) (defun escape-xml-obj (obj) (escape-xml #f"{obj}")) -(defun report-error (bot evt err) +(defun report-error (evt err) (log:error "While handling ~A: ~A" evt err) (let ((msg #f"{(escape-xml-obj err)} while handling{;~%}
{(escape-xml-obj evt)}
")) - (send-message bot - :chat-id (conf:dev-group) - :text msg - :parse-mode html))) + (send-message :chat-id (conf:dev-group) + :text msg + :parse-mode html))) diff --git a/src/state.lisp b/src/state.lisp index 6348ee3..ef4050d 100644 --- a/src/state.lisp +++ b/src/state.lisp @@ -2,30 +2,95 @@ ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/src/state (:documentation "Holds the global state") - (:use :c2cl) + (:nicknames :state) + (:use :c2cl :ukkoclot/src/rw-lock) (:import-from :com.dieggsy.f-string :enable-f-strings) - (:import-from :conf :bot-token) + (:import-from :conf :*config* :bot-token) + (:import-from :sqlite :sqlite-handle) (:export - #:bot - #:make-bot - #:bot-p - #:copy-bot - #:bot-db - #:bot-base-uri - #:bot-power-on - #:bot-username% - #:bot-id%)) + #:*state* + #:state + #:make-state + #:state-p + #:db + #:base-uri + #:power-on + #:set-power-on + #:username% + #:set-username% + #:id% + #:set-id%)) (in-package :ukkoclot/src/state) (enable-f-strings) -(defstruct (bot (:constructor make-bot%)) - (db (error "No value given for DB") :read-only t) - (base-uri (error "No value given for base-uri") :read-only t) +(defstruct (state (:constructor make-state%)) + (lock (make-rw-lock :name "state's lock") :type rw-lock :read-only t) + (db (error "No value given for DB") :type sqlite-handle :read-only t) + (base-uri (error "No value given for base-uri") :type string :read-only t) (power-on t :type boolean) (username% nil :type (or string null)) (id% nil :type (or integer null))) -(defun make-bot (db) - (let ((base-uri #f"https://api.telegram.org/bot{(bot-token)}/")) - (make-bot% :db db :base-uri base-uri))) +(defun make-state (db &optional (config *config*)) + (check-type db sqlite-handle) + (let ((base-uri #f"https://api.telegram.org/bot{(bot-token config)}/")) + (make-state% :db db :base-uri base-uri))) + +(defvar *state* nil + "Bot's general state. You should initialise this with a value before doing anything fun.") + +(defun db (&optional (state *state*)) + "Get the database handle of the bot." + (with-slots (lock db) state + (with-read-lock (lock) + db))) + +(defun base-uri (&optional (state *state*)) + "Get the base URI of the bot." + (with-slots (lock base-uri) state + (with-read-lock (lock) + base-uri))) + +(defun power-on (&optional (state *state*)) + "Get whether the bot is running" + (with-slots (lock power-on) state + (with-read-lock (lock) + power-on))) + +(defun set-power-on (new-value &optional (state *state*)) + "Set the value of the power-on" + (with-slots (lock power-on) state + (with-write-lock (lock) + (setf power-on new-value)))) + +(defsetf power-on (&optional (state '*state*)) (new-value) + `(set-power-on ,new-value ,state)) + +(defun username% (&optional (state *state*)) + "Get the cached bot's username, you should probably use `ukkoclot/src/tg:bot-username' instead." + (with-slots (lock username%) state + (with-read-lock (lock) + username%))) + +(defun set-username% (new-value &optional (state *state*)) + (with-slots (lock username%) state + (with-write-lock (lock) + (setf username% new-value)))) + +(defsetf username% (&optional (state '*state*)) (new-value) + `(set-username% ,new-value ,state)) + +(defun id% (&optional (state *state*)) + "Get the cached bot's ID, you should probably use `ukkoclot/src/tg:bot-id' instead." + (with-slots (lock id%) state + (with-read-lock (lock) + id%))) + +(defun set-id% (new-value &optional (state *state*)) + (with-slots (lock id%) state + (with-write-lock (lock) + (setf id% new-value)))) + +(defsetf id% (&optional (state '*state*)) (new-value) + `(set-id% ,new-value ,state)) diff --git a/src/tg/delete-message.lisp b/src/tg/delete-message.lisp index cc52371..2b332df 100644 --- a/src/tg/delete-message.lisp +++ b/src/tg/delete-message.lisp @@ -1,6 +1,7 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/src/tg/delete-message + (:documentation "deleteMessage Telegram method") (:use :c2cl :ukkoclot/src/tg/message :ukkoclot/src/tg/method-macros :ukkoclot/src/tg/send-animation) (:export :delete-message :try-delete-message)) (in-package :ukkoclot/src/tg/delete-message) @@ -9,13 +10,13 @@ (chat-id (or integer string)) (message-id integer)) -(defun try-delete-message (bot msg) +(defun try-delete-message (msg) + "Attempt to delete the MSG, on failure reply with a GIF of the DO NOT cat." (handler-case - (delete-message bot - :chat-id (message-chat-id msg) + (delete-message :chat-id (message-chat-id msg) :message-id (message-id msg)) (error () (handler-case - (reply-animation bot msg #P"blob/do-not.mp4" + (reply-animation msg #P"blob/do-not.mp4" :allow-sending-without-reply nil) (error () nil))))) diff --git a/src/tg/get-me.lisp b/src/tg/get-me.lisp index b7e8bc0..e7d41a1 100644 --- a/src/tg/get-me.lisp +++ b/src/tg/get-me.lisp @@ -1,27 +1,31 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/src/tg/get-me + (:documentation "getMe Telegram method") (:use :c2cl :ukkoclot/src/tg/method-macros :ukkoclot/src/tg/user) - (:import-from :ukkoclot/src/state :bot-id% :bot-username%) + (:import-from :state) (:export :bot-id :bot-username :get-me)) (in-package :ukkoclot/src/tg/get-me) (define-tg-method (get-me% user :GET)) -(defun get-me (bot) - (let ((me (get-me% bot))) - (setf (bot-id% bot) (user-id me)) - (setf (bot-username% bot) (user-username me)) +(defun get-me () + "getMe Telegram method" + (let ((me (get-me%))) + (setf (state:id%) (user-id me)) + (setf (state:username%) (user-username me)) me)) -(defun bot-id (bot) - (or (bot-id% bot) +(defun bot-id () + "Get the bot's ID, this memoizes the result" + (or (state:id%) (progn - (get-me bot) - (bot-id% bot)))) + (get-me) + (state:id%)))) -(defun bot-username (bot) - (or (bot-username% bot) +(defun bot-username () + "Get the bot's username, this memoizes the result" + (or (state:username%) (progn - (get-me bot) - (bot-username% bot)))) + (get-me) + (state:username%)))) diff --git a/src/tg/method-macros.lisp b/src/tg/method-macros.lisp index 00adf95..56445e3 100644 --- a/src/tg/method-macros.lisp +++ b/src/tg/method-macros.lisp @@ -6,8 +6,8 @@ (:import-from :alexandria :with-gensyms) (:import-from :com.dieggsy.f-string :enable-f-strings) (:import-from :serapeum :take) + (:import-from :state) (:import-from :str) - (:import-from :ukkoclot/src/state :bot) (:import-from :ukkoclot/src/transport :do-call) (:export :define-tg-method)) (in-package :ukkoclot/src/tg/method-macros) @@ -53,9 +53,9 @@ `(,(param-name param) ,(param-default param))) (defun emit-defun (name return-type params method) - (with-gensyms (args bot) - `(defun ,name (,bot &key ,@(iter (for param in params) ; lint:suppress lambda-list-invalid - (collect (emit-defun-arg param)))) + (with-gensyms (args) + `(defun ,name (&key ,@(iter (for param in params) ; lint:suppress lambda-list-invalid + (collect (emit-defun-arg param)))) (let (,args) ,@(iter (for param in (reverse params)) (collect (if (param-skip-if-default param) @@ -63,11 +63,11 @@ ,(param-default param)) ,(emit-append-to-args param args)) (emit-append-to-args param args)))) - (do-call ,bot ,method ,(path-from-name name) ',return-type ,args))))) + (do-call ,method ,(path-from-name name) ',return-type ,args))))) (defun emit-ftype (name return-type params) - `(declaim (ftype (function (bot &key ,@(iter (for param in params) - (collect (emit-arg-type param)))) + `(declaim (ftype (function (&key ,@(iter (for param in params) + (collect (emit-arg-type param)))) ,return-type) ,name)))) diff --git a/src/tg/send-animation.lisp b/src/tg/send-animation.lisp index a0b2d57..560b331 100644 --- a/src/tg/send-animation.lisp +++ b/src/tg/send-animation.lisp @@ -1,6 +1,7 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/src/tg/send-animation + (:documentation "sendAnimation Telegram method") (:use :c2cl :ukkoclot/src/tg/force-reply @@ -40,9 +41,9 @@ (reply-markup (or inline-keyboard-markup reply-keyboard-markup reply-keyboard-remove force-reply null) nil)) ;; TODO: Some kind of caching for files? -(defun reply-animation (bot msg animation &key allow-sending-without-reply text parse-mode caption-above) - (send-animation bot - :chat-id (message-chat-id msg) +(defun reply-animation (msg animation &key allow-sending-without-reply text parse-mode caption-above) + "Shortcut to reply to a given MSG with an animation." + (send-animation :chat-id (message-chat-id msg) :animation animation :caption text :parse-mode parse-mode diff --git a/src/tg/send-message.lisp b/src/tg/send-message.lisp index 9edc50d..befecbe 100644 --- a/src/tg/send-message.lisp +++ b/src/tg/send-message.lisp @@ -1,6 +1,7 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/src/tg/send-message + (:documentation "sendMessage Telegram method") (:use :c2cl :ukkoclot/src/tg/force-reply @@ -30,9 +31,9 @@ (reply-parameters (or reply-parameters null) nil) (reply-markup (or inline-keyboard-markup reply-keyboard-markup reply-keyboard-remove force-reply null) nil)) -(defun reply-message (bot msg text &key parse-mode allow-sending-without-reply) - (send-message bot - :chat-id (message-chat-id msg) +(defun reply-message (msg text &key parse-mode allow-sending-without-reply) + "Shortcut to reply to a given MSG." + (send-message :chat-id (message-chat-id msg) :text text :parse-mode parse-mode :reply-parameters diff --git a/src/tg/set-my-name.lisp b/src/tg/set-my-name.lisp index 67c698d..2b3869a 100644 --- a/src/tg/set-my-name.lisp +++ b/src/tg/set-my-name.lisp @@ -1,6 +1,7 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/src/tg/set-my-name + (:documentation "setMyName Telegram method.") (:use :c2cl :ukkoclot/src/tg/bot-name :ukkoclot/src/tg/get-my-name :ukkoclot/src/tg/method-macros) (:export :set-my-name)) (in-package :ukkoclot/src/tg/set-my-name) @@ -9,11 +10,14 @@ (name (or string null) nil) (language-code (or string null) nil)) -(defun set-my-name (bot &key (name nil) (language-code nil)) +(defun set-my-name (&key (name nil) (language-code nil)) + "setMyName Telegram method. + +We also first check if the name is already set because setMyName has a very heavy rate limiting impact." (block nil (when name - (let ((curr-name (get-my-name bot :language-code language-code))) + (let ((curr-name (get-my-name :language-code language-code))) (when (string= name (bot-name-name curr-name)) (return)))) - (unless (set-my-name% bot :name name :language-code language-code) + (unless (set-my-name% :name name :language-code language-code) (error "Failed to set name")))) diff --git a/src/transport.lisp b/src/transport.lisp index bb451c1..6906e6d 100644 --- a/src/transport.lisp +++ b/src/transport.lisp @@ -6,8 +6,8 @@ (:import-from :cl+ssl) (:import-from :dex) (:import-from :log) + (:import-from :state :base-uri) (:import-from :ukkoclot/src/serializing :fixup-args :parse-value) - (:import-from :ukkoclot/src/state :bot-base-uri) (:local-nicknames (:jzon :com.inuoe.jzon)) (:export :do-call)) @@ -47,9 +47,9 @@ See `do-call'." (error "TG error ~A: ~A ~:A" error-code description parameters))))))) -(defun do-call (bot method path out-type args) +(defun do-call (method path out-type args) "Perform a HTTP call." - (let ((uri (concatenate 'string (bot-base-uri bot) path)) + (let ((uri (concatenate 'string (base-uri) path)) (args-encoded (fixup-args args))) (log:debug "~A .../~A ~S" method path args-encoded) (do-call% method uri out-type args-encoded))) -- cgit v1.2.3