telegram.lisp 8.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227
  1. (in-package #:chatikbot)
  2. (defvar *telegram-token* nil "Telegram bot token")
  3. (defparameter +telegram-api-format+ "https://api.telegram.org/bot~A/~A")
  4. (defparameter +telegram-file-format+ "https://api.telegram.org/file/bot~A/~A")
  5. (defvar *telegram-timeout* 30 "Default Telegram timeout")
  6. (defun %telegram-api-call (method &optional args)
  7. (let* ((params (loop for (k . v) in args when v
  8. collect (cons
  9. (princ-to-string k)
  10. (if (pathnamep v) v
  11. (princ-to-string v)))))
  12. (timeout (+ 5 (or (aget "timeout" args)
  13. *telegram-timeout*)))
  14. (response
  15. (handler-case
  16. (bordeaux-threads:with-timeout (timeout)
  17. (json-request (format nil +telegram-api-format+
  18. *telegram-token* method)
  19. :method :post
  20. :parameters params))
  21. (bordeaux-threads:timeout () (error "Timeout")))))
  22. (unless (aget "ok" response)
  23. (error (aget "description" response)))
  24. (aget "result" response)))
  25. (defun telegram-get-updates (&key offset limit timeout)
  26. (%telegram-api-call
  27. "getUpdates"
  28. (list (cons "offset" offset)
  29. (cons "limit" limit)
  30. (cons "timeout" timeout))))
  31. (defun telegram-get-me ()
  32. (%telegram-api-call "getMe"))
  33. (defun telegram-set-webhook (&optional url certificate)
  34. (%telegram-api-call "setWebhook" (list (cons "url" url) (cons "certificate" certificate))))
  35. (defun telegram-send-message (chat-id text &key parse-mode disable-web-preview disable-notification reply-to reply-markup)
  36. (%telegram-api-call
  37. "sendMessage"
  38. (list (cons "chat_id" chat-id)
  39. (cons "text" text)
  40. (cons "parse_mode" parse-mode)
  41. (cons "disable_web_page_preview" disable-web-preview)
  42. (cons "disable_notification" disable-notification)
  43. (cons "reply_to_message_id" reply-to)
  44. (cons "reply_markup" reply-markup))))
  45. (defun telegram-forward-message (chat-id from-chat-id message-id)
  46. (%telegram-api-call
  47. "forwardMessage"
  48. `(("chat_id" . ,chat-id)
  49. ("from_chat_id" . ,from-chat-id)
  50. ("message_id" . ,message-id))))
  51. (defun telegram-send-photo (chat-id photo &key caption reply-to reply-markup)
  52. (%telegram-api-call
  53. "sendPhoto"
  54. (list (cons "chat_id" chat-id)
  55. (cons "photo" photo)
  56. (cons "caption" caption)
  57. (cons "reply_to_message_id" reply-to)
  58. (cons "reply_markup" reply-markup))))
  59. (defun telegram-send-audio (chat-id audio &key duration performer title reply-to reply-markup)
  60. (%telegram-api-call
  61. "sendAudio"
  62. (list (cons "chat_id" chat-id)
  63. (cons "audio" audio)
  64. (cons "duration" duration)
  65. (cons "performer" performer)
  66. (cons "title" title)
  67. (cons "reply_to_message_id" reply-to)
  68. (cons "reply_markup" reply-markup))))
  69. (defun telegram-send-document (chat-id document &key reply-to reply-markup)
  70. (%telegram-api-call
  71. "sendDocument"
  72. (list (cons "chat_id" chat-id)
  73. (cons "document" document)
  74. (cons "reply_to_message_id" reply-to)
  75. (cons "reply_markup" reply-markup))))
  76. (defun telegram-send-sticker (chat-id sticker &key reply-to reply-markup)
  77. (%telegram-api-call
  78. "sendSticker"
  79. (list (cons "chat_id" chat-id)
  80. (cons "sticker" sticker)
  81. (cons "reply_to_message_id" reply-to)
  82. (cons "reply_markup" reply-markup))))
  83. (defun telegram-send-video (chat-id video &key duration caption reply-to reply-markup)
  84. (%telegram-api-call
  85. "sendVideo"
  86. (list (cons "chat_id" chat-id)
  87. (cons "video" video)
  88. (cons "duration" duration)
  89. (cons "caption" caption)
  90. (cons "reply_to_message_id" reply-to)
  91. (cons "reply_markup" reply-markup))))
  92. (defun telegram-send-voice (chat-id voice &key duration reply-to reply-markup)
  93. (%telegram-api-call
  94. "sendVoice"
  95. (list (cons "chat_id" chat-id)
  96. (cons "voice" voice)
  97. (cons "duration" duration)
  98. (cons "reply_to_message_id" reply-to)
  99. (cons "reply_markup" reply-markup))))
  100. (defun telegram-send-location (chat-id latitude longitude &key reply-to reply-markup)
  101. (%telegram-api-call
  102. "sendLocation"
  103. (list (cons "chat_id" chat-id)
  104. (cons "latitude" latitude)
  105. (cons "longitude" longitude)
  106. (cons "reply_to_message_id" reply-to)
  107. (cons "reply_markup" reply-markup))))
  108. (defun telegram-send-chat-action (chat-id action)
  109. (%telegram-api-call
  110. "sendChatAction"
  111. (list (cons "chat_id" chat-id)
  112. (cons "action" action))))
  113. (defun telegram-get-user-profile-photos (user-id &key offset limit)
  114. (%telegram-api-call
  115. "getUserProfilePhotos"
  116. (list (cons "user_id" user-id)
  117. (cons "offset" offset)
  118. (cons "limit" limit))))
  119. (defun telegram-get-file (file-id)
  120. (%telegram-api-call "getFile" (list (cons "file_id" file-id))))
  121. (defun telegram-answer-callback-query (query-id &key text show-alert)
  122. (%telegram-api-call
  123. "answerCallbackQuery"
  124. (list (cons "callback_query_id" query-id)
  125. (cons "text" text)
  126. (cons "show_alert" show-alert))))
  127. (defun telegram-edit-message-text (text &key chat-id message-id inline-message-id parse-mode disable-web-preview reply-markup)
  128. (%telegram-api-call
  129. "editMessageText"
  130. (list (cons "chat_id" chat-id)
  131. (cons "message_id" message-id)
  132. (cons "inline_message_id" inline-message-id)
  133. (cons "text" text)
  134. (cons "parse_mode" parse-mode)
  135. (cons "disable_web_page_preview" disable-web-preview)
  136. (cons "reply_markup" reply-markup))))
  137. (defun telegram-edit-message-caption (caption &key chat-id message-id inline-message-id reply-markup)
  138. (%telegram-api-call
  139. "editMessageCaption"
  140. (list (cons "chat_id" chat-id)
  141. (cons "message_id" message-id)
  142. (cons "inline_message_id" inline-message-id)
  143. (cons "caption" caption)
  144. (cons "reply_markup" reply-markup))))
  145. (defun telegram-edit-message-reply-markup (reply-markup &key chat-id message-id inline-message-id)
  146. (%telegram-api-call
  147. "editMessageReplyMarkup"
  148. (list (cons "chat_id" chat-id)
  149. (cons "message_id" message-id)
  150. (cons "inline_message_id" inline-message-id)
  151. (cons "reply_markup" reply-markup))))
  152. (defun telegram-answer-inline-query (query-id results &key cache-time is-personal next-offset switch-pm-text switch-pm-parameter)
  153. (%telegram-api-call
  154. "answerInlineQuery"
  155. (list (cons "inline_query_id" query-id)
  156. (cons "results" (plist-json results))
  157. (cons "cache_time" cache-time)
  158. (cons "is_personal" is-personal)
  159. (cons "next_offset" next-offset)
  160. (cons "switch_pm_text" switch-pm-text)
  161. (cons "switch_pm_parameter" switch-pm-parameter))))
  162. (defun telegram-file-contents (file-id)
  163. (let* ((file (telegram-get-file file-id))
  164. (file-path (aget "file_path" file))
  165. (file-url (format nil +telegram-file-format+ *telegram-token* file-path)))
  166. (drakma:http-request file-url :force-binary t :decode-content t)))
  167. (defun telegram-inline-keyboard-markup (inline-keyboard)
  168. (plist-json
  169. (list :inline-keyboard inline-keyboard)))
  170. (defun telegram-reply-keyboard-markup (keyboard &key resize-keyboard one-time-keyboard selective)
  171. (plist-json
  172. (list :keyboard keyboard
  173. :resize-keyboard resize-keyboard
  174. :one-time-keyboard one-time-keyboard
  175. :selective selective)))
  176. (defun telegram-reply-keyboard-hide (&optional selective)
  177. (plist-json (list :hide-keyboard t :selective selective)))
  178. (defun telegram-force-reply (&optional selective)
  179. (plist-json (list :force-reply t :selective selective)))
  180. ;; Simplified interface
  181. ;;
  182. (defun send-response (chat-id response &optional reply-id)
  183. (if (consp response)
  184. (if (keywordp (car response))
  185. (case (car response)
  186. (:text (telegram-send-message chat-id (cdr response) :reply-to reply-id))
  187. (:voice (telegram-send-voice chat-id (cdr response) :reply-to reply-id))
  188. (:sticker (telegram-send-sticker chat-id (cdr response) :reply-to reply-id)))
  189. (mapc #'(lambda (r) (send-response chat-id r reply-id)) response))
  190. (telegram-send-message chat-id response :reply-to reply-id)))
  191. (defun bot-send-message (chat-id text &key parse-mode disable-web-preview disable-notification reply-to reply-markup)
  192. (handler-case (telegram-send-message chat-id text :parse-mode parse-mode
  193. :disable-web-preview disable-web-preview
  194. :disable-notification disable-notification
  195. :reply-to reply-to
  196. :reply-markup reply-markup)
  197. (error (e)
  198. (log:error e))))