hiro/cl-telegram-bot
1
0
Fork 0
mirror of https://github.com/vale981/cl-telegram-bot synced 2025-03-04 17:21:41 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

updated methods

Browse source
This commit is contained in:
unwind-protect 2017-08-07 15:30:38 +01:00
parent ad9ae3123b
commit be51e40419
2 changed files with 458 additions and 190 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

611
cl-telegram-bot.lisp
View file

@ -1,26 +1,26 @@
; cl-telegram-bot ;; cl-telegram-bot
; ;;
; MIT License ;; MIT License
; ;;
; Copyright (c) 2016 Rei <https://github.com/sovietspaceship> ;; Copyright (c) 2016 Rei <https://github.com/sovietspaceship>
; ;;
; Permission is hereby granted, free of charge, to any person obtaining a copy ;; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal ;; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights ;; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell ;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is ;; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions: ;; furnished to do so, subject to the following conditions:
; ;;
; The above copyright notice and this permission notice shall be included in all ;; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software. ;; copies or substantial portions of the Software.
; ;;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, ;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE ;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER ;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, ;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE ;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE. ;; SOFTWARE.
(in-package :cl-telegram-bot) (in-package :cl-telegram-bot)
@ -55,8 +55,8 @@
(endpoint endpoint) (endpoint endpoint)
(file-endpoint file-endpoint) (file-endpoint file-endpoint)
(api-uri api-uri)) object (api-uri api-uri)) object
(setf endpoint (concatenate 'string api-uri "bot" token "/") (setf endpoint (concatenate 'string api-uri "bot" token "/")
file-endpoint (concatenate 'string api-uri "file/" "bot" token "/")))) file-endpoint (concatenate 'string api-uri "file/" "bot" token "/"))))
(defun make-bot (token) (defun make-bot (token)
"Create a new bot instance. Takes a token string." "Create a new bot instance. Takes a token string."
@ -81,7 +81,7 @@
(defun access (update &rest args) (defun access (update &rest args)
"Access update field. update.first.second. ... => (access update 'first 'second ...). Nil if unbound." "Access update field. update.first.second. ... => (access update 'first 'second ...). Nil if unbound."
(unless update (unless update
(return-from access nil)) (return-from access nil))
(let ((current update)) (let ((current update))
(dolist (r args) (dolist (r args)
(unless (slot-boundp current r) (unless (slot-boundp current r)
@ -96,40 +96,56 @@
nil)) nil))
(defmacro with-package (package &rest body) (defmacro with-package (package &rest body)
`(let ((json:*json-symbols-package* ,package)) ,@body)) `(let ((json:*json-symbols-package* ,package)) ,@body))
(defgeneric decode (object)) (defgeneric decode (object))
(defmethod decode ((object stream)) (defmethod decode ((object stream))
(json:with-decoder-simple-clos-semantics (json:with-decoder-simple-clos-semantics
(prog1 (prog1
(json:decode-json object) (json:decode-json object)
(close object)))) (close object))))
(defmethod decode ((object string)) (defmethod decode ((object string))
(json:with-decoder-simple-clos-semantics (json:with-decoder-simple-clos-semantics
(with-input-from-string (stream object) (with-input-from-string (stream object)
(json:decode-json stream)))) (json:decode-json stream))))
(defmethod decode ((object vector)) (defmethod decode ((object vector))
(decode (map 'string #'code-char object))) (decode (map 'string #'code-char object)))
(define-condition request-error (error) (define-condition request-error (error)
((what :initarg :what :reader what))) ((what :initarg :what :reader what)))
(defmacro find-json-symbol (sym) (defmacro find-json-symbol (sym)
`(find-symbol (symbol-name ,sym) json:*json-symbols-package*)) `(find-symbol (symbol-name ,sym) json:*json-symbols-package*))
(defmacro trace-http () (defmacro trace-http ()
'(setf drakma:*header-stream* *standard-output*)) '(setf drakma:*header-stream* *standard-output*))
; Telegram API methods, see https://core.telegram.org/bots/api (defun download-file (b file-id)
"Get the path for a file from a file-id (see: get-file) and then
download it. Returns nil if the value of the http response code is
not success (200); otherwise it will returns three values: the
data, the http headers and the exension of the original file"
(with-package :cl-telegram-bot
(let* ((file-spec (decode (get-file b file-id))))
(with-ok-results (file-spec results)
(when-let* ((path (access results 'file--path))
(uri (concatenate 'string (file-endpoint b) path))
(extension (cl-ppcre:scan-to-strings "\\..*$" path)))
(multiple-value-bind (body code headers)
(drakma:http-request uri :method :get)
(when (= code +http-ok+)
(values body headers extension))))))))
;; Telegram API methods, see https://core.telegram.org/bots/api
(defmacro with-ok-results ((unserialized results) &body body) (defmacro with-ok-results ((unserialized results) &body body)
`(let ((,results (slot-value ,unserialized (find-json-symbol :result)))) `(let ((,results (slot-value ,unserialized (find-json-symbol :result))))
(if (slot-value ,unserialized (find-json-symbol :ok)) (if (slot-value ,unserialized (find-json-symbol :ok))
(progn ,@body) (progn ,@body)
nil))) nil)))
(defun get-updates (b &key limit timeout) (defun get-updates (b &key limit timeout)
"https://core.telegram.org/bots/api#getupdates" "https://core.telegram.org/bots/api#getupdates"
@ -150,24 +166,34 @@
(incf (id b)))) (incf (id b))))
results)) results))
(defun set-webhook (b &key url certificate) ;; Compiled method list
"https://core.telegram.org/bots/api#setwebhook"
(let ((options '()))
(when url (nconc options `((:url . ,url))))
(when certificate (nconc options `((:certificate . ,certificate))))
(make-request b "setWebhook" options)))
(defun send-message (b chat-id text &key parse-mode disable-web-page-preview disable-notification reply) (defun set-webhook (b url &key certificate max-connections allowed-updates)
"https://core.telegram.org/bots/api#setwebhook"
(let ((options
(list
(cons :url url))))
(when certificate (nconc options `((:certificate . ,certificate))))
(when max-connections (nconc options `((:max_connections . ,max-connections))))
(when allowed-updates (nconc options `((:allowed_updates . ,allowed-updates))))
(make-request b "setWebhook" options)))
(defun get-webhook-info (b)
"https://core.telegram.org/bots/api#getwebhookinfo"
(let ((options '()))
(make-request b "getWebhookInfo" options)))
(defun send-message (b chat-id text &key parse-mode disable-web-page-preview disable-notification reply-to-message-id)
"https://core.telegram.org/bots/api#sendmessage" "https://core.telegram.org/bots/api#sendmessage"
(let ((options (let ((options
(list (list
(cons :chat_id chat-id) (cons :chat_id chat-id)
(cons :text text)))) (cons :text text))))
(when parse-mode (nconc options `((:parse_mode . ,parse-mode)))) (when parse-mode (nconc options `((:parse_mode . ,parse-mode))))
(when disable-web-page-preview (nconc options `((:disable_web_page_preview . ,disable-web-page-preview)))) (when disable-web-page-preview (nconc options `((:disable_web_page_preview . ,disable-web-page-preview))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification)))) (when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(when reply (nconc options `((:reply_to_message_id . ,reply)))) (when reply-to-message-id (nconc options `((:reply_to_message_id . ,reply-to-message-id))))
(make-request b "sendMessage" options))) (make-request b "sendMessage" options)))
(defun forward-message (b chat-id from-chat-id message-id &key disable-notification) (defun forward-message (b chat-id from-chat-id message-id &key disable-notification)
"https://core.telegram.org/bots/api#forwardmessage" "https://core.telegram.org/bots/api#forwardmessage"
@ -176,98 +202,102 @@
(cons :chat_id chat-id) (cons :chat_id chat-id)
(cons :from_chat_id from-chat-id) (cons :from_chat_id from-chat-id)
(cons :message_id message-id)))) (cons :message_id message-id))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification)))) (when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(make-request b "forwardMessage" options))) (make-request b "forwardMessage" options)))
(defun send-photo (b chat-id photo &key caption disable-notification reply reply-markup) (defun send-photo (b chat-id photo &key caption disable-notification reply-to-message-id reply-markup)
"https://core.telegram.org/bots/api#sendphoto" "https://core.telegram.org/bots/api#sendphoto"
(let ((options (let ((options
(list (list
(cons :chat_id chat-id) (cons :chat_id chat-id)
(cons :photo photo)))) (cons :photo photo))))
(when caption (nconc options `((:caption . ,caption)))) (when caption (nconc options `((:caption . ,caption))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification)))) (when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(when reply (nconc options `((:reply_to_message_id . ,reply)))) (when reply-to-message-id (nconc options `((:reply_to_message_id . ,reply-to-message-id))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup)))) (when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "sendPhoto" options))) (make-request b "sendPhoto" options)))
(defun send-audio (b chat-id audio &key duration performer title disable-notification reply reply-markup) (defun send-audio (b chat-id audio &key caption duration performer title disable-notification reply-to-message-id reply-markup)
"https://core.telegram.org/bots/api#sendaudio" "https://core.telegram.org/bots/api#sendaudio"
(let ((options (let ((options
(list (list
(cons :chat_id chat-id) (cons :chat_id chat-id)
(cons :audio audio)))) (cons :audio audio))))
(when duration (nconc options `((:duration . ,duration)))) (when caption (nconc options `((:caption . ,caption))))
(when performer (nconc options `((:performer . ,performer)))) (when duration (nconc options `((:duration . ,duration))))
(when title (nconc options `((:title . ,title)))) (when performer (nconc options `((:performer . ,performer))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification)))) (when title (nconc options `((:title . ,title))))
(when reply (nconc options `((:reply_to_message_id . ,reply)))) (when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup)))) (when reply-to-message-id (nconc options `((:reply_to_message_id . ,reply-to-message-id))))
(make-request b "sendAudio" options))) (when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "sendAudio" options)))
(defun send-document (b chat-id document &key caption disable-notification reply reply-markup) (defun send-document (b chat-id document &key caption disable-notification reply-to-message-id reply-markup)
"https://core.telegram.org/bots/api#senddocument" "https://core.telegram.org/bots/api#senddocument"
(let ((options (let ((options
(list (list
(cons :chat_id chat-id) (cons :chat_id chat-id)
(cons :document document)))) (cons :document document))))
(when caption (nconc options `((:caption . ,caption)))) (when caption (nconc options `((:caption . ,caption))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification)))) (when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(when reply (nconc options `((:reply_to_message_id . ,reply)))) (when reply-to-message-id (nconc options `((:reply_to_message_id . ,reply-to-message-id))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup)))) (when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "sendDocument" options))) (make-request b "sendDocument" options)))
(defun send-sticker (b chat-id sticker &key disable-notification reply reply-markup) (defun send-video (b chat-id video &key duration width height caption disable-notification reply-to-message-id reply-markup)
"https://core.telegram.org/bots/api#sendsticker"
(let ((options
(list
(cons :chat_id chat-id)
(cons :sticker sticker))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(when reply (nconc options `((:reply_to_message_id . ,reply))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "sendSticker" options)))
(defun send-video (b chat-id video &key duration width height caption disable-notification reply reply-markup)
"https://core.telegram.org/bots/api#sendvideo" "https://core.telegram.org/bots/api#sendvideo"
(let ((options (let ((options
(list (list
(cons :chat_id chat-id) (cons :chat_id chat-id)
(cons :video video)))) (cons :video video))))
(when duration (nconc options `((:duration . ,duration)))) (when duration (nconc options `((:duration . ,duration))))
(when width (nconc options `((:width . ,width)))) (when width (nconc options `((:width . ,width))))
(when height (nconc options `((:height . ,height)))) (when height (nconc options `((:height . ,height))))
(when caption (nconc options `((:caption . ,caption)))) (when caption (nconc options `((:caption . ,caption))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification)))) (when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(when reply (nconc options `((:reply_to_message_id . ,reply)))) (when reply-to-message-id (nconc options `((:reply_to_message_id . ,reply-to-message-id))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup)))) (when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "sendVideo" options))) (make-request b "sendVideo" options)))
(defun send-voice (b chat-id voice &key duration disable-notification reply reply-markup) (defun send-voice (b chat-id voice &key caption duration disable-notification reply-to-message-id reply-markup)
"https://core.telegram.org/bots/api#sendvoice" "https://core.telegram.org/bots/api#sendvoice"
(let ((options (let ((options
(list (list
(cons :chat_id chat-id) (cons :chat_id chat-id)
(cons :voice voice)))) (cons :voice voice))))
(when duration (nconc options `((:duration . ,duration)))) (when caption (nconc options `((:caption . ,caption))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification)))) (when duration (nconc options `((:duration . ,duration))))
(when reply (nconc options `((:reply_to_message_id . ,reply)))) (when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup)))) (when reply-to-message-id (nconc options `((:reply_to_message_id . ,reply-to-message-id))))
(make-request b "sendVoice" options))) (when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "sendVoice" options)))
(defun send-location (b chat-id latitude longitude &key disable-notification reply reply-markup) (defun send-video-note (b chat-id video-note &key duration length disable-notification reply-to-message-id reply-markup)
"https://core.telegram.org/bots/api#sendvideonote"
(let ((options
(list
(cons :chat_id chat-id)
(cons :video_note video-note))))
(when duration (nconc options `((:duration . ,duration))))
(when length (nconc options `((:length . ,length))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(when reply-to-message-id (nconc options `((:reply_to_message_id . ,reply-to-message-id))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "sendVideoNote" options)))
(defun send-location (b chat-id latitude longitude &key disable-notification reply-to-message-id reply-markup)
"https://core.telegram.org/bots/api#sendlocation" "https://core.telegram.org/bots/api#sendlocation"
(let ((options (let ((options
(list (list
(cons :chat_id chat-id) (cons :chat_id chat-id)
(cons :latitude latitude) (cons :latitude latitude)
(cons :longitude longitude)))) (cons :longitude longitude))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification)))) (when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(when reply (nconc options `((:reply_to_message_id . ,reply)))) (when reply-to-message-id (nconc options `((:reply_to_message_id . ,reply-to-message-id))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup)))) (when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "sendLocation" options))) (make-request b "sendLocation" options)))
(defun send-venue (b chat-id latitude longitude title address &key foursquare-id disable-notification reply reply-markup) (defun send-venue (b chat-id latitude longitude title address &key foursquare-id disable-notification reply-to-message-id reply-markup)
"https://core.telegram.org/bots/api#sendvenue" "https://core.telegram.org/bots/api#sendvenue"
(let ((options (let ((options
(list (list
@ -276,24 +306,24 @@
(cons :longitude longitude) (cons :longitude longitude)
(cons :title title) (cons :title title)
(cons :address address)))) (cons :address address))))
(when foursquare-id (nconc options `((:foursquare_id . ,foursquare-id)))) (when foursquare-id (nconc options `((:foursquare_id . ,foursquare-id))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification)))) (when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(when reply (nconc options `((:reply_to_message_id . ,reply)))) (when reply-to-message-id (nconc options `((:reply_to_message_id . ,reply-to-message-id))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup)))) (when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "sendVenue" options))) (make-request b "sendVenue" options)))
(defun send-contact (b chat-id phone-number first-name &key last-name disable-notification reply reply-markup) (defun send-contact (b chat-id phone-number first-name &key last-name disable-notification reply-to-message-id reply-markup)
"https://core.telegram.org/bots/api#sendcontact" "https://core.telegram.org/bots/api#sendcontact"
(let ((options (let ((options
(list (list
(cons :chat_id chat-id) (cons :chat_id chat-id)
(cons :phone_number phone-number) (cons :phone_number phone-number)
(cons :first_name first-name)))) (cons :first_name first-name))))
(when last-name (nconc options `((:last_name . ,last-name)))) (when last-name (nconc options `((:last_name . ,last-name))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification)))) (when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(when reply (nconc options `((:reply_to_message_id . ,reply)))) (when reply-to-message-id (nconc options `((:reply_to_message_id . ,reply-to-message-id))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup)))) (when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "sendContact" options))) (make-request b "sendContact" options)))
(defun send-chat-action (b chat-id action) (defun send-chat-action (b chat-id action)
"https://core.telegram.org/bots/api#sendchataction" "https://core.telegram.org/bots/api#sendchataction"
@ -301,54 +331,32 @@
(list (list
(cons :chat_id chat-id) (cons :chat_id chat-id)
(cons :action action)))) (cons :action action))))
(make-request b "sendChatAction" options))) (make-request b "sendChatAction" options)))
(defun get-user-profile-photos (b user-id &key offset limit) (defun get-user-profile-photos (b user-id &key offset limit)
"https://core.telegram.org/bots/api#getuserprofilephotos" "https://core.telegram.org/bots/api#getuserprofilephotos"
(let ((options (let ((options
(list (list
(cons :user_id user-id)))) (cons :user_id user-id))))
(when offset (nconc options `((:offset . ,offset)))) (when offset (nconc options `((:offset . ,offset))))
(when limit (nconc options `((:limit . ,limit)))) (when limit (nconc options `((:limit . ,limit))))
(make-request b "getUserProfilePhotos" options))) (make-request b "getUserProfilePhotos" options)))
(defun get-file (b file-id) (defun get-file (b file-id)
"https://core.telegram.org/bots/api#getfile" "https://core.telegram.org/bots/api#getfile"
(let ((options (let ((options
(list (list
(cons :file_id file-id)))) (cons :file_id file-id))))
(make-request b "getFile" options))) (make-request b "getFile" options)))
(defun download-file (b file-id) (defun kick-chat-member (b chat-id user-id until-date)
"Get the path for a file from a file-id (see: get-file) and then
download it. Returns nil if the value of the http response code is
not success (200); otherwise it will returns three values: the
data, the http headers and the exension of the original file"
(with-package :cl-telegram-bot
(let* ((file-spec (decode (get-file b file-id))))
(with-ok-results (file-spec results)
(when-let* ((path (access results 'file--path))
(uri (concatenate 'string (file-endpoint b) path))
(extension (cl-ppcre:scan-to-strings "\\..*$" path)))
(multiple-value-bind (body code headers)
(drakma:http-request uri :method :get)
(when (= code +http-ok+)
(values body headers extension))))))))
(defun kick-chat-member (b chat-id user-id)
"https://core.telegram.org/bots/api#kickchatmember" "https://core.telegram.org/bots/api#kickchatmember"
(let ((options (let ((options
(list (list
(cons :chat_id chat-id) (cons :chat_id chat-id)
(cons :user_id user-id)))) (cons :user_id user-id)
(make-request b "kickChatMember" options))) (cons :until_date until-date))))
(make-request b "kickChatMember" options)))
(defun leave-chat (b chat-id)
"https://core.telegram.org/bots/api#leavechat"
(let ((options
(list
(cons :chat_id chat-id))))
(make-request b "leaveChat" options)))
(defun unban-chat-member (b chat-id user-id) (defun unban-chat-member (b chat-id user-id)
"https://core.telegram.org/bots/api#unbanchatmember" "https://core.telegram.org/bots/api#unbanchatmember"
@ -356,28 +364,118 @@
(list (list
(cons :chat_id chat-id) (cons :chat_id chat-id)
(cons :user_id user-id)))) (cons :user_id user-id))))
(make-request b "unbanChatMember" options))) (make-request b "unbanChatMember" options)))
(defun restrict-chat-member (b chat-id user-id until-date can-send-messages can-send-media-messages can-send-other-messages can-add-web-page-previews)
"https://core.telegram.org/bots/api#restrictchatmember"
(let ((options
(list
(cons :chat_id chat-id)
(cons :user_id user-id)
(cons :until_date until-date)
(cons :can_send_messages can-send-messages)
(cons :can_send_media_messages can-send-media-messages)
(cons :can_send_other_messages can-send-other-messages)
(cons :can_add_web_page_previews can-add-web-page-previews))))
(make-request b "restrictChatMember" options)))
(defun promote-chat-member (b chat-id user-id can-change-info can-post-messages can-edit-messages can-delete-messages can-invite-users can-restrict-members can-pin-messages can-promote-members)
"https://core.telegram.org/bots/api#promotechatmember"
(let ((options
(list
(cons :chat_id chat-id)
(cons :user_id user-id)
(cons :can_change_info can-change-info)
(cons :can_post_messages can-post-messages)
(cons :can_edit_messages can-edit-messages)
(cons :can_delete_messages can-delete-messages)
(cons :can_invite_users can-invite-users)
(cons :can_restrict_members can-restrict-members)
(cons :can_pin_messages can-pin-messages)
(cons :can_promote_members can-promote-members))))
(make-request b "promoteChatMember" options)))
(defun export-chat-invite-link (b chat-id)
"https://core.telegram.org/bots/api#exportchatinvitelink"
(let ((options
(list
(cons :chat_id chat-id))))
(make-request b "exportChatInviteLink" options)))
(defun set-chat-photo (b chat-id photo)
"https://core.telegram.org/bots/api#setchatphoto"
(let ((options
(list
(cons :chat_id chat-id)
(cons :photo photo))))
(make-request b "setChatPhoto" options)))
(defun delete-chat-photo (b chat-id)
"https://core.telegram.org/bots/api#deletechatphoto"
(let ((options
(list
(cons :chat_id chat-id))))
(make-request b "deleteChatPhoto" options)))
(defun set-chat-title (b chat-id title)
"https://core.telegram.org/bots/api#setchattitle"
(let ((options
(list
(cons :chat_id chat-id)
(cons :title title))))
(make-request b "setChatTitle" options)))
(defun set-chat-description (b chat-id description)
"https://core.telegram.org/bots/api#setchatdescription"
(let ((options
(list
(cons :chat_id chat-id)
(cons :description description))))
(make-request b "setChatDescription" options)))
(defun pin-chat-message (b chat-id message-id disable-notification)
"https://core.telegram.org/bots/api#pinchatmessage"
(let ((options
(list
(cons :chat_id chat-id)
(cons :message_id message-id)
(cons :disable_notification disable-notification))))
(make-request b "pinChatMessage" options)))
(defun unpin-chat-message (b chat-id)
"https://core.telegram.org/bots/api#unpinchatmessage"
(let ((options
(list
(cons :chat_id chat-id))))
(make-request b "unpinChatMessage" options)))
(defun leave-chat (b chat-id)
"https://core.telegram.org/bots/api#leavechat"
(let ((options
(list
(cons :chat_id chat-id))))
(make-request b "leaveChat" options)))
(defun get-chat (b chat-id) (defun get-chat (b chat-id)
"https://core.telegram.org/bots/api#getchat" "https://core.telegram.org/bots/api#getchat"
(let ((options (let ((options
(list (list
(cons :chat_id chat-id)))) (cons :chat_id chat-id))))
(make-request b "getChat" options))) (make-request b "getChat" options)))
(defun get-chat-administrators (b chat-id) (defun get-chat-administrators (b chat-id)
"https://core.telegram.org/bots/api#getchatadministrators" "https://core.telegram.org/bots/api#getchatadministrators"
(let ((options (let ((options
(list (list
(cons :chat_id chat-id)))) (cons :chat_id chat-id))))
(make-request b "getChatAdministrators" options))) (make-request b "getChatAdministrators" options)))
(defun get-chat-members-count (b chat-id) (defun get-chat-members-count (b chat-id)
"https://core.telegram.org/bots/api#getchatmemberscount" "https://core.telegram.org/bots/api#getchatmemberscount"
(let ((options (let ((options
(list (list
(cons :chat_id chat-id)))) (cons :chat_id chat-id))))
(make-request b "getChatMembersCount" options))) (make-request b "getChatMembersCount" options)))
(defun get-chat-member (b chat-id user-id) (defun get-chat-member (b chat-id user-id)
"https://core.telegram.org/bots/api#getchatmember" "https://core.telegram.org/bots/api#getchatmember"
@ -385,50 +483,122 @@
(list (list
(cons :chat_id chat-id) (cons :chat_id chat-id)
(cons :user_id user-id)))) (cons :user_id user-id))))
(make-request b "getChatMember" options))) (make-request b "getChatMember" options)))
(defun answer-callback-query (b callback-query-id &key text show-alert) (defun answer-callback-query (b callback-query-id &key text show-alert url)
"https://core.telegram.org/bots/api#answercallbackquery" "https://core.telegram.org/bots/api#answercallbackquery"
(let ((options (let ((options
(list (list
(cons :callback_query_id callback-query-id)))) (cons :callback_query_id callback-query-id))))
(when text (nconc options `((:text . ,text)))) (when text (nconc options `((:text . ,text))))
(when show-alert (nconc options `((:show_alert . ,show-alert)))) (when show-alert (nconc options `((:show_alert . ,show-alert))))
(make-request b "answerCallbackQuery" options))) (when url (nconc options `((:url . ,url))))
(make-request b "answerCallbackQuery" options)))
(defun edit-message-text (b chat-id message-id inline-message-id text &key parse-mode disable-web-page-preview reply-markup) (defun edit-message-text (b text &key chat-id message-id inline-message-id parse-mode disable-web-page-preview reply-markup)
"https://core.telegram.org/bots/api#editmessagetext" "https://core.telegram.org/bots/api#editmessagetext"
(let ((options (let ((options
(list (list
(cons :chat_id chat-id)
(cons :message_id message-id)
(cons :inline_message_id inline-message-id)
(cons :text text)))) (cons :text text))))
(when parse-mode (nconc options `((:parse_mode . ,parse-mode)))) (when chat-id (nconc options `((:chat_id . ,chat-id))))
(when disable-web-page-preview (nconc options `((:disable_web_page_preview . ,disable-web-page-preview)))) (when message-id (nconc options `((:message_id . ,message-id))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup)))) (when inline-message-id (nconc options `((:inline_message_id . ,inline-message-id))))
(make-request b "editMessageText" options))) (when parse-mode (nconc options `((:parse_mode . ,parse-mode))))
(when disable-web-page-preview (nconc options `((:disable_web_page_preview . ,disable-web-page-preview))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "editMessageText" options)))
(defun edit-message-caption (b chat-id message-id inline-message-id &key caption reply-markup) (defun edit-message-caption (b &key chat-id message-id inline-message-id caption reply-markup)
"https://core.telegram.org/bots/api#editmessagecaption" "https://core.telegram.org/bots/api#editmessagecaption"
(let ((options (let ((options '()))
(list (when chat-id (nconc options `((:chat_id . ,chat-id))))
(cons :chat_id chat-id) (when message-id (nconc options `((:message_id . ,message-id))))
(cons :message_id message-id) (when inline-message-id (nconc options `((:inline_message_id . ,inline-message-id))))
(cons :inline_message_id inline-message-id)))) (when caption (nconc options `((:caption . ,caption))))
(when caption (nconc options `((:caption . ,caption)))) (when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup)))) (make-request b "editMessageCaption" options)))
(make-request b "editMessageCaption" options)))
(defun edit-message-reply-markup (b chat-id message-id inline-message-id &key reply-markup) (defun edit-message-reply-markup (b &key chat-id message-id inline-message-id reply-markup)
"https://core.telegram.org/bots/api#editmessagereplymarkup" "https://core.telegram.org/bots/api#editmessagereplymarkup"
(let ((options '()))
(when chat-id (nconc options `((:chat_id . ,chat-id))))
(when message-id (nconc options `((:message_id . ,message-id))))
(when inline-message-id (nconc options `((:inline_message_id . ,inline-message-id))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "editMessageReplyMarkup" options)))
(defun delete-message (b chat-id message-id)
"https://core.telegram.org/bots/api#deletemessage"
(let ((options (let ((options
(list (list
(cons :chat_id chat-id) (cons :chat_id chat-id)
(cons :message_id message-id) (cons :message_id message-id))))
(cons :inline_message_id inline-message-id)))) (make-request b "deleteMessage" options)))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "editMessageReplyMarkup" options))) (defun send-sticker (b chat-id sticker &key disable-notification reply-to-message-id reply-markup)
"https://core.telegram.org/bots/api#sendsticker"
(let ((options
(list
(cons :chat_id chat-id)
(cons :sticker sticker))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(when reply-to-message-id (nconc options `((:reply_to_message_id . ,reply-to-message-id))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "sendSticker" options)))
(defun get-sticker-set (b name)
"https://core.telegram.org/bots/api#getstickerset"
(let ((options
(list
(cons :name name))))
(make-request b "getStickerSet" options)))
(defun upload-sticker-file (b user-id png-sticker)
"https://core.telegram.org/bots/api#uploadstickerfile"
(let ((options
(list
(cons :user_id user-id)
(cons :png_sticker png-sticker))))
(make-request b "uploadStickerFile" options)))
(defun create-new-sticker-set (b user-id name title png-sticker emojis &key contains-masks mask-position)
"https://core.telegram.org/bots/api#createnewstickerset"
(let ((options
(list
(cons :user_id user-id)
(cons :name name)
(cons :title title)
(cons :png_sticker png-sticker)
(cons :emojis emojis))))
(when contains-masks (nconc options `((:contains_masks . ,contains-masks))))
(when mask-position (nconc options `((:mask_position . ,mask-position))))
(make-request b "createNewStickerSet" options)))
(defun add-sticker-to-set (b user-id name png-sticker emojis &key mask-position)
"https://core.telegram.org/bots/api#addstickertoset"
(let ((options
(list
(cons :user_id user-id)
(cons :name name)
(cons :png_sticker png-sticker)
(cons :emojis emojis))))
(when mask-position (nconc options `((:mask_position . ,mask-position))))
(make-request b "addStickerToSet" options)))
(defun set-sticker-position-in-set (b sticker position)
"https://core.telegram.org/bots/api#setstickerpositioninset"
(let ((options
(list
(cons :sticker sticker)
(cons :position position))))
(make-request b "setStickerPositionInSet" options)))
(defun delete-sticker-from-set (b sticker)
"https://core.telegram.org/bots/api#deletestickerfromset"
(let ((options
(list
(cons :sticker sticker))))
(make-request b "deleteStickerFromSet" options)))
(defun answer-inline-query (b inline-query-id results &key cache-time is-personal next-offset switch-pm-text) (defun answer-inline-query (b inline-query-id results &key cache-time is-personal next-offset switch-pm-text)
"https://core.telegram.org/bots/api#answerinlinequery" "https://core.telegram.org/bots/api#answerinlinequery"
@ -436,8 +606,87 @@
(list (list
(cons :inline_query_id inline-query-id) (cons :inline_query_id inline-query-id)
(cons :results results)))) (cons :results results))))
(when cache-time (nconc options `((:cache_time . ,cache-time)))) (when cache-time (nconc options `((:cache_time . ,cache-time))))
(when is-personal (nconc options `((:is_personal . ,is-personal)))) (when is-personal (nconc options `((:is_personal . ,is-personal))))
(when next-offset (nconc options `((:next_offset . ,next-offset)))) (when next-offset (nconc options `((:next_offset . ,next-offset))))
(when switch-pm-text (nconc options `((:switch_pm_text . ,switch-pm-text)))) (when switch-pm-text (nconc options `((:switch_pm_text . ,switch-pm-text))))
(make-request b "answerInlineQuery" options))) (make-request b "answerInlineQuery" options)))
(defun send-invoice (b chat-id title description payload provider-token start-parameter currency prices &key photo-url photo-size photo-width photo-height need-name need-phone-number need-email need-shipping-address is-flexible disable-notification reply-to-message-id reply-markup)
"https://core.telegram.org/bots/api#sendinvoice"
(let ((options
(list
(cons :chat_id chat-id)
(cons :title title)
(cons :description description)
(cons :payload payload)
(cons :provider_token provider-token)
(cons :start_parameter start-parameter)
(cons :currency currency)
(cons :prices prices))))
(when photo-url (nconc options `((:photo_url . ,photo-url))))
(when photo-size (nconc options `((:photo_size . ,photo-size))))
(when photo-width (nconc options `((:photo_width . ,photo-width))))
(when photo-height (nconc options `((:photo_height . ,photo-height))))
(when need-name (nconc options `((:need_name . ,need-name))))
(when need-phone-number (nconc options `((:need_phone_number . ,need-phone-number))))
(when need-email (nconc options `((:need_email . ,need-email))))
(when need-shipping-address (nconc options `((:need_shipping_address . ,need-shipping-address))))
(when is-flexible (nconc options `((:is_flexible . ,is-flexible))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(when reply-to-message-id (nconc options `((:reply_to_message_id . ,reply-to-message-id))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "sendInvoice" options)))
(defun answer-shipping-query (b shipping-query-id ok &key shipping-options error-message)
"https://core.telegram.org/bots/api#answershippingquery"
(let ((options
(list
(cons :shipping_query_id shipping-query-id)
(cons :ok ok))))
(when shipping-options (nconc options `((:shipping_options . ,shipping-options))))
(when error-message (nconc options `((:error_message . ,error-message))))
(make-request b "answerShippingQuery" options)))
(defun answer-pre-checkout-query (b pre-checkout-query-id ok &key error-message)
"https://core.telegram.org/bots/api#answerprecheckoutquery"
(let ((options
(list
(cons :pre_checkout_query_id pre-checkout-query-id)
(cons :ok ok))))
(when error-message (nconc options `((:error_message . ,error-message))))
(make-request b "answerPreCheckoutQuery" options)))
(defun send-game (b chat-id game-short-name &key disable-notification reply-to-message-id reply-markup)
"https://core.telegram.org/bots/api#sendgame"
(let ((options
(list
(cons :chat_id chat-id)
(cons :game_short_name game-short-name))))
(when disable-notification (nconc options `((:disable_notification . ,disable-notification))))
(when reply-to-message-id (nconc options `((:reply_to_message_id . ,reply-to-message-id))))
(when reply-markup (nconc options `((:reply_markup . ,reply-markup))))
(make-request b "sendGame" options)))
(defun set-game-score (b user-id score &key force disable-edit-message chat-id message-id inline-message-id)
"https://core.telegram.org/bots/api#setgamescore"
(let ((options
(list
(cons :user_id user-id)
(cons :score score))))
(when force (nconc options `((:force . ,force))))
(when disable-edit-message (nconc options `((:disable_edit_message . ,disable-edit-message))))
(when chat-id (nconc options `((:chat_id . ,chat-id))))
(when message-id (nconc options `((:message_id . ,message-id))))
(when inline-message-id (nconc options `((:inline_message_id . ,inline-message-id))))
(make-request b "setGameScore" options)))
(defun get-game-high-scores (b user-id &key chat-id message-id inline-message-id)
"https://core.telegram.org/bots/api#getgamehighscores"
(let ((options
(list
(cons :user_id user-id))))
(when chat-id (nconc options `((:chat_id . ,chat-id))))
(when message-id (nconc options `((:message_id . ,message-id))))
(when inline-message-id (nconc options `((:inline_message_id . ,inline-message-id))))
(make-request b "getGameHighScores" options)))

37
package.lisp
View file

@ -1,26 +1,22 @@
(defpackage :cl-telegram-bot (defpackage :cl-telegram-bot
(:use #:cl) (:use #:cl)
(:nicknames :telegram-bot :tg-bot) (:nicknames :telegram-bot :tg-bot)
(:size 36) (:size 55)
(:export (:export
#:bot #:bot
#:make-bot #:make-bot
#:with-package
#:find-json-symbol
#:get-slot
#:access #:access
#:request-error
#:decode
#:get-updates #:get-updates
#:set-webhook #:set-webhook
#:get-webhook-info
#:send-message #:send-message
#:forward-message #:forward-message
#:send-photo #:send-photo
#:send-audio #:send-audio
#:send-document #:send-document
#:send-sticker
#:send-video #:send-video
#:send-voice #:send-voice
#:send-video-note
#:send-location #:send-location
#:send-venue #:send-venue
#:send-contact #:send-contact
@ -28,8 +24,17 @@
#:get-user-profile-photos #:get-user-profile-photos
#:get-file #:get-file
#:kick-chat-member #:kick-chat-member
#:leave-chat
#:unban-chat-member #:unban-chat-member
#:restrict-chat-member
#:promote-chat-member
#:export-chat-invite-link
#:set-chat-photo
#:delete-chat-photo
#:set-chat-title
#:set-chat-description
#:pin-chat-message
#:unpin-chat-message
#:leave-chat
#:get-chat #:get-chat
#:get-chat-administrators #:get-chat-administrators
#:get-chat-members-count #:get-chat-members-count
@ -38,4 +43,18 @@
#:edit-message-text #:edit-message-text
#:edit-message-caption #:edit-message-caption
#:edit-message-reply-markup #:edit-message-reply-markup
#:answer-inline-query)) #:delete-message
#:send-sticker
#:get-sticker-set
#:upload-sticker-file
#:create-new-sticker-set
#:add-sticker-to-set
#:set-sticker-position-in-set
#:delete-sticker-from-set
#:answer-inline-query
#:send-invoice
#:answer-shipping-query
#:answer-pre-checkout-query
#:send-game
#:set-game-score
#:get-game-high-scores))