Several fixes, working fine now.

This commit is contained in:
unwind-protect 2016-08-18 04:24:09 +02:00
parent 901c633e1c
commit 8fcd0d75c8
5 changed files with 237 additions and 171 deletions

BIN
.README.md.swp Normal file

Binary file not shown.

View file

@ -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.

View file

@ -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)))

View file

@ -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)))

View file

@ -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