telegram.lisp 5.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150
  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-send-message (chat-id text &key parse-mode disable-web-preview reply-to reply-markup)
  33. (%telegram-api-call
  34. "sendMessage"
  35. (list (cons "chat_id" chat-id)
  36. (cons "text" text)
  37. (cons "parse_mode" parse-mode)
  38. (cons "disable_web_page_preview" disable-web-preview)
  39. (cons "reply_to_message_id" reply-to)
  40. (cons "reply_markup" reply-markup))))
  41. (defun telegram-forward-message (chat-id from-chat-id message-id)
  42. (%telegram-api-call
  43. "forwardMessage"
  44. `(("chat_id" . ,chat-id)
  45. ("from_chat_id" . ,from-chat-id)
  46. ("message_id" . ,message-id))))
  47. (defun telegram-send-photo (chat-id photo &key caption reply-to reply-markup)
  48. (%telegram-api-call
  49. "sendPhoto"
  50. (list (cons "chat_id" chat-id)
  51. (cons "photo" photo)
  52. (cons "caption" caption)
  53. (cons "reply_to_message_id" reply-to)
  54. (cons "reply_markup" reply-markup))))
  55. (defun telegram-send-audio (chat-id audio &key duration performer title reply-to reply-markup)
  56. (%telegram-api-call
  57. "sendAudio"
  58. (list (cons "chat_id" chat-id)
  59. (cons "audio" audio)
  60. (cons "duration" duration)
  61. (cons "performer" performer)
  62. (cons "title" title)
  63. (cons "reply_to_message_id" reply-to)
  64. (cons "reply_markup" reply-markup))))
  65. (defun telegram-send-document (chat-id document &key reply-to reply-markup)
  66. (%telegram-api-call
  67. "sendDocument"
  68. (list (cons "chat_id" chat-id)
  69. (cons "document" document)
  70. (cons "reply_to_message_id" reply-to)
  71. (cons "reply_markup" reply-markup))))
  72. (defun telegram-send-sticker (chat-id sticker &key reply-to reply-markup)
  73. (%telegram-api-call
  74. "sendSticker"
  75. (list (cons "chat_id" chat-id)
  76. (cons "sticker" sticker)
  77. (cons "reply_to_message_id" reply-to)
  78. (cons "reply_markup" reply-markup))))
  79. (defun telegram-send-video (chat-id video &key duration caption reply-to reply-markup)
  80. (%telegram-api-call
  81. "sendVideo"
  82. (list (cons "chat_id" chat-id)
  83. (cons "video" video)
  84. (cons "duration" duration)
  85. (cons "caption" caption)
  86. (cons "reply_to_message_id" reply-to)
  87. (cons "reply_markup" reply-markup))))
  88. (defun telegram-send-voice (chat-id voice &key duration reply-to reply-markup)
  89. (%telegram-api-call
  90. "sendVoice"
  91. (list (cons "chat_id" chat-id)
  92. (cons "voice" voice)
  93. (cons "duration" duration)
  94. (cons "reply_to_message_id" reply-to)
  95. (cons "reply_markup" reply-markup))))
  96. (defun telegram-send-location (chat-id latitude longitude &key reply-to reply-markup)
  97. (%telegram-api-call
  98. "sendLocation"
  99. (list (cons "chat_id" chat-id)
  100. (cons "latitude" latitude)
  101. (cons "longitude" longitude)
  102. (cons "reply_to_message_id" reply-to)
  103. (cons "reply_markup" reply-markup))))
  104. (defun telegram-send-chat-action (chat-id action)
  105. (%telegram-api-call
  106. "sendChatAction"
  107. (list (cons "chat_id" chat-id)
  108. (cons "action" action))))
  109. (defun telegram-get-user-profile-photos (user-id &key offset limit)
  110. (%telegram-api-call
  111. "getUserProfilePhotos"
  112. `(("user_id" . ,user-id) ("offset" . ,offset) ("limit" . ,limit))))
  113. (defun telegram-get-file (file-id)
  114. (%telegram-api-call "getFile" `(("file_id" . ,file-id))))
  115. ;; Simplified interface
  116. ;;
  117. (defun send-response (chat-id response &optional reply-id)
  118. (if (consp response)
  119. (if (keywordp (car response))
  120. (case (car response)
  121. (:text (telegram-send-message chat-id (cdr response) :reply-to reply-id))
  122. (:voice (telegram-send-voice chat-id (cdr response) :reply-to reply-id))
  123. (:sticker (telegram-send-sticker chat-id (cdr response) :reply-to reply-id)))
  124. (mapc #'(lambda (r) (send-response chat-id r reply-id)) response))
  125. (telegram-send-message chat-id response :reply-to reply-id)))
  126. (defun bot-send-message (chat-id text &key parse-mode disable-web-preview reply-to reply-markup)
  127. (handler-case (telegram-send-message chat-id text :parse-mode parse-mode
  128. :disable-web-preview disable-web-preview
  129. :reply-to reply-to
  130. :reply-markup reply-markup)
  131. (error (e)
  132. (log:error e))))