chatikbot/telegram.lisp

(in-package :cl-user)
(defpackage chatikbot.telegram
  (:use :cl :chatikbot.utils)
  (:export :*telegram-token*
           :+telegram-max-callback-data-length+
           :telegram-get-updates
           :telegram-get-me
           :telegram-set-webhook
           :telegram-send-message
           :telegram-forward-message
           :telegram-send-photo
           :telegram-send-audio
           :telegram-send-document
           :telegram-send-sticker
           :telegram-send-video
           :telegram-send-voice
           :telegram-send-location
           :telegram-send-chat-action
           :telegram-send-get-user-profile-photos
           :telegram-send-get-file
           :telegram-answer-callback-query
           :telegram-edit-message-text
           :telegram-edit-message-caption
           :telegram-edit-message-reply-markup
           :telegram-delete-message
           :telegram-answer-inline-query
           :telegram-file-contents
           :telegram-inline-keyboard-markup
           :telegram-reply-keyboard-markup
           :telegram-reply-keyboard-hide
           :telegram-force-reply
           :send-response
           :bot-send-message))
(in-package :chatikbot.telegram)

(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")
(defparameter +telegram-max-callback-data-length+ 64)
(defvar *telegram-timeout* 30 "Default Telegram timeout")

(defun %telegram-api-call (method &optional args)
  (handler-case
      (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
              (json-request (format nil +telegram-api-format+
                                    *telegram-token* method)
                            :method :post
                            :content params
                            :timeout timeout)))
        (unless (aget "ok" response)
          (error (aget "description" response)))
        (aget "result" response))
    (dex:http-request-forbidden (e)
      (log:info "Forbidden" e))))

(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 disable-notification 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 "disable_notification" disable-notification)
         (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"
   (list (cons "user_id" user-id)
         (cons "offset" offset)
         (cons "limit" limit))))

(defun telegram-get-file (file-id)
  (%telegram-api-call "getFile" (list (cons "file_id" file-id))))

(defun telegram-answer-callback-query (query-id &key text show-alert)
  (%telegram-api-call
   "answerCallbackQuery"
   (list (cons "callback_query_id" query-id)
         (cons "text" text)
         (cons "show_alert" show-alert))))

(defun telegram-edit-message-text (text &key chat-id message-id inline-message-id parse-mode disable-web-preview reply-markup)
  (%telegram-api-call
   "editMessageText"
   (list (cons "chat_id" chat-id)
         (cons "message_id" message-id)
         (cons "inline_message_id" inline-message-id)
         (cons "text" text)
         (cons "parse_mode" parse-mode)
         (cons "disable_web_page_preview" disable-web-preview)
         (cons "reply_markup" reply-markup))))

(defun telegram-edit-message-caption (caption &key chat-id message-id inline-message-id reply-markup)
  (%telegram-api-call
   "editMessageCaption"
   (list (cons "chat_id" chat-id)
         (cons "message_id" message-id)
         (cons "inline_message_id" inline-message-id)
         (cons "caption" caption)
         (cons "reply_markup" reply-markup))))

(defun telegram-edit-message-reply-markup (reply-markup &key chat-id message-id inline-message-id)
  (%telegram-api-call
   "editMessageReplyMarkup"
   (list (cons "chat_id" chat-id)
         (cons "message_id" message-id)
         (cons "inline_message_id" inline-message-id)
         (cons "reply_markup" reply-markup))))

(defun telegram-delete-message (chat-id message-id)
  (%telegram-api-call
   "deleteMessage" (list (cons "chat_id" chat-id)
                         (cons "message_id" message-id))))

(defun telegram-answer-inline-query (query-id results &key cache-time is-personal next-offset switch-pm-text switch-pm-parameter)
  (%telegram-api-call
   "answerInlineQuery"
   (list (cons "inline_query_id" query-id)
         (cons "results" (plist-json results))
         (cons "cache_time" cache-time)
         (cons "is_personal" is-personal)
         (cons "next_offset" next-offset)
         (cons "switch_pm_text" switch-pm-text)
         (cons "switch_pm_parameter" switch-pm-parameter))))

(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)))
    (http-request file-url :force-binary t)))

(defun telegram-inline-keyboard-markup (inline-keyboard)
  (when inline-keyboard
    (plist-json
     (list :inline-keyboard inline-keyboard))))

(defun telegram-reply-keyboard-markup (keyboard &key resize-keyboard one-time-keyboard selective)
  (when keyboard
    (plist-json
     (list :keyboard keyboard
           :resize-keyboard resize-keyboard
           :one-time-keyboard one-time-keyboard
           :selective selective))))

(defun telegram-reply-keyboard-hide (&optional selective)
  (plist-json (list :hide-keyboard t :selective selective)))

(defun telegram-force-reply (&optional selective)
  (plist-json (list :force-reply t :selective selective)))

;; 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 disable-notification reply-to reply-markup)
  (handler-case (telegram-send-message chat-id text :parse-mode parse-mode
                                       :disable-web-preview disable-web-preview
                                       :disable-notification disable-notification
                                       :reply-to reply-to
                                       :reply-markup reply-markup)
    (error (e)
      (log:error e))))