From b4c1f66e1631f40d8a7d0f80523470677a91381f Mon Sep 17 00:00:00 2001 From: Uko Kokņevičs Date: Fri, 10 Oct 2025 12:30:46 +0300 Subject: Bunch of changes - Animations - Rewrite of serialization deserialization - Bunch of new TG types --- src/bot/advanced.lisp | 27 +++++- src/bot/impl.lisp | 91 ++++++++++++--------- src/bot/methods.lisp | 46 ++++++++--- src/inline-bots.lisp | 31 ++++--- src/main.lisp | 26 +++--- src/tg-types.lisp | 10 +++ src/tg-types/bot-name.lisp | 10 +-- src/tg-types/callback-query.lisp | 17 ++-- src/tg-types/chat-administrator-rights.lisp | 44 ++++++++++ src/tg-types/chat.lisp | 31 ++++--- src/tg-types/force-reply.lisp | 17 ++-- src/tg-types/inline-keyboard-button.lisp | 28 +++---- src/tg-types/inline-keyboard-markup.lisp | 13 ++- src/tg-types/keyboard-button-poll-type.lisp | 14 ++++ src/tg-types/keyboard-button-request-chat.lisp | 32 ++++++++ src/tg-types/keyboard-button-request-users.lisp | 24 ++++++ src/tg-types/keyboard-button.lisp | 32 ++++++++ src/tg-types/link-preview-options.lisp | 21 ++--- src/tg-types/macros.lisp | 82 ++++++++++--------- src/tg-types/message-entity.lisp | 30 ++++--- src/tg-types/message.lisp | 104 ++++++++++++------------ src/tg-types/parsers.lisp | 9 -- src/tg-types/reply-keyboard-markup.lisp | 24 ++++++ src/tg-types/reply-keyboard-remove.lisp | 16 ++++ src/tg-types/reply-parameters.lisp | 27 +++--- src/tg-types/suggested-post-parameters.lisp | 16 ++++ src/tg-types/suggested-post-price.lisp | 16 ++++ src/tg-types/update.lisp | 39 +++++---- src/tg-types/user.lisp | 23 ++++-- src/tg-types/web-app-info.lisp | 14 ++++ 30 files changed, 605 insertions(+), 309 deletions(-) create mode 100644 src/tg-types/chat-administrator-rights.lisp create mode 100644 src/tg-types/keyboard-button-poll-type.lisp create mode 100644 src/tg-types/keyboard-button-request-chat.lisp create mode 100644 src/tg-types/keyboard-button-request-users.lisp create mode 100644 src/tg-types/keyboard-button.lisp delete mode 100644 src/tg-types/parsers.lisp create mode 100644 src/tg-types/reply-keyboard-markup.lisp create mode 100644 src/tg-types/reply-keyboard-remove.lisp create mode 100644 src/tg-types/suggested-post-parameters.lisp create mode 100644 src/tg-types/suggested-post-price.lisp create mode 100644 src/tg-types/web-app-info.lisp (limited to 'src') diff --git a/src/bot/advanced.lisp b/src/bot/advanced.lisp index a6ad9ba..241b04d 100644 --- a/src/bot/advanced.lisp +++ b/src/bot/advanced.lisp @@ -2,7 +2,7 @@ ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/bot/advanced (:use :c2cl :ukkoclot/bot/impl :ukkoclot/bot/methods :ukkoclot/tg-types) - (:export :bot-id :bot-username :reply-message)) + (:export :bot-id :bot-username :reply-animation :reply-message :try-delete-message)) (in-package :ukkoclot/bot/advanced) (defun bot-id (bot) @@ -17,6 +17,20 @@ (get-me bot) (bot-username% bot)))) +;; 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) + :animation animation + :caption text + :parse-mode parse-mode + :show-caption-above-media caption-above + :reply-parameters + (make-reply-parameters + :allow-sending-without-reply allow-sending-without-reply + :message-id (message-id msg) + :chat-id (message-chat-id msg)))) + (defun reply-message (bot msg text &key parse-mode allow-sending-without-reply) (send-message bot :chat-id (message-chat-id msg) @@ -27,3 +41,14 @@ :allow-sending-without-reply allow-sending-without-reply :message-id (message-id msg) :chat-id (message-chat-id msg)))) + +(defun try-delete-message (bot msg) + (handler-case + (delete-message bot + :chat-id (message-chat-id msg) + :message-id (message-id msg)) + (error () + (handler-case + (reply-animation bot msg #P"blob/do-not.mp4" + :allow-sending-without-reply nil) + (error () nil))))) diff --git a/src/bot/impl.lisp b/src/bot/impl.lisp index b57e2d3..57a9572 100644 --- a/src/bot/impl.lisp +++ b/src/bot/impl.lisp @@ -8,41 +8,62 @@ (:local-nicknames (:jzon :com.inuoe.jzon)) (:export - :arg-encode :bot :bot-p :make-bot :do-call + :bot :bot-p :make-bot :fixup-value :do-call :parse-value :bot-config :bot-db :bot-base-uri :bot-power-on :bot-username% :bot-id%)) (in-package :ukkoclot/bot/impl) -(defgeneric will-arg-encode (object) - (:documentation "Whether the OBJECT has any transformation done to it by arg-encode") - (:method (obj) - nil) - (:method ((obj cons)) - (or (will-arg-encode (car obj)) - (will-arg-encode (cdr obj))))) +(defgeneric parse-value (type json) + (:documentation "Parse value of TYPE from the parsed JSON") + (:method (type json) + (log-error "I don't know how to parse simple type ~A!" type) + (error "I don't know how to parse simple type ~A!" type)) + (:method ((type (eql 'boolean)) json) + (check-type json boolean) + json) + (:method ((type (eql 'integer)) json) + (check-type json integer) + json) + (:method ((type (eql 'null)) json) + (check-type json null) + json) + (:method ((type (eql 'string)) json) + (check-type json string) + json)) -(defgeneric arg-encode (object) - (:documentation "Encode the OBJECT to a form that our HTTP code is happy about.") - (:method (obj) - obj) - (:method ((obj cons)) - (if (not (will-arg-encode obj)) - obj - (cons (arg-encode (car obj)) - (arg-encode (cdr obj)))))) +(defun try-parse-value (type json) + (handler-case (values t (parse-value type json)) + (error () (values nil nil)))) -(defgeneric fixup-arg (value) - (:documentation "Make sure Telegram & QURI & whatever like the arg") +(defmethod parse-value ((type cons) json) + (cond ((and (eq (car type) 'array) + (null (cddr type))) + (when json + (let ((element-type (cadr type))) + (iter (for element in-vector json) + (collect (parse-value element-type element) result-type vector))))) + ((eq (car type) 'or) + (iter (for el-type in (cdr type)) + (multiple-value-bind (success res) (try-parse-value el-type json) + (when success + (return res))) + (finally + (error "Failed to parse ~S as ~A!" json type)))) + (t + (error "I don't know how to parse complex type ~A!" type)))) + +(defgeneric fixup-value (value) + (:documentation "Fixup top-level VALUE before passing it onto telegram") (:method (value) - (error "Unsupported argument type ~S (~S)" (class-name (class-of value)) value)) + (jzon:stringify value)) (:method ((value null)) value) (:method ((value number)) value) - (:method ((value string)) + (:method ((value pathname)) value) - (:method ((value hash-table)) - (jzon:stringify value))) + (:method ((value string)) + value)) (defstruct (bot (:constructor make-bot%)) (config (error "No value given for config") :read-only t) @@ -58,39 +79,35 @@ (config-bot-token config) "/"))) (make-bot% :config config :db db :base-uri base-uri))) -(defun args-plist->alist (args-plist) - (iter (for (old-key value) on args-plist by #'cddr) +(defun fixup-args (args) + (iter (for (key . value) in args) (collect - (let ((new-key (string-downcase (lisp->snake-case (symbol-name old-key))))) - (cons new-key value))))) - -(defun fixup-args (args-alist) - (iter (for (name . value) in args-alist) - (collecting (cons name (fixup-arg (arg-encode value)))))) + (cons (string-downcase (lisp->snake-case (symbol-name key))) + (fixup-value value))))) (defun req (uri method content) ;; We deal with this manually (handler-bind ((dex:http-request-too-many-requests #'dex:ignore-and-continue)) (dex:request uri :method method :content content))) -(defun do-call% (bot method uri mapfn args-encoded) +(defun do-call% (bot method uri type args-encoded) (let ((body (req uri method args-encoded))) (let ((hash (jzon:parse body))) (acond - ((gethash "ok" hash) (funcall mapfn (gethash "result" hash))) + ((gethash "ok" hash) (parse-value type (gethash "result" hash))) ((aand (gethash "parameters" hash) (gethash "retry_after" it)) (log-info "Should sleep for ~A seconds" it) (sleep it) (log-info "Good morning!") - (do-call% bot method uri mapfn args-encoded)) + (do-call% bot method uri type args-encoded)) (t (error "TG error ~A: ~A ~:A" (gethash "error_code" hash) (gethash "description" hash) (gethash "parameters" hash))))))) -(defun do-call (bot method path mapfn args-plist) +(defun do-call (bot method path type args) (let ((uri (concatenate 'string (bot-base-uri bot) path)) - (args-encoded (fixup-args (args-plist->alist args-plist)))) + (args-encoded (fixup-args args))) (log-debug "~A .../~A ~S" method path args-encoded) - (do-call% bot method uri mapfn args-encoded))) + (do-call% bot method uri type args-encoded))) diff --git a/src/bot/methods.lisp b/src/bot/methods.lisp index 99b6411..7ccc4ad 100644 --- a/src/bot/methods.lisp +++ b/src/bot/methods.lisp @@ -2,22 +2,22 @@ ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/bot/methods (:use :c2cl :ukkoclot/bot/impl :ukkoclot/tg-types :ukkoclot/tg-types/macros) - (:export :answer-callback-query :delete-message :edit-message-text :get-me :get-updates :send-message :set-my-name)) + (:export :answer-callback-query :delete-message :send-animation :edit-message-text :get-me :get-updates :send-message :set-my-name)) (in-package :ukkoclot/bot/methods) -(define-tg-method (answer-callback-query boolean "answerCallbackQuery" #'identity) +(define-tg-method (answer-callback-query boolean "answerCallbackQuery") (callback-query-id string) (text (or string null) nil) (show-alert boolean nil) (url (or string null) nil) (cache-time (or integer null) nil)) -(define-tg-method (delete-message boolean "deleteMessage" #'identity) +(define-tg-method (delete-message boolean "deleteMessage") (chat-id (or integer string)) (message-id integer)) ;; TODO: Add a way to simply specify :message msg :) -(define-tg-method (edit-message-text message "editMessageText" #'hash->message) +(define-tg-method (edit-message-text message "editMessageText") (business-connection-id (or string null) nil) (chat-id (or integer string null) nil) (message-id (or integer null) nil) @@ -28,7 +28,7 @@ (link-preview-options (or link-preview-options null) nil) (reply-markup (or inline-keyboard-markup null) nil)) -(define-tg-method (get-me% user "getMe" #'hash->user :GET)) +(define-tg-method (get-me% user "getMe" :GET)) (defun get-me (bot) (let ((res (get-me% bot))) @@ -36,16 +36,39 @@ (setf (bot-username% bot) (user-username res)) res)) -(define-tg-method (get-my-name bot-name "getMyName" #'hash->bot-name :GET) +(define-tg-method (get-my-name bot-name "getMyName" :GET) (language-code (or string null) nil)) -(define-tg-method (get-updates (array update) "getUpdates" #'parse-update-array) +(define-tg-method (get-updates (array update) "getUpdates") (offset (or integer null) nil) (limit (or integer null) nil) (timeout (or integer null) nil) (allowed-updates (or string null) nil)) -(define-tg-method (send-message message "sendMessage" #'hash->message) +(define-tg-method (send-animation message "sendAnimation") + (business-connection-id (or string null) nil) + (chat-id (or integer string)) + (message-thread-id (or integer null) nil) + (direct-messages-topic-id (or integer null) nil) + (animation (or pathname string)) + (duration (or integer null) nil) + (width (or integer null) nil) + (height (or integer null) nil) + (thumbnail (or pathname string null) nil) + (caption (or string null) nil) + (parse-mode (or string null) nil) + (caption-entities (or (array message-entity) null) nil) + (show-caption-above-media boolean nil) + (has-spoiler boolean nil) + (disable-notification boolean nil) + (protect-content boolean nil) + (allow-paid-broadcast boolean nil) + (message-effect-id (or string null) nil) + (suggested-post-parameters (or suggested-post-parameters null) nil) + (reply-parameters (or reply-parameters null) nil) + (reply-markup (or inline-keyboard-markup reply-keyboard-markup reply-keyboard-remove force-reply null) nil)) + +(define-tg-method (send-message message "sendMessage") (business-connection-id (or string null) nil) (chat-id (or integer string)) (message-thread-id (or integer null) nil) @@ -58,12 +81,9 @@ (protect-content (or boolean null) nil) (message-effect-id (or string null) nil) (reply-parameters (or reply-parameters null) nil) - (reply-markup (or inline-keyboard-markup - ;; TODO: reply-keyboard-markup - ;; TODO: reply-keyboard-remove - force-reply null) nil)) + (reply-markup (or inline-keyboard-markup reply-keyboard-markup reply-keyboard-remove force-reply null) nil)) -(define-tg-method (set-my-name% boolean "setMyName" #'identity) +(define-tg-method (set-my-name% boolean "setMyName") (name (or string null) nil) (language-code (or string null) nil)) diff --git a/src/inline-bots.lisp b/src/inline-bots.lisp index 5945084..eb20f21 100644 --- a/src/inline-bots.lisp +++ b/src/inline-bots.lisp @@ -20,23 +20,20 @@ (log-info "Deleting an unallowed inline bot message from ~A ~A" (user-username via) (user-id via)) - (delete-message bot - :chat-id (message-chat-id msg) - :message-id (message-id msg)) + (try-delete-message bot msg) (unless (eq ty :blacklisted) ;; Not explicitly blacklisted, notify dev group - (send-message bot - :chat-id (config-dev-group (bot-config bot)) - :text (format nil "Deleted a message sent via inline bot @~A ~A" - (user-username via) - (user-id via)) - :parse-mode "HTML" - :reply-markup (make-inline-keyboard-markup - :inline-keyboard - #(#((make-inline-keyboard-button - :text "Whitelist" - :callback-data (format nil "bwl:~A" (user-id via))) - (make-inline-keyboard-button - :text "Blacklist" - :callback-data (format nil "bbl:~A" (user-id via)))))))) + (let ((whitelist (make-inline-keyboard-button :text "Whitelist" + :callback-data (format nil "bwl:~A" (user-id via)))) + (blacklist (make-inline-keyboard-button :text "Blacklist" + :callback-data (format nil "bbl:~A" (user-id via))))) + (send-message bot + :chat-id (config-dev-group (bot-config bot)) + :text (format nil "Deleted a message sent via inline bot @~A ~A" + (user-username via) + (user-id via)) + :parse-mode "HTML" + :reply-markup (make-inline-keyboard-markup + :inline-keyboard + (make-array '(1 2) :initial-contents (list (list whitelist blacklist))))))) nil)))) diff --git a/src/main.lisp b/src/main.lisp index 419bb67..6d83ff4 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -4,7 +4,7 @@ (:nicknames :ukkoclot) (:use :c2cl :ukkoclot/bot :ukkoclot/config :ukkoclot/inline-bots :ukkoclot/log :ukkoclot/tg-types) (:import-from :anaphora :acond :awhen :it) - (:import-from :ukkoclot/bot :make-bot :bot-power-on) + (:import-from :ukkoclot/bot :make-bot :bot-power-on :fixup-value) (:import-from :ukkoclot/db :with-db) (:import-from :ukkoclot/strings :escape-xml :is-tg-whitespace-str :starts-with :starts-with-ignore-case) (:local-nicknames @@ -32,7 +32,8 @@ (log-info "We're done!"))) (defun wrapped-main (bot config) - (send-message bot :chat-id (config-dev-group config) :text "Initializing...") + (when *in-prod* + (send-message bot :chat-id (config-dev-group config) :text "Initializing...")) (set-my-name bot :name (config-bot-name config)) (let ((gup-offset 0)) (loop while (bot-power-on bot) do @@ -101,14 +102,17 @@ (on-new-member bot msg new-chat-member))))) (defun on-new-member (bot msg new-member) - ;; TODO: Rule 11 no hating on cats on bot entry ;; TODO: Rule 10 have fun and enjoy your time on user entry (if (= (user-id new-member) (bot-id bot)) - nil - (reply-message bot msg - (concatenate 'string "Hello there, " (user-format-name new-member) "! Be on your bestest behaviour now!!") - :parse-mode "HTML" - :allow-sending-without-reply t))) + (reply-animation bot msg #P"blob/rule-11.mp4" + :allow-sending-without-reply t) + (reply-animation bot msg #P"blob/rule-10.mp4" + :text (concatenate 'string "Hello there, " + (user-format-name new-member) + "! Be on your bestest behaviour now!!") + :parse-mode "HTML" + :caption-above t + :allow-sending-without-reply t))) (defun is-bad-text (text) ;; TODO: @@ -130,7 +134,7 @@ (awhen (message-entities msg) (loop for entity across it - when (and (eq (message-entity-type entity) :bot-command) + when (and (equal (message-entity-type entity) "bot_command") (= (message-entity-offset entity) 0)) do (on-text-command bot msg text (message-entity-extract entity text)))) @@ -218,9 +222,7 @@ ((and (equal simple-cmd "msginfo") (message-reply-to-message msg)) - (reply-message bot it - ;; TODO: Text needs lot more massaging lol - (jzon:stringify (arg-encode it)))) + (reply-message bot it (fixup-value it))) ((equal simple-cmd "ping") (let* ((start-time (get-internal-real-time)) diff --git a/src/tg-types.lisp b/src/tg-types.lisp index 1243773..6a830b6 100644 --- a/src/tg-types.lisp +++ b/src/tg-types.lisp @@ -6,13 +6,23 @@ :ukkoclot/tg-types/bot-name :ukkoclot/tg-types/callback-query :ukkoclot/tg-types/chat + :ukkoclot/tg-types/chat-administrator-rights :ukkoclot/tg-types/force-reply :ukkoclot/tg-types/inline-keyboard-button :ukkoclot/tg-types/inline-keyboard-markup + :ukkoclot/tg-types/keyboard-button + :ukkoclot/tg-types/keyboard-button-poll-type + :ukkoclot/tg-types/keyboard-button-request-chat + :ukkoclot/tg-types/keyboard-button-request-users :ukkoclot/tg-types/link-preview-options :ukkoclot/tg-types/message :ukkoclot/tg-types/message-entity + :ukkoclot/tg-types/reply-keyboard-markup + :ukkoclot/tg-types/reply-keyboard-remove :ukkoclot/tg-types/reply-parameters + :ukkoclot/tg-types/suggested-post-parameters + :ukkoclot/tg-types/suggested-post-price :ukkoclot/tg-types/update :ukkoclot/tg-types/user + :ukkoclot/tg-types/web-app-info )) diff --git a/src/tg-types/bot-name.lisp b/src/tg-types/bot-name.lisp index 385b91c..b42765c 100644 --- a/src/tg-types/bot-name.lisp +++ b/src/tg-types/bot-name.lisp @@ -3,11 +3,11 @@ (defpackage :ukkoclot/tg-types/bot-name (:use :c2cl :ukkoclot/tg-types/macros) (:export - bot-name bot-name-p - - hash->bot-name make-bot-name parse-bot-name-array - - bot-name-name)) + #:bot-name + #:make-bot-name + #:bot-name-p + #:copy-bot-name + #:bot-name-name)) (in-package :ukkoclot/tg-types/bot-name) (define-tg-type bot-name diff --git a/src/tg-types/callback-query.lisp b/src/tg-types/callback-query.lisp index bb1b4e7..875ff25 100644 --- a/src/tg-types/callback-query.lisp +++ b/src/tg-types/callback-query.lisp @@ -6,12 +6,17 @@ :ukkoclot/tg-types/message :ukkoclot/tg-types/user) (:export - callback-query callback-query-p - - hash->callback-query make-callback-query parse-callback-query-array - - callback-query-id callback-query-from callback-query-message callback-query-inline-message-id - callback-query-chat-instance callback-query-data callback-query-game-short-name)) + #:callback-query + #:make-callback-query + #:callback-query-p + #:copy-callback-query + #:callback-query-id + #:callback-query-from + #:callback-query-message + #:callback-query-inline-message-id + #:callback-query-chat-instance + #:callback-query-data + #:callback-query-game-short-name)) (in-package :ukkoclot/tg-types/callback-query) (define-tg-type callback-query diff --git a/src/tg-types/chat-administrator-rights.lisp b/src/tg-types/chat-administrator-rights.lisp new file mode 100644 index 0000000..37c1ce0 --- /dev/null +++ b/src/tg-types/chat-administrator-rights.lisp @@ -0,0 +1,44 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/chat-administrator-rights + (:use :c2cl :ukkoclot/tg-types/macros) + (:export + #:chat-administrator-rights + #:make-chat-administrator-rights + #:chat-administrator-rights-p + #:copy-chat-administrator-rights + #:chat-administrator-rights-is-anonymous + #:chat-administrator-rights-can-manage-chat + #:chat-administrator-rights-can-delete-messages + #:chat-administrator-rights-can-manage-video-chats + #:chat-administrator-rights-can-restrict-members + #:chat-administrator-rights-can-promote-members + #:chat-administrator-rights-can-change-info + #:chat-administrator-rights-can-invite-users + #:chat-administrator-rights-can-post-stories + #:chat-administrator-rights-can-edit-stories + #:chat-administrator-rights-can-delete-stories + #:chat-administrator-rights-can-post-messages + #:chat-administrator-rights-can-edit-messages + #:chat-administrator-rights-can-pin-messages + #:chat-administrator-rights-can-manage-topics + #:chat-administrator-rights-can-manage-direct-messages)) +(in-package :ukkoclot/tg-types/chat-administrator-rights) + +(define-tg-type chat-administrator-rights + (is-anonymous boolean) + (can-manage-chat boolean) + (can-delete-messages boolean) + (can-manage-video-chats boolean) + (can-restrict-members boolean) + (can-promote-members boolean) + (can-change-info boolean) + (can-invite-users boolean) + (can-post-stories boolean) + (can-edit-stories boolean) + (can-delete-stories boolean) + (can-post-messages boolean nil) + (can-edit-messages boolean nil) + (can-pin-messages boolean nil) + (can-manage-topics boolean nil) + (can-manage-direct-messages boolean nil)) diff --git a/src/tg-types/chat.lisp b/src/tg-types/chat.lisp index 4010f7b..3ad42ef 100644 --- a/src/tg-types/chat.lisp +++ b/src/tg-types/chat.lisp @@ -1,28 +1,25 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/tg-types/chat - (:use :c2cl :ukkoclot/tg-types/macros :ukkoclot/tg-types/parsers) + (:use :c2cl :ukkoclot/tg-types/macros) (:export - chat - make-chat - chat-p - copy-chat - chat-id - chat-type - chat-title - chat-username - chat-first-name - chat-last-name - chat-is-forum - chat-is-direct-messages - - hash->chat - parse-chat-array)) + #:chat + #:make-chat + #:chat-p + #:copy-chat + #:chat-id + #:chat-type + #:chat-title + #:chat-username + #:chat-first-name + #:chat-last-name + #:chat-is-forum + #:chat-is-direct-messages)) (in-package :ukkoclot/tg-types/chat) (define-tg-type chat (id integer) - (type keyword nil :parser tg-string->keyword) + (type string nil) ;TODO: member of keywords (title (or string null) nil) (username (or string null) nil) (first-name (or string null) nil) diff --git a/src/tg-types/force-reply.lisp b/src/tg-types/force-reply.lisp index ad9d2a0..5dc49fb 100644 --- a/src/tg-types/force-reply.lisp +++ b/src/tg-types/force-reply.lisp @@ -3,16 +3,13 @@ (defpackage :ukkoclot/tg-types/force-reply (:use :c2cl :ukkoclot/tg-types/macros) (:export - force-reply - make-force-reply - force-reply-p - copy-force-reply - force-reply-force-reply - force-reply-input-field-placeholder - force-reply-selective - - hash->force-reply - parse-force-reply-array)) + #:force-reply + #:make-force-reply + #:force-reply-p + #:copy-force-reply + #:force-reply-force-reply + #:force-reply-input-field-placeholder + #:force-reply-selective)) (in-package :ukkoclot/tg-types/force-reply) (define-tg-type force-reply diff --git a/src/tg-types/inline-keyboard-button.lisp b/src/tg-types/inline-keyboard-button.lisp index 3b76ade..e3b3533 100644 --- a/src/tg-types/inline-keyboard-button.lisp +++ b/src/tg-types/inline-keyboard-button.lisp @@ -1,28 +1,26 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/tg-types/inline-keyboard-button - (:use :c2cl :ukkoclot/tg-types/macros) + (:use :c2cl :ukkoclot/tg-types/macros :ukkoclot/tg-types/web-app-info) (:export - inline-keyboard-button - make-inline-keyboard-button - inline-keyboard-button-p - copy-inline-keyboard-button - inline-keyboard-button-text - inline-keyboard-button-url - inline-keyboard-button-callback-data - inline-keyboard-button-switch-inline-query - inline-keyboard-button-switch-inline-query-current-chat - inline-keyboard-button-pay - - hash->inline-keyboard-button - parse-inline-keyboard-button-array)) + #:inline-keyboard-button + #:make-inline-keyboard-button + #:inline-keyboard-button-p + #:copy-inline-keyboard-button + #:inline-keyboard-button-text + #:inline-keyboard-button-url + #:inline-keyboard-button-callback-data + #:inline-keyboard-button-web-app + #:inline-keyboard-button-switch-inline-query + #:inline-keyboard-button-switch-inline-query-current-chat + #:inline-keyboard-button-pay)) (in-package :ukkoclot/tg-types/inline-keyboard-button) (define-tg-type inline-keyboard-button (text string) (url (or string null) nil) (callback-data string) - ;; TODO: (web-app (or web-app-info null) nil) + (web-app (or web-app-info null) nil) ;; TODO: (login-url (or login-url null) nil) (switch-inline-query (or string null) nil) (switch-inline-query-current-chat (or string null) nil) diff --git a/src/tg-types/inline-keyboard-markup.lisp b/src/tg-types/inline-keyboard-markup.lisp index 1f17f6c..bb7b9c1 100644 --- a/src/tg-types/inline-keyboard-markup.lisp +++ b/src/tg-types/inline-keyboard-markup.lisp @@ -3,14 +3,11 @@ (defpackage :ukkoclot/tg-types/inline-keyboard-markup (:use :c2cl :ukkoclot/tg-types/inline-keyboard-button :ukkoclot/tg-types/macros) (:export - inline-keyboard-markup - make-inline-keyboard-markup - inline-keyboard-markup-p - copy-inline-keyboard-markup - inline-keyboard-markup-inline-keyboard - - hash->inline-keyboard-markup - parse-inline-keyboard-markup-array)) + #:inline-keyboard-markup + #:make-inline-keyboard-markup + #:inline-keyboard-markup-p + #:copy-inline-keyboard-markup + #:inline-keyboard-markup-inline-keyboard)) (in-package :ukkoclot/tg-types/inline-keyboard-markup) (define-tg-type inline-keyboard-markup diff --git a/src/tg-types/keyboard-button-poll-type.lisp b/src/tg-types/keyboard-button-poll-type.lisp new file mode 100644 index 0000000..fdd7b92 --- /dev/null +++ b/src/tg-types/keyboard-button-poll-type.lisp @@ -0,0 +1,14 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/keyboard-button-poll-type + (:use :c2cl :ukkoclot/tg-types/macros) + (:export + #:keyboard-button-poll-type + #:make-keyboard-button-poll-type + #:keyboard-button-poll-type-p + #:copy-keyboard-button-poll-type + #:keyboard-button-poll-type-type)) +(in-package :ukkoclot/tg-types/keyboard-button-poll-type) + +(define-tg-type keyboard-button-poll-type + (type (or string null) nil)) ;(member "quiz" "regular") or null diff --git a/src/tg-types/keyboard-button-request-chat.lisp b/src/tg-types/keyboard-button-request-chat.lisp new file mode 100644 index 0000000..aab8512 --- /dev/null +++ b/src/tg-types/keyboard-button-request-chat.lisp @@ -0,0 +1,32 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/keyboard-button-request-chat + (:use :c2cl :ukkoclot/tg-types/chat-administrator-rights :ukkoclot/tg-types/macros) + (:export + #:keyboard-button-request-chat + #:make-keyboard-button-request-chat + #:keyboard-button-request-chat-p + #:copy-keyboard-button-request-chat + #:keyboard-button-request-chat-request-id + #:keyboard-button-request-chat-chat-is-channel + #:keyboard-button-request-chat-chat-is-created + #:keyboard-button-request-chat-user-administrator-rights + #:keyboard-button-request-chat-bot-administrator-rights + #:keyboard-button-request-chat-bot-is-member + #:keyboard-button-request-chat-request-title + #:keyboard-button-request-chat-request-username + #:keyboard-button-request-chat-request-photo)) +(in-package :ukkoclot/tg-types/keyboard-button-request-chat) + +(define-tg-type keyboard-button-request-chat + (request-id integer) + (chat-is-channel boolean) + ;; TODO: (chat-is-forum ternary nil) + ;; TODO: (chat-has-username ternary nil) + (chat-is-created boolean nil) + (user-administrator-rights (or chat-administrator-rights null) nil) + (bot-administrator-rights (or chat-administrator-rights null) nil) + (bot-is-member boolean nil) + (request-title boolean nil) + (request-username boolean nil) + (request-photo boolean nil)) diff --git a/src/tg-types/keyboard-button-request-users.lisp b/src/tg-types/keyboard-button-request-users.lisp new file mode 100644 index 0000000..9b20c3d --- /dev/null +++ b/src/tg-types/keyboard-button-request-users.lisp @@ -0,0 +1,24 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/keyboard-button-request-users + (:use :c2cl :ukkoclot/tg-types/macros) + (:export + #:keyboard-button-request-users + #:make-keyboard-button-request-users + #:keyboard-button-request-users-p + #:copy-keyboard-button-request-users + #:keyboard-button-request-users-request-id + #:keyboard-button-request-users-max-quantity + #:keyboard-button-request-users-request-name + #:keyboard-button-request-users-request-username + #:keyboard-button-request-users-request-photo)) +(in-package :ukkoclot/tg-types/keyboard-button-request-users) + +(define-tg-type keyboard-button-request-users + (request-id integer) + ;; TODO: (user-is-bot ternary nil) + ;; TODO: (user-is-premium ternary nil) + (max-quantity integer 1) + (request-name boolean nil) + (request-username boolean nil) + (request-photo boolean nil)) diff --git a/src/tg-types/keyboard-button.lisp b/src/tg-types/keyboard-button.lisp new file mode 100644 index 0000000..fac64e6 --- /dev/null +++ b/src/tg-types/keyboard-button.lisp @@ -0,0 +1,32 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/keyboard-button + (:use + :c2cl + :ukkoclot/tg-types/keyboard-button-poll-type + :ukkoclot/tg-types/keyboard-button-request-chat + :ukkoclot/tg-types/keyboard-button-request-users + :ukkoclot/tg-types/macros + :ukkoclot/tg-types/web-app-info) + (:export + #:keyboard-button + #:make-keyboard-button + #:keyboard-button-p + #:copy-keyboard-button + #:keyboard-button-text + #:keyboard-button-request-users + #:keyboard-button-request-chat + #:keyboard-button-request-contact + #:keyboard-button-request-location + #:keyboard-button-request-poll + #:keyboard-button-web-app)) +(in-package :ukkoclot/tg-types/keyboard-button) + +(define-tg-type keyboard-button + (text string) + (request-users (or keyboard-button-request-users null) nil) + (request-chat (or keyboard-button-request-chat null) nil) + (request-contact boolean nil) + (request-location boolean nil) + (request-poll (or keyboard-button-poll-type null) nil) + (web-app (or web-app-info null) nil)) diff --git a/src/tg-types/link-preview-options.lisp b/src/tg-types/link-preview-options.lisp index 66b7d83..450a9ea 100644 --- a/src/tg-types/link-preview-options.lisp +++ b/src/tg-types/link-preview-options.lisp @@ -3,18 +3,15 @@ (defpackage :ukkoclot/tg-types/link-preview-options (:use :c2cl :ukkoclot/tg-types/macros) (:export - link-preview-options - make-link-preview-options - link-preview-options-p - copy-link-preview-options - link-preview-options-is-disabled - link-preview-options-url - link-preview-options-prefer-small-media - link-preview-options-prefer-large-media - link-preview-options-show-above-text - - hash->link-preview-options - parse-link-preview-options-array)) + #:link-preview-options + #:make-link-preview-options + #:link-preview-options-p + #:copy-link-preview-options + #:link-preview-options-is-disabled + #:link-preview-options-url + #:link-preview-options-prefer-small-media + #:link-preview-options-prefer-large-media + #:link-preview-options-show-above-text)) (in-package :ukkoclot/tg-types/link-preview-options) (define-tg-type link-preview-options diff --git a/src/tg-types/macros.lisp b/src/tg-types/macros.lisp index 668df17..a8a3d96 100644 --- a/src/tg-types/macros.lisp +++ b/src/tg-types/macros.lisp @@ -2,26 +2,27 @@ ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/tg-types/macros (:use :c2cl) - (:import-from :ukkoclot/bot/impl :arg-encode :bot :do-call :will-arg-encode) + (:import-from :ukkoclot/bot/impl :bot :do-call :parse-value) (:import-from :ukkoclot/hash-tables :gethash-lazy) (:import-from :ukkoclot/strings :lisp->snake-case) + (:local-nicknames + (:jzon :com.inuoe.jzon)) (:export :define-tg-method :define-tg-type)) (in-package :ukkoclot/tg-types/macros) (eval-when (:compile-toplevel :load-toplevel :execute) - (defstruct (field (:constructor make-field%)) name type default skip-if-default (parser 'identity)) + (defstruct (field (:constructor make-field%)) name type default skip-if-default) (defparameter +unique+ (gensym)) - (defun make-field (name type &optional (default +unique+) &key (parser 'identity) (skip-if-default (not (eq default +unique+)))) + (defun make-field (name type &optional (default +unique+) &key (skip-if-default (not (eq default +unique+)))) (let ((default (if (eq default +unique+) (list 'error (format nil "No value given for ~A" name)) default))) (make-field% :name name :type type :default default - :skip-if-default skip-if-default - :parser parser))) + :skip-if-default skip-if-default))) (defun parse-field-specs (field-specs) (loop for field-spec in field-specs @@ -33,6 +34,11 @@ (defun field-accessor (struc-name field) (intern (concatenate 'string (symbol-name struc-name) "-" (symbol-name (field-name field))))) + (defun field->coerced-field-spec (field struc-name obj-name) + `(list ,(string-downcase (lisp->snake-case (symbol-name (field-name field)))) + (,(field-accessor struc-name field) ,obj-name) + ',(field-type field))) + (defun field->defun-spec (field) (list (field-name field) (field-default field))) @@ -58,10 +64,8 @@ `(setf (gethash ,hash-key ,hash-table-sym) (,(field-accessor name field) ,struc))))) (defun field->let-gethash-spec (field hash-table-sym) - (list (field-name field) - (list 'funcall - (list 'function (field-parser field)) - (field->gethash-spec field hash-table-sym)))) + `(,(field-name field) + (parse-value ',(field-type field) ,(field->gethash-spec field hash-table-sym)))) (defun field->make-spec (field) (list (intern (symbol-name (field-name field)) :keyword) @@ -72,35 +76,40 @@ ;; TODO: Automatically derive path from name ;; TODO: Automatically derive mapfn from type -;; TODO: Skip values that are already their defaults (defmacro define-tg-method ( - (name type path mapfn &optional (method :POST)) + (name type path &optional (method :POST)) &body field-specs) - (let ((fields (parse-field-specs field-specs)) - (args-plist (gensym "ARGS-PLIST-")) - (bot (gensym "BOT-"))) + (let* ((fields (parse-field-specs field-specs)) + (revfields (reverse fields)) + (args (gensym "ARGS")) + (bot (gensym "BOT-"))) `(progn (declaim (ftype (function (bot &key ,@(loop for field in fields collect (field->ftype-spec field))) ,type) ,name)) - (defun ,name (,bot &rest ,args-plist &key ,@(loop for field in fields collect (field->defun-spec field))) - (declare ,@(loop for field in fields collect (list 'ignore (field-name field)))) - (do-call ,bot ,method ,path ,mapfn ,args-plist))))) + (defun ,name (,bot &key ,@(loop for field in fields collect (field->defun-spec field))) + (let (,args) + ,@(loop for field in revfields + collecting + (if (field-skip-if-default field) + `(unless (equal ,(field-name field) ,(field-default field)) + (setf ,args (acons ',(field-name field) ,(field-name field) ,args))) + `(setf ,args (acons ',(field-name field) ,(field-name field) ,args)))) + (do-call ,bot ,method ,path ',type ,args)))))) (defmacro define-tg-type (name &body field-specs) (let* ((fields (parse-field-specs field-specs)) (revfields (reverse fields)) (make-name (intern (concatenate 'string "MAKE-" (symbol-name name)))) - (hash->name (intern (concatenate 'string "HASH->" (symbol-name name)))) - (parse-name-array (intern (concatenate 'string "PARSE-" (symbol-name name) "-ARRAY"))) (printer (gensym (concatenate 'string "PRINT-" (symbol-name name)))) (hash (gensym "HASH-")) - (array (gensym "ARRAY-")) (struc (gensym (symbol-name name))) (stream (gensym "STREAM")) (depth (gensym "DEPTH")) - (pprint-args (gensym "PPRINT-ARGS"))) + (pprint-args (gensym "PPRINT-ARGS")) + (res (gensym "RES")) + (type (gensym "TYPE"))) `(progn (defstruct (,name (:print-function ,printer)) ,@(loop for field in fields @@ -116,19 +125,18 @@ (setf ,pprint-args (list* ',(field-name field) value ,pprint-args)))) `(setf ,pprint-args (list* ',(field-name field) (,(field-accessor name field) ,struc) ,pprint-args)))) (format ,stream "~A~<[~;~@{~_~1I~W = ~W~^, ~}~;]~:>" ',name ,pprint-args))) - (defun ,hash->name (,hash) - (when ,hash - (let ,(loop for field in fields - collect (field->let-gethash-spec field hash)) - (,make-name ,@(loop for field in fields - append (field->make-spec field)))))) - (defmethod arg-encode ((,struc ,name)) - (let ((,hash (make-hash-table))) - ,@(loop for field in fields - collect (field->sethash-spec field name struc hash)) - ,hash)) - (defmethod will-arg-encode ((,struc ,name)) - t) - (defun ,parse-name-array (,array) - (when ,array - (map 'vector #',hash->name ,array)))))) + (defmethod parse-value ((,type (eql ',name)) ,hash) + (let ,(loop for field in fields + collect (field->let-gethash-spec field hash)) + (,make-name ,@(loop for field in fields + append (field->make-spec field))))) + (defmethod jzon:coerced-fields ((,struc ,name)) + (let (,res) + ,@(loop for field in revfields + collecting + (if (field-skip-if-default field) + `(let ((value (,(field-accessor name field) ,struc))) + (unless (equal value ,(field-default field)) + (setf ,res (cons ,(field->coerced-field-spec field name struc) ,res)))) + `(setf ,res (cons ,(field->coerced-field-spec field name struc) ,res)))) + ,res))))) diff --git a/src/tg-types/message-entity.lisp b/src/tg-types/message-entity.lisp index fcabcce..a605f23 100644 --- a/src/tg-types/message-entity.lisp +++ b/src/tg-types/message-entity.lisp @@ -1,27 +1,25 @@ ;; SPDX-License-Identifier: EUPL-1.2 ;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs (defpackage :ukkoclot/tg-types/message-entity - (:use :c2cl :iterate :ukkoclot/tg-types/macros :ukkoclot/tg-types/parsers :ukkoclot/tg-types/user) + (:use :c2cl :iterate :ukkoclot/tg-types/macros :ukkoclot/tg-types/user) (:export - message-entity - make-message-entity - message-entity-p - copy-message-entity - message-entity-type - message-entity-offset - message-entity-length - message-entity-url - message-entity-user - message-entity-language - message-entity-custom-emoji-id + #:message-entity + #:make-message-entity + #:message-entity-p + #:copy-message-entity + #:message-entity-type + #:message-entity-offset + #:message-entity-length + #:message-entity-url + #:message-entity-user + #:message-entity-language + #:message-entity-custom-emoji-id - hash->message-entity - message-entity-extract - parse-message-entity-array)) + #:message-entity-extract)) (in-package :ukkoclot/tg-types/message-entity) (define-tg-type message-entity - (type keyword nil :parser tg-string->keyword) + (type string nil) ;TODO: keywords (offset integer) (length integer) (url (or string null) nil) diff --git a/src/tg-types/message.lisp b/src/tg-types/message.lisp index fee0734..028379f 100644 --- a/src/tg-types/message.lisp +++ b/src/tg-types/message.lisp @@ -7,52 +7,50 @@ :ukkoclot/tg-types/message-entity :ukkoclot/tg-types/user) (:export - message - make-message - message-p - copy-message - message-message-id - message-message-thread-id - message-from - message-sender-boost-count - message-sender-business-bot - message-date - message-business-connection-id - message-chat - message-is-topic-message - message-is-automatic-forward - message-reply-to-message - message-reply-to-checklist-task-id - message-via-bot - message-edit-date - message-has-protected-content - message-is-from-offline - message-is-paid-post - message-media-group-id - message-author-signature - message-paid-star-count - message-text - message-entities - message-effect-id - message-caption - message-show-caption-above-media - message-has-media-spoiler - message-new-chat-members - message-new-chat-title - message-delete-chat-photo - message-group-chat-created - message-supergroup-chat-created - message-channel-chat-created - message-migrate-to-chat-id - message-migrate-from-chat-id - message-pinned-message - message-connected-website + #:message + #:make-message + #:message-p + #:copy-message + #:message-message-id + #:message-message-thread-id + #:message-from + #:message-sender-boost-count + #:message-sender-business-bot + #:message-date + #:message-business-connection-id + #:message-chat + #:message-is-topic-message + #:message-is-automatic-forward + #:message-reply-to-message + #:message-reply-to-checklist-task-id + #:message-via-bot + #:message-edit-date + #:message-has-protected-content + #:message-is-from-offline + #:message-is-paid-post + #:message-media-group-id + #:message-author-signature + #:message-paid-star-count + #:message-text + #:message-entities + #:message-effect-id + #:message-caption + #:message-show-caption-above-media + #:message-has-media-spoiler + #:message-new-chat-members + #:message-new-chat-title + #:message-delete-chat-photo + #:message-group-chat-created + #:message-supergroup-chat-created + #:message-channel-chat-created + #:message-migrate-to-chat-id + #:message-migrate-from-chat-id + #:message-pinned-message + #:message-connected-website - hash->message - message-id - message-chat-id - message-thread-id - parse-message-array)) + #:message-chat-id + #:message-thread-id + #:message-id)) (in-package :ukkoclot/tg-types/message) ;; If this is a MaybeInaccessibleMessage date will be 0 if this is inaccessible @@ -60,22 +58,22 @@ (message-id integer) (message-thread-id (or integer null) nil) ;; (direct-messages-topic (or direct-messages-topic null) nil) - (from (or user null) nil :parser hash->user) + (from (or user null) nil) ;; (sender-chat (or chat null) nil) (sender-boost-count (or integer null) nil) - (sender-business-bot (or user null) nil :parser hash->user) + (sender-business-bot (or user null) nil) (date integer) (business-connection-id (or string null) nil) - (chat chat nil :parser hash->chat) + (chat chat nil) ;; (forward-origin (or message-origin null) nil) (is-topic-message boolean nil) (is-automatic-forward boolean nil) - (reply-to-message (or message null) nil :parser hash->message) + (reply-to-message (or message null) nil) ;; (external-reply (or external-reply-info null) nil) ;; (quote (or text-quote null) nil) ;; (reply-to-story (or story null) nil) (reply-to-checklist-task-id (or integer null) nil) - (via-bot (or user null) nil :parser hash->user) + (via-bot (or user null) nil) (edit-date (or integer null) nil) (has-protected-content boolean nil) (is-from-offline boolean nil) @@ -84,7 +82,7 @@ (author-signature (or string null) nil) (paid-star-count (or string null) nil) (text (or string null) nil) - (entities (or (array message-entity) null) nil :parser parse-message-entity-array) + (entities (or (array message-entity) null) nil) ;; (link-preview-options (or link-preview-options null) nil) ;; (suggested-post-info (or suggested-post-info null) nil) (effect-id (or string null) nil) @@ -108,7 +106,7 @@ ;; (poll (or poll null) nil) ;; (venue (or venue null) nil) ;; (location (or location null) nil) - (new-chat-members (or (array user) null) nil :parser parse-user-array) + (new-chat-members (or (array user) null) nil) ;; (left-chat-member (or user null) nil) (new-chat-title (or string null) nil) ;; (new-chat-photo (or (array photo-size) null) nil) @@ -119,7 +117,7 @@ ;; (message-auto-delete-timer-changed (orp message-auto-delete-timer-changed null) nil) (migrate-to-chat-id (or integer null) nil) (migrate-from-chat-id (or integer null) nil) - (pinned-message (or message null) nil :parser hash->message) + (pinned-message (or message null) nil) ;; (invoice (or invoice null) nil) ;; (successful-payment (or successful-payment null) nil) ;; (refunded-payment (or refunded-payment null) nil) diff --git a/src/tg-types/parsers.lisp b/src/tg-types/parsers.lisp deleted file mode 100644 index 0b6c4ae..0000000 --- a/src/tg-types/parsers.lisp +++ /dev/null @@ -1,9 +0,0 @@ -;; SPDX-License-Identifier: EUPL-1.2 -;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs -(defpackage :ukkoclot/tg-types/parsers - (:use :c2cl :ukkoclot/strings) - (:export tg-string->keyword)) -(in-package :ukkoclot/tg-types/parsers) - -(defun tg-string->keyword (str) - (intern (string-upcase (snake->lisp-case str)) :keyword)) diff --git a/src/tg-types/reply-keyboard-markup.lisp b/src/tg-types/reply-keyboard-markup.lisp new file mode 100644 index 0000000..f4b5d45 --- /dev/null +++ b/src/tg-types/reply-keyboard-markup.lisp @@ -0,0 +1,24 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/reply-keyboard-markup + (:use :c2cl :ukkoclot/tg-types/keyboard-button :ukkoclot/tg-types/macros) + (:export + #:reply-keyboard-markup + #:make-reply-keyboard-markup + #:reply-keyboard-markup-p + #:copy-reply-keyboard-markup + #:reply-keyboard-markup-keyboard + #:reply-keyboard-markup-is-persistent + #:reply-keyboard-markup-resize-keyboard + #:reply-keyboard-markup-one-time-keyboard + #:reply-keyboard-markup-input-field-placeholder + #:reply-keyboard-markup-selective)) +(in-package :ukkoclot/tg-types/reply-keyboard-markup) + +(define-tg-type reply-keyboard-markup + (keyboard (array (array keyboard-button))) + (is-persistent boolean nil) + (resize-keyboard boolean nil) + (one-time-keyboard boolean nil) + (input-field-placeholder (or string null) nil) + (selective boolean nil)) diff --git a/src/tg-types/reply-keyboard-remove.lisp b/src/tg-types/reply-keyboard-remove.lisp new file mode 100644 index 0000000..9925d82 --- /dev/null +++ b/src/tg-types/reply-keyboard-remove.lisp @@ -0,0 +1,16 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/reply-keyboard-remove + (:use :c2cl :ukkoclot/tg-types/macros) + (:export + #:reply-keyboard-remove + #:make-reply-keyboard-remove + #:reply-keyboard-remove-p + #:copy-reply-keyboard-remove + #:reply-keyboard-remove-remove-keyboard + #:reply-keyboard-remove-selective)) +(in-package :ukkoclot/tg-types/reply-keyboard-remove) + +(define-tg-type reply-keyboard-remove + (remove-keyboard boolean t :skip-if-default nil) + (selective boolean nil)) diff --git a/src/tg-types/reply-parameters.lisp b/src/tg-types/reply-parameters.lisp index 29d21f7..ac38db7 100644 --- a/src/tg-types/reply-parameters.lisp +++ b/src/tg-types/reply-parameters.lisp @@ -3,21 +3,18 @@ (defpackage :ukkoclot/tg-types/reply-parameters (:use :c2cl :ukkoclot/tg-types/macros :ukkoclot/tg-types/message-entity) (:export - reply-parameters - make-reply-parameters - reply-parameters-p - copy-reply-parameters - reply-parameters-message-id - reply-parameters-chat-id - reply-parameters-allow-sending-without-reply - reply-parameters-quote - reply-parameters-quote-parse-mode - reply-parameters-quote-entities - reply-parameters-quote-position - reply-parameters-checklist-task-id - - hash->reply-parameters - parse-reply-parameters-array)) + #:reply-parameters + #:make-reply-parameters + #:reply-parameters-p + #:copy-reply-parameters + #:reply-parameters-message-id + #:reply-parameters-chat-id + #:reply-parameters-allow-sending-without-reply + #:reply-parameters-quote + #:reply-parameters-quote-parse-mode + #:reply-parameters-quote-entities + #:reply-parameters-quote-position + #:reply-parameters-checklist-task-id)) (in-package :ukkoclot/tg-types/reply-parameters) (define-tg-type reply-parameters diff --git a/src/tg-types/suggested-post-parameters.lisp b/src/tg-types/suggested-post-parameters.lisp new file mode 100644 index 0000000..bf781fc --- /dev/null +++ b/src/tg-types/suggested-post-parameters.lisp @@ -0,0 +1,16 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/suggested-post-parameters + (:use :c2cl :ukkoclot/tg-types/macros :ukkoclot/tg-types/suggested-post-price) + (:export + #:suggested-post-parameters + #:make-suggested-post-parameters + #:suggested-post-parameters-p + #:copy-suggested-post-parameters + #:suggested-post-parameters-price + #:suggested-post-parameters-send-date)) +(in-package :ukkoclot/tg-types/suggested-post-parameters) + +(define-tg-type suggested-post-parameters + (price (or suggested-post-price null) nil) + (send-date (or integer null) nil)) diff --git a/src/tg-types/suggested-post-price.lisp b/src/tg-types/suggested-post-price.lisp new file mode 100644 index 0000000..e5b6cb3 --- /dev/null +++ b/src/tg-types/suggested-post-price.lisp @@ -0,0 +1,16 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/suggested-post-price + (:use :c2cl :ukkoclot/tg-types/macros) + (:export + #:suggested-post-price + #:make-suggested-post-price + #:suggested-post-price-p + #:copy-suggested-post-price + #:suggested-post-price-currency + #:suggested-post-price-amount)) +(in-package :ukkoclot/tg-types/suggested-post-price) + +(define-tg-type suggested-post-price + (currency string) ;(member "XTR" "TON") + (amount integer)) diff --git a/src/tg-types/update.lisp b/src/tg-types/update.lisp index 9043d54..c259553 100644 --- a/src/tg-types/update.lisp +++ b/src/tg-types/update.lisp @@ -5,36 +5,35 @@ :ukkoclot/tg-types/callback-query :ukkoclot/tg-types/message) (:export - update update-p - - hash->update make-update parse-update-array - - update-update-id update-message update-edited-message update-channel-post update-edited-channel-post - ;; update-business-connection - update-business-message update-edited-business-message - ;; update-deleted-business-messages update-message-reaction update-message-reaction-count update-inline-query - ;; update-chosen-inline-result - update-callback-query - ;; update-shipping-query update-pre-checkout-query update-poll update-poll-answer update-my-chat-member - ;; update-chat-member update-chat-join-request update-chat-boost update-removed-chat-boost - )) + #:update + #:make-update + #:update-p + #:copy-update + #:update-update-id + #:update-message + #:update-edited-message + #:update-channel-post + #:update-edited-channel-post + #:update-business-message + #:update-edited-business-message + #:update-callback-query)) (in-package :ukkoclot/tg-types/update) (define-tg-type update (update-id integer) - (message (or message null) nil :parser hash->message) - (edited-message (or message null) nil :parser hash->message) - (channel-post (or message null) nil :parser hash->message) - (edited-channel-post (or message null) nil :parser hash->message) + (message (or message null) nil) + (edited-message (or message null) nil) + (channel-post (or message null) nil) + (edited-channel-post (or message null) nil) ;; (business-connection (or business-connection null) nil) - (business-message (or message null) nil :parser hash->message) - (edited-business-message (or message null) nil :parser hash->message) + (business-message (or message null) nil) + (edited-business-message (or message null) nil) ;; (deleted-business-messages (or business-messages-deleted null) nil) ;; (message-reaction (or message-reaction-updated null) nil) ;; (message-reaction-count (or message-reaction-count-updated null) nil) ;; (inline-query (or inline-query null) nil) ;; (chosen-inline-result (or chosen-inline-result null) nil) - (callback-query (or callback-query null) nil :parser hash->callback-query) + (callback-query (or callback-query null) nil) ;; (shipping-query (or shipping-query null) nil) ;; (pre-checkout-query (or pre-checkout-query null) nil) ;; (poll (or poll null) nil) diff --git a/src/tg-types/user.lisp b/src/tg-types/user.lisp index c5ed499..b5be417 100644 --- a/src/tg-types/user.lisp +++ b/src/tg-types/user.lisp @@ -4,13 +4,24 @@ (:use :c2cl :ukkoclot/tg-types/macros) (:import-from :ukkoclot/strings :escape-xml) (:export - user user-p + #:user + #:make-user + #:user-p + #:copy-user + #:user-id + #:user-is-bot + #:user-first-name + #:user-last-name + #:user-username + #:user-language-code + #:user-is-premium + #:user-added-to-attachment-menu + #:user-can-join-groups + #:user-can-read-all-group-messages + #:user-supports-inline-queries + #:user-can-connect-to-business - hash->user make-user parse-user-array user-format-name - - user-id user-is-bot user-first-name user-last-name user-username user-language-code user-is-premium - user-added-to-attachment-menu user-can-join-groups user-can-read-all-group-messages user-supports-inline-queries - user-can-connect-to-business)) + #:user-format-name)) (in-package :ukkoclot/tg-types/user) (define-tg-type user diff --git a/src/tg-types/web-app-info.lisp b/src/tg-types/web-app-info.lisp new file mode 100644 index 0000000..e239830 --- /dev/null +++ b/src/tg-types/web-app-info.lisp @@ -0,0 +1,14 @@ +;; SPDX-License-Identifier: EUPL-1.2 +;; SPDX-FileCopyrightText: 2025 Uko Kokņevičs +(defpackage :ukkoclot/tg-types/web-app-info + (:use :c2cl :ukkoclot/tg-types/macros) + (:export + #:web-app-info + #:make-web-app-info + #:web-app-info-p + #:copy-web-app-info + #:web-app-info-url)) +(in-package :ukkoclot/tg-types/web-app-info) + +(define-tg-type web-app-info + (url string)) -- cgit v1.2.3