diff --git a/.README.md.swp b/.README.md.swp new file mode 100644 index 0000000..3388da8 Binary files /dev/null and b/.README.md.swp differ diff --git a/README.md b/README.md index eb23338..c47b7c0 100644 --- a/README.md +++ b/README.md @@ -9,6 +9,9 @@ This library has the following aliases: cl-telegram-bot, tl-bot, tg-bot, telegra - function `(make-bot token)` Returns a bot instance for a given token. To get a new token, see [here](https://core.telegram.org/bots#3-how-do-i-create-a-bot). +- macro `(with-package package-name &rest body)` + Interns JSON symbols into package-name (usually, the package the bot is being used) while executing `body`. + - function `(access object &rest slot-list)` Convenience function to access nested fields in a JSON object. Returns NIL if at least one slot is unbound. For example, to access update.message.from.id, you can use `(access update 'message 'from 'id)`. This operation is linear in time, so I suggest keeping it at a minimum, @@ -16,22 +19,28 @@ This library has the following aliases: cl-telegram-bot, tl-bot, tg-bot, telegra You can use this function from any JSON field, so `(access message 'from 'id)` from a previously accessed message field should be used when many nested fields share a common parent. -- function `(decode json-object)` +- macro `(decode json-object)` Decode JSON object to CLOS object. Use to convert the return value of API calls when needed, e.g. `(decode (send-message ...)` returns an object ready to be used (by `access`, for example). +- macro `(find-json-symbol :symbol-name)` + Returns JSON-interned symbol. + - function `(get-slot obj slot)` Returns slot from obj, NIL if unbound. Use with JSON CLOS object. - error `request-error` Used (currently) by get-updates on HTTP error. -- function `(cl-telegram-bot::get-class-slots object)` (SBCL only) +- unexported function `(cl-telegram-bot::get-class-slots object)` (SBCL only) Use this function to inspect JSON objects. For debugging only. -- function `(cl-telegram-bot::make-request b method-name options-alist)` +- unexported function `(cl-telegram-bot::make-request b method-name options-alist)` Make direct API request using Drakma. Use for debugging only. +- unexported function `(cl-telegram-bot::trace-http)` + Turns on Drakma's HTTP header output. Use for debugging only. + - function [`(get-updates bot &key limit timeout)`](https://core.telegram.org/bots/api#getupdates) Returns a vector of updates as CLOS objects. diff --git a/cl-telegram-bot.lisp b/cl-telegram-bot.lisp index a25001c..7b5c501 100644 --- a/cl-telegram-bot.lisp +++ b/cl-telegram-bot.lisp @@ -24,7 +24,6 @@ (in-package :cl-telegram-bot) - (defclass bot () ((id :documentation "Update id" @@ -67,6 +66,8 @@ (defun access (update &rest args) "Access update field. update.first.second. ... => (access update 'first 'second ...). Nil if unbound." + (unless update + (return-from access nil)) (let ((current update)) (dolist (r args) (unless (slot-boundp current r) @@ -80,37 +81,38 @@ (slot-value update slot) nil)) -(defun decode (obj) - (let ((cl-json:*json-symbols-package* :cl-telegram-bot) - (decoded-object - (json:with-decoder-simple-clos-semantics - (let ((decoded-json (json:decode-json obj))) - (with-slots (ok result) decoded-json - (values decoded-json - (class-of decoded-json) ok result)))))) - decoded-object)) +(defmacro with-package (package &rest body) + `(let ((json:*json-symbols-package* ,package)) ,@body)) + +(defmacro decode (obj) + `(json:with-decoder-simple-clos-semantics + (json:decode-json ,obj))) (define-condition request-error (error) ((what :initarg :what :reader what))) +(defmacro find-json-symbol (sym) + `(find-symbol (symbol-name ,sym) json:*json-symbols-package*)) + +(defmacro trace-http () + '(setf drakma:*header-stream* *standard-output*)) + ; Telegram API methods, see https://core.telegram.org/bots/api (defun get-updates (b &key limit timeout) "https://core.telegram.org/bots/api#getupdates" (let* ((current-id (id b)) - (cl-json:*json-symbols-package* :cl-telegram-bot) (request (decode (make-request b "getUpdates" (list (cons :offset current-id) (cons :limit limit) (cons :timeout timeout))))) - (results (slot-value request 'result))) - - (when (eql (slot-value request 'ok) nil) + (results (slot-value request (find-json-symbol :result)))) + (when (eql (slot-value request (find-json-symbol :ok)) nil) (error 'request-error :what request)) (when (> (length results) 0) (let* ((last-update (elt results (- (length results) 1))) - (id (slot-value last-update 'update--id))) + (id (slot-value last-update (find-json-symbol :update--id)))) (when (= current-id 0) (setf (id b) id)) (incf (id b)))) @@ -118,224 +120,277 @@ (defun set-webhook (b &key url certificate) "https://core.telegram.org/bots/api#setwebhook" - (make-request b "setWebhook" - (list (cons :url url) - (cons :certificate certificate)))) + (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 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" - (make-request b "sendMessage" - (list (cons :chat-id chat-id) - (cons :text text) - (cons :parse-mode parse-mode) - (cons :disable-web-page-preview disable-web-page-preview) - (cons :disable-notification disable-notification) - (cons :reply reply)))) + (let ((options + (list + (cons :chat_id chat-id) + (cons :text text)))) + (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-notification (nconc options `((:disable_notification . ,disable-notification)))) + (when reply-to-message-id (nconc options `((:reply_to_message_id . ,reply-to-message-id)))) + (make-request b "sendMessage" options))) (defun forward-message (b chat-id from-chat-id message-id &key disable-notification) "https://core.telegram.org/bots/api#forwardmessage" - (make-request b "forwardMessage" - (list (cons :chat-id chat-id) - (cons :from-chat-id from-chat-id) - (cons :message-id message-id) - (cons :disable-notification disable-notification)))) + (let ((options + (list + (cons :chat_id chat-id) + (cons :from_chat_id from-chat-id) + (cons :message_id message-id)))) + (when disable-notification (nconc options `((:disable_notification . ,disable-notification)))) + (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" - (make-request b "sendPhoto" - (list (cons :chat-id chat-id) - (cons :photo photo) - (cons :caption caption) - (cons :disable-notification disable-notification) - (cons :reply reply) - (cons :reply-markup reply-markup)))) + (let ((options + (list + (cons :chat_id chat-id) + (cons :photo photo)))) + (when caption (nconc options `((:caption . ,caption)))) + (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 "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 duration performer title disable-notification reply-to-message-id reply-markup) "https://core.telegram.org/bots/api#sendaudio" - (make-request b "sendAudio" - (list (cons :chat-id chat-id) - (cons :audio audio) - (cons :duration duration) - (cons :performer performer) - (cons :title title) - (cons :disable-notification disable-notification) - (cons :reply reply) - (cons :reply-markup reply-markup)))) + (let ((options + (list + (cons :chat_id chat-id) + (cons :audio audio)))) + (when duration (nconc options `((:duration . ,duration)))) + (when performer (nconc options `((:performer . ,performer)))) + (when title (nconc options `((:title . ,title)))) + (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 "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" - (make-request b "sendDocument" - (list (cons :chat-id chat-id) - (cons :document document) - (cons :caption caption) - (cons :disable-notification disable-notification) - (cons :reply reply) - (cons :reply-markup reply-markup)))) + (let ((options + (list + (cons :chat_id chat-id) + (cons :document document)))) + (when caption (nconc options `((:caption . ,caption)))) + (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 "sendDocument" options))) -(defun send-sticker (b chat-id sticker &key disable-notification reply reply-markup) +(defun send-sticker (b chat-id sticker &key disable-notification reply-to-message-id reply-markup) "https://core.telegram.org/bots/api#sendsticker" - (make-request b "sendSticker" - (list (cons :chat-id chat-id) - (cons :sticker sticker) - (cons :disable-notification disable-notification) - (cons :reply reply) - (cons :reply-markup reply-markup)))) + (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 send-video (b chat-id video &key duration width height caption 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#sendvideo" - (make-request b "sendVideo" - (list (cons :chat-id chat-id) - (cons :video video) - (cons :duration duration) - (cons :width width) - (cons :height height) - (cons :caption caption) - (cons :disable-notification disable-notification) - (cons :reply reply) - (cons :reply-markup reply-markup)))) + (let ((options + (list + (cons :chat_id chat-id) + (cons :video video)))) + (when duration (nconc options `((:duration . ,duration)))) + (when width (nconc options `((:width . ,width)))) + (when height (nconc options `((:height . ,height)))) + (when caption (nconc options `((:caption . ,caption)))) + (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 "sendVideo" options))) -(defun send-voice (b chat-id voice &key duration disable-notification reply reply-markup) +(defun send-voice (b chat-id voice &key duration disable-notification reply-to-message-id reply-markup) "https://core.telegram.org/bots/api#sendvoice" - (make-request b "sendVoice" - (list (cons :chat-id chat-id) - (cons :voice voice) - (cons :duration duration) - (cons :disable-notification disable-notification) - (cons :reply reply) - (cons :reply-markup reply-markup)))) + (let ((options + (list + (cons :chat_id chat-id) + (cons :voice voice)))) + (when duration (nconc options `((:duration . ,duration)))) + (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 "sendVoice" options))) -(defun send-location (b chat-id latitude longitude &key disable-notification reply reply-markup) +(defun send-location (b chat-id latitude longitude &key disable-notification reply-to-message-id reply-markup) "https://core.telegram.org/bots/api#sendlocation" - (make-request b "sendLocation" - (list (cons :chat-id chat-id) + (let ((options + (list + (cons :chat_id chat-id) (cons :latitude latitude) - (cons :longitude longitude) - (cons :disable-notification disable-notification) - (cons :reply reply) - (cons :reply-markup reply-markup)))) + (cons :longitude longitude)))) + (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 "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" - (make-request b "sendVenue" - (list (cons :chat-id chat-id) + (let ((options + (list + (cons :chat_id chat-id) (cons :latitude latitude) (cons :longitude longitude) (cons :title title) - (cons :address address) - (cons :foursquare-id foursquare-id) - (cons :disable-notification disable-notification) - (cons :reply reply) - (cons :reply-markup reply-markup)))) + (cons :address address)))) + (when foursquare-id (nconc options `((:foursquare_id . ,foursquare-id)))) + (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 "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" - (make-request b "sendContact" - (list (cons :chat-id chat-id) - (cons :phone-number phone-number) - (cons :first-name first-name) - (cons :last-name last-name) - (cons :disable-notification disable-notification) - (cons :reply reply) - (cons :reply-markup reply-markup)))) + (let ((options + (list + (cons :chat_id chat-id) + (cons :phone_number phone-number) + (cons :first_name first-name)))) + (when last-name (nconc options `((:last_name . ,last-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 "sendContact" options))) (defun send-chat-action (b chat-id action) "https://core.telegram.org/bots/api#sendchataction" - (make-request b "sendChatAction" - (list (cons :chat-id chat-id) + (let ((options + (list + (cons :chat_id chat-id) (cons :action action)))) + (make-request b "sendChatAction" options))) (defun get-user-profile-photos (b user-id &key offset limit) "https://core.telegram.org/bots/api#getuserprofilephotos" - (make-request b "getUserProfilePhotos" - (list (cons :user-id user-id) - (cons :offset offset) - (cons :limit limit)))) + (let ((options + (list + (cons :user_id user-id)))) + (when offset (nconc options `((:offset . ,offset)))) + (when limit (nconc options `((:limit . ,limit)))) + (make-request b "getUserProfilePhotos" options))) (defun get-file (b file-id) "https://core.telegram.org/bots/api#getfile" - (make-request b "getFile" - (list (cons :file-id file-id)))) + (let ((options + (list + (cons :file_id file-id)))) + (make-request b "getFile" options))) (defun kick-chat-member (b chat-id user-id) "https://core.telegram.org/bots/api#kickchatmember" - (make-request b "kickChatMember" - (list (cons :chat-id chat-id) - (cons :user-id user-id)))) + (let ((options + (list + (cons :chat_id chat-id) + (cons :user_id user-id)))) + (make-request b "kickChatMember" options))) (defun leave-chat (b chat-id) "https://core.telegram.org/bots/api#leavechat" - (make-request b "leaveChat" - (list (cons :chat-id chat-id)))) + (let ((options + (list + (cons :chat_id chat-id)))) + (make-request b "leaveChat" options))) (defun unban-chat-member (b chat-id user-id) "https://core.telegram.org/bots/api#unbanchatmember" - (make-request b "unbanChatMember" - (list (cons :chat-id chat-id) - (cons :user-id user-id)))) + (let ((options + (list + (cons :chat_id chat-id) + (cons :user_id user-id)))) + (make-request b "unbanChatMember" options))) (defun get-chat (b chat-id) "https://core.telegram.org/bots/api#getchat" - (make-request b "getChat" - (list (cons :chat-id chat-id)))) + (let ((options + (list + (cons :chat_id chat-id)))) + (make-request b "getChat" options))) (defun get-chat-administrators (b chat-id) "https://core.telegram.org/bots/api#getchatadministrators" - (make-request b "getChatAdministrators" - (list (cons :chat-id chat-id)))) + (let ((options + (list + (cons :chat_id chat-id)))) + (make-request b "getChatAdministrators" options))) (defun get-chat-members-count (b chat-id) "https://core.telegram.org/bots/api#getchatmemberscount" - (make-request b "getChatMembersCount" - (list (cons :chat-id chat-id)))) + (let ((options + (list + (cons :chat_id chat-id)))) + (make-request b "getChatMembersCount" options))) (defun get-chat-member (b chat-id user-id) "https://core.telegram.org/bots/api#getchatmember" - (make-request b "getChatMember" - (list (cons :chat-id chat-id) - (cons :user-id user-id)))) + (let ((options + (list + (cons :chat_id chat-id) + (cons :user_id user-id)))) + (make-request b "getChatMember" options))) (defun answer-callback-query (b callback-query-id &key text show-alert) "https://core.telegram.org/bots/api#answercallbackquery" - (make-request b "answerCallbackQuery" - (list (cons :callback-query-id callback-query-id) - (cons :text text) - (cons :show-alert show-alert)))) + (let ((options + (list + (cons :callback_query_id callback-query-id)))) + (when text (nconc options `((:text . ,text)))) + (when show-alert (nconc options `((:show_alert . ,show-alert)))) + (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) "https://core.telegram.org/bots/api#editmessagetext" - (make-request b "editMessageText" - (list (cons :chat-id chat-id) - (cons :message-id message-id) - (cons :inline-message-id inline-message-id) - (cons :text text) - (cons :parse-mode parse-mode) - (cons :disable-web-page-preview disable-web-page-preview) - (cons :reply-markup reply-markup)))) + (let ((options + (list + (cons :chat_id chat-id) + (cons :message_id message-id) + (cons :inline_message_id inline-message-id) + (cons :text text)))) + (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) "https://core.telegram.org/bots/api#editmessagecaption" - (make-request b "editMessageCaption" - (list (cons :chat-id chat-id) - (cons :message-id message-id) - (cons :inline-message-id inline-message-id) - (cons :caption caption) - (cons :reply-markup reply-markup)))) + (let ((options + (list + (cons :chat_id chat-id) + (cons :message_id message-id) + (cons :inline_message_id inline-message-id)))) + (when caption (nconc options `((:caption . ,caption)))) + (when reply-markup (nconc options `((:reply_markup . ,reply-markup)))) + (make-request b "editMessageCaption" options))) (defun edit-message-reply-markup (b chat-id message-id inline-message-id &key reply-markup) "https://core.telegram.org/bots/api#editmessagereplymarkup" - (make-request b "editMessageReplyMarkup" - (list (cons :chat-id chat-id) - (cons :message-id message-id) - (cons :inline-message-id inline-message-id) - (cons :reply-markup reply-markup)))) + (let ((options + (list + (cons :chat_id chat-id) + (cons :message_id message-id) + (cons :inline_message_id inline-message-id)))) + (when reply-markup (nconc options `((:reply_markup . ,reply-markup)))) + (make-request b "editMessageReplyMarkup" options))) (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" - (make-request b "answerInlineQuery" - (list (cons :inline-query-id inline-query-id) - (cons :results results) - (cons :cache-time cache-time) - (cons :is-personal is-personal) - (cons :next-offset next-offset) - (cons :switch-pm-text switch-pm-text)))) + (let ((options + (list + (cons :inline_query_id inline-query-id) + (cons :results results)))) + (when cache-time (nconc options `((:cache_time . ,cache-time)))) + (when is-personal (nconc options `((:is_personal . ,is-personal)))) + (when next-offset (nconc options `((:next_offset . ,next-offset)))) + (when switch-pm-text (nconc options `((:switch_pm_text . ,switch-pm-text)))) + (make-request b "answerInlineQuery" options))) diff --git a/example.lisp b/example.lisp index 238b271..620c825 100644 --- a/example.lisp +++ b/example.lisp @@ -9,14 +9,15 @@ (defun match-command (regex text function) (multiple-value-bind (msg match) - (cl-ppcre::scan-to-strings regex text) + (cl-ppcre:scan-to-strings regex text) (when match (funcall function msg match)))) -(let ((bot (make-bot "1234567890:YOUR TOKEN HERE"))) +(let ((bot (make-bot "123456789:YOUR TOKEN HERE"))) (loop + (with-package :example-bot (loop for update across (get-updates bot) do - (let* ((message (access update 'message)) + (let* ((message (access update 'message)) (text (access message 'text)) (message-id (access message 'message--id)) (chat-id (access message 'chat 'id)) @@ -29,7 +30,7 @@ (when text (match-command "^/echo (.*)$" text (lambda (msg args) - (send-message bot + (format t (read-line (send-message bot chat-id - (elt args 0))))))) + (elt args 0)))))))))) (sleep 1))) diff --git a/package.lisp b/package.lisp index 93921b7..7fc8c81 100644 --- a/package.lisp +++ b/package.lisp @@ -1,10 +1,11 @@ (defpackage :cl-telegram-bot (:use #:cl) (:nicknames :telegram-bot :tg-bot) - (:size 34) + (:size 5) (:export #:bot #:make-bot + #:with-package #:access #:request-error #:decode