chatikbot/telegram.lisp

(in-package #:chatikbot)

(defvar *telegram-token* nil "Telegram bot token")
(defparameter +telegram-api-format+ "https://api.telegram.org/bot~A/~A")
(defparameter +telegram-file-format+ "https://api.telegram.org/file/bot~A/~A")
(defvar *telegram-timeout* 30 "Default Telegram timeout")

(defun %telegram-api-call (method &optional args)
  (let* ((params (loop for (k . v) in args when v
                    collect (cons
                             (princ-to-string k)
                             (if (pathnamep v) v
                                 (princ-to-string v)))))
         (timeout (+ 5 (or (aget "timeout" args)
                           *telegram-timeout*)))
         (response
          (handler-case
              (bordeaux-threads:with-timeout (timeout)
                (json-request (format nil +telegram-api-format+
                                      *telegram-token* method)
                              :method :post
                              :parameters params))
            (bordeaux-threads:timeout () (error "Timeout")))))
    (unless (aget "ok" response)
      (error (aget "description" response)))
    (aget "result" response)))

(defun telegram-get-updates (&key offset limit timeout)
  (%telegram-api-call
   "getUpdates"
   (list (cons "offset" offset)
         (cons "limit" limit)
         (cons "timeout" timeout))))

(defun telegram-get-me ()
  (%telegram-api-call "getMe"))

(defun telegram-set-webhook (&optional url certificate)
  (%telegram-api-call "setWebhook" (list (cons "url" url) (cons "certificate" certificate))))

(defun telegram-send-message (chat-id text &key parse-mode disable-web-preview reply-to reply-markup)
  (%telegram-api-call
   "sendMessage"
   (list (cons "chat_id" chat-id)
         (cons "text" text)
         (cons "parse_mode" parse-mode)
         (cons "disable_web_page_preview" disable-web-preview)
         (cons "reply_to_message_id" reply-to)
         (cons "reply_markup" reply-markup))))

(defun telegram-forward-message (chat-id from-chat-id message-id)
  (%telegram-api-call
   "forwardMessage"
   `(("chat_id" . ,chat-id)
     ("from_chat_id" . ,from-chat-id)
     ("message_id" . ,message-id))))

(defun telegram-send-photo (chat-id photo &key caption reply-to reply-markup)
  (%telegram-api-call
   "sendPhoto"
   (list (cons "chat_id" chat-id)
         (cons "photo" photo)
         (cons "caption" caption)
         (cons "reply_to_message_id" reply-to)
         (cons "reply_markup" reply-markup))))

(defun telegram-send-audio (chat-id audio &key duration performer title reply-to reply-markup)
  (%telegram-api-call
   "sendAudio"
   (list (cons "chat_id" chat-id)
         (cons "audio" audio)
         (cons "duration" duration)
         (cons "performer" performer)
         (cons "title" title)
         (cons "reply_to_message_id" reply-to)
         (cons "reply_markup" reply-markup))))

(defun telegram-send-document (chat-id document &key reply-to reply-markup)
  (%telegram-api-call
   "sendDocument"
   (list (cons "chat_id" chat-id)
         (cons "document" document)
         (cons "reply_to_message_id" reply-to)
         (cons "reply_markup" reply-markup))))

(defun telegram-send-sticker (chat-id sticker &key reply-to reply-markup)
  (%telegram-api-call
   "sendSticker"
   (list (cons "chat_id" chat-id)
         (cons "sticker" sticker)
         (cons "reply_to_message_id" reply-to)
         (cons "reply_markup" reply-markup))))

(defun telegram-send-video (chat-id video &key duration caption reply-to reply-markup)
  (%telegram-api-call
   "sendVideo"
   (list (cons "chat_id" chat-id)
         (cons "video" video)
         (cons "duration" duration)
         (cons "caption" caption)
         (cons "reply_to_message_id" reply-to)
         (cons "reply_markup" reply-markup))))

(defun telegram-send-voice (chat-id voice &key duration reply-to reply-markup)
  (%telegram-api-call
   "sendVoice"
   (list (cons "chat_id" chat-id)
         (cons "voice" voice)
         (cons "duration" duration)
         (cons "reply_to_message_id" reply-to)
         (cons "reply_markup" reply-markup))))

(defun telegram-send-location (chat-id latitude longitude &key reply-to reply-markup)
  (%telegram-api-call
   "sendLocation"
   (list (cons "chat_id" chat-id)
         (cons "latitude" latitude)
         (cons "longitude" longitude)
         (cons "reply_to_message_id" reply-to)
         (cons "reply_markup" reply-markup))))

(defun telegram-send-chat-action (chat-id action)
  (%telegram-api-call
   "sendChatAction"
   (list (cons "chat_id" chat-id)
         (cons "action" action))))

(defun telegram-get-user-profile-photos (user-id &key offset limit)
  (%telegram-api-call
   "getUserProfilePhotos"
   `(("user_id" . ,user-id) ("offset" . ,offset) ("limit" . ,limit))))

(defun telegram-get-file (file-id)
  (%telegram-api-call "getFile" `(("file_id" . ,file-id))))

(defun telegram-file-contents (file-id)
  (let* ((file (telegram-get-file file-id))
         (file-path (aget "file_path" file))
         (file-url (format nil +telegram-file-format+ *telegram-token* file-path)))
    (drakma:http-request file-url :force-binary t :decode-content t)))

;; Simplified interface
;;
(defun send-response (chat-id response &optional reply-id)
  (if (consp response)
      (if (keywordp (car response))
          (case (car response)
            (:text (telegram-send-message chat-id (cdr response) :reply-to reply-id))
            (:voice (telegram-send-voice chat-id (cdr response) :reply-to reply-id))
            (:sticker (telegram-send-sticker chat-id (cdr response) :reply-to reply-id)))
          (mapc #'(lambda (r) (send-response chat-id r reply-id)) response))
      (telegram-send-message chat-id response :reply-to reply-id)))

(defun bot-send-message (chat-id text &key parse-mode disable-web-preview reply-to reply-markup)
  (handler-case (telegram-send-message chat-id text :parse-mode parse-mode
                                       :disable-web-preview disable-web-preview
                                       :reply-to reply-to
                                       :reply-markup reply-markup)
    (error (e)
      (log:error e))))