1
0

telegram.lisp 8.8 KB

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