telegram.lisp 5.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153
  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. (defvar *telegram-timeout* 30 "Default Telegram timeout")
  5. (defun %telegram-api-call (method &optional args)
  6. (let* ((params (loop for (k . v) in args when v
  7. collect (cons
  8. (princ-to-string k)
  9. (if (pathnamep v) v
  10. (princ-to-string v)))))
  11. (timeout (+ 5 (or (aget "timeout" args)
  12. *telegram-timeout*)))
  13. (response
  14. (handler-case
  15. (bordeaux-threads:with-timeout (timeout)
  16. (json-request (format nil +telegram-api-format+
  17. *telegram-token* method)
  18. :method :post
  19. :parameters params))
  20. (bordeaux-threads:timeout () (error "Timeout")))))
  21. (unless (aget "ok" response)
  22. (error (aget "description" response)))
  23. (aget "result" response)))
  24. (defun telegram-get-updates (&key offset limit timeout)
  25. (%telegram-api-call
  26. "getUpdates"
  27. (list (cons "offset" offset)
  28. (cons "limit" limit)
  29. (cons "timeout" timeout))))
  30. (defun telegram-get-me ()
  31. (%telegram-api-call "getMe"))
  32. (defun telegram-set-webhook (&optional url certificate)
  33. (%telegram-api-call "setWebhook" (list (cons "url" url) (cons "certificate" certificate))))
  34. (defun telegram-send-message (chat-id text &key parse-mode disable-web-preview reply-to reply-markup)
  35. (%telegram-api-call
  36. "sendMessage"
  37. (list (cons "chat_id" chat-id)
  38. (cons "text" text)
  39. (cons "parse_mode" parse-mode)
  40. (cons "disable_web_page_preview" disable-web-preview)
  41. (cons "reply_to_message_id" reply-to)
  42. (cons "reply_markup" reply-markup))))
  43. (defun telegram-forward-message (chat-id from-chat-id message-id)
  44. (%telegram-api-call
  45. "forwardMessage"
  46. `(("chat_id" . ,chat-id)
  47. ("from_chat_id" . ,from-chat-id)
  48. ("message_id" . ,message-id))))
  49. (defun telegram-send-photo (chat-id photo &key caption reply-to reply-markup)
  50. (%telegram-api-call
  51. "sendPhoto"
  52. (list (cons "chat_id" chat-id)
  53. (cons "photo" photo)
  54. (cons "caption" caption)
  55. (cons "reply_to_message_id" reply-to)
  56. (cons "reply_markup" reply-markup))))
  57. (defun telegram-send-audio (chat-id audio &key duration performer title reply-to reply-markup)
  58. (%telegram-api-call
  59. "sendAudio"
  60. (list (cons "chat_id" chat-id)
  61. (cons "audio" audio)
  62. (cons "duration" duration)
  63. (cons "performer" performer)
  64. (cons "title" title)
  65. (cons "reply_to_message_id" reply-to)
  66. (cons "reply_markup" reply-markup))))
  67. (defun telegram-send-document (chat-id document &key reply-to reply-markup)
  68. (%telegram-api-call
  69. "sendDocument"
  70. (list (cons "chat_id" chat-id)
  71. (cons "document" document)
  72. (cons "reply_to_message_id" reply-to)
  73. (cons "reply_markup" reply-markup))))
  74. (defun telegram-send-sticker (chat-id sticker &key reply-to reply-markup)
  75. (%telegram-api-call
  76. "sendSticker"
  77. (list (cons "chat_id" chat-id)
  78. (cons "sticker" sticker)
  79. (cons "reply_to_message_id" reply-to)
  80. (cons "reply_markup" reply-markup))))
  81. (defun telegram-send-video (chat-id video &key duration caption reply-to reply-markup)
  82. (%telegram-api-call
  83. "sendVideo"
  84. (list (cons "chat_id" chat-id)
  85. (cons "video" video)
  86. (cons "duration" duration)
  87. (cons "caption" caption)
  88. (cons "reply_to_message_id" reply-to)
  89. (cons "reply_markup" reply-markup))))
  90. (defun telegram-send-voice (chat-id voice &key duration reply-to reply-markup)
  91. (%telegram-api-call
  92. "sendVoice"
  93. (list (cons "chat_id" chat-id)
  94. (cons "voice" voice)
  95. (cons "duration" duration)
  96. (cons "reply_to_message_id" reply-to)
  97. (cons "reply_markup" reply-markup))))
  98. (defun telegram-send-location (chat-id latitude longitude &key reply-to reply-markup)
  99. (%telegram-api-call
  100. "sendLocation"
  101. (list (cons "chat_id" chat-id)
  102. (cons "latitude" latitude)
  103. (cons "longitude" longitude)
  104. (cons "reply_to_message_id" reply-to)
  105. (cons "reply_markup" reply-markup))))
  106. (defun telegram-send-chat-action (chat-id action)
  107. (%telegram-api-call
  108. "sendChatAction"
  109. (list (cons "chat_id" chat-id)
  110. (cons "action" action))))
  111. (defun telegram-get-user-profile-photos (user-id &key offset limit)
  112. (%telegram-api-call
  113. "getUserProfilePhotos"
  114. `(("user_id" . ,user-id) ("offset" . ,offset) ("limit" . ,limit))))
  115. (defun telegram-get-file (file-id)
  116. (%telegram-api-call "getFile" `(("file_id" . ,file-id))))
  117. ;; Simplified interface
  118. ;;
  119. (defun send-response (chat-id response &optional reply-id)
  120. (if (consp response)
  121. (if (keywordp (car response))
  122. (case (car response)
  123. (:text (telegram-send-message chat-id (cdr response) :reply-to reply-id))
  124. (:voice (telegram-send-voice chat-id (cdr response) :reply-to reply-id))
  125. (:sticker (telegram-send-sticker chat-id (cdr response) :reply-to reply-id)))
  126. (mapc #'(lambda (r) (send-response chat-id r reply-id)) response))
  127. (telegram-send-message chat-id response :reply-to reply-id)))
  128. (defun bot-send-message (chat-id text &key parse-mode disable-web-preview reply-to reply-markup)
  129. (handler-case (telegram-send-message chat-id text :parse-mode parse-mode
  130. :disable-web-preview disable-web-preview
  131. :reply-to reply-to
  132. :reply-markup reply-markup)
  133. (error (e)
  134. (log:error e))))