Extend telegram api support

chatikbot.asd

@@ -14,6 +14,7 @@
                #:drakma
                #:flexi-streams
                #:hunchentoot
+               #:ironclad
                #:local-time
                #:log4cl
                #:plump

telegram.lisp

@@ -38,13 +38,14 @@
 (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)
+(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))))
 
@@ -128,10 +129,58 @@
 (defun telegram-get-user-profile-photos (user-id &key offset limit)
   (%telegram-api-call
    "getUserProfilePhotos"
-   `(("user_id" . ,user-id) ("offset" . ,offset) ("limit" . ,limit))))
+   (list (cons "user_id" user-id)
+         (cons "offset" offset)
+         (cons "limit" limit))))
 
 (defun telegram-get-file (file-id)
-  (%telegram-api-call "getFile" `(("file_id" . ,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-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))
@@ -139,6 +188,23 @@
          (file-url (format nil +telegram-file-format+ *telegram-token* file-path)))
     (drakma:http-request file-url :force-binary t :decode-content t)))
 
+(defun telegram-inline-keyboard-markup (inline-keyboard)
+  (plist-json
+    (list :inline-keyboard inline-keyboard)))
+
+(defun telegram-reply-keyboard-markup (keyboard &key resize-keyboard one-time-keyboard selective)
+  (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)
@@ -151,9 +217,10 @@
           (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)
+(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)

utils.lisp

@@ -207,6 +207,32 @@ is replaced with replacement."
            (values (yason:parse stream :object-as object-as) uri))
       (ignore-errors (close http-stream)))))
 
+(defun plist-hash (plist &optional skip-nil (format-key #'identity) &rest hash-table-initargs)
+  (cond
+    ((and (consp plist) (keywordp (car plist)))
+     (let ((table (apply #'make-hash-table hash-table-initargs)))
+       (do ((tail plist (cddr tail)))
+           ((not tail))
+         (let ((key (funcall format-key (car tail)))
+               (value (cadr tail)))
+           (when (or value (not skip-nil))
+             (setf (gethash key table)
+                   (if (listp value)
+                       (apply #'plist-hash value skip-nil format-key hash-table-initargs)
+                       value)))))
+       table))
+    ((consp plist)
+     (loop for item in plist collect (apply #'plist-hash item skip-nil format-key hash-table-initargs)))
+    (:default plist)))
+
+(defmethod yason:encode ((object (eql 'f)) &optional (stream *standard-output*))
+  (write-string "false" stream)
+  object)
+
+(defun plist-json (plist)
+  (with-output-to-string (stream)
+    (yason:encode (plist-hash plist t #'dekeyify) stream)))
+
 (defun format-ts (ts)
   (local-time:format-timestring nil ts
                                 :format '(:year "-" (:month 2) "-" (:day 2) " "
@@ -237,6 +263,34 @@ is replaced with replacement."
     ((< seconds (* 60 60 24 7 54)) (format nil "~A weeks" (round seconds (* 60 60 24 7))))
     (:otherwise (format nil "~A years" (smart-f (/ seconds (* 60 60 24 365.25)) 1)))))
 
+(defun token-hmac (message &optional (hmac-length 12))
+  (let ((hmac (crypto:make-hmac (crypto:ascii-string-to-byte-array *telegram-token*) :sha256)))
+    (crypto:update-hmac hmac (crypto:ascii-string-to-byte-array message))
+    (base64:usb8-array-to-base64-string
+     (subseq (crypto:hmac-digest hmac) 0 hmac-length))))
+
+(defun encode-callback-data (chat-id section data &optional (ttl 600) (hmac-length 12))
+  (let ((message (format nil "~A:~A:~A:~A"
+                         (base64:integer-to-base64-string chat-id) section data
+                         (base64:integer-to-base64-string
+                          (+ ttl (local-time:timestamp-to-universal (local-time:now)))))))
+    (format nil "~A$~A"
+            message (token-hmac message hmac-length))))
+
+(defun decode-callback-data (chat-id raw-data &optional (hmac-length 12))
+  (destructuring-bind (message hmac)
+      (split-sequence:split-sequence #\$ raw-data :from-end t :count 2)
+    (destructuring-bind (cid section data expire)
+        (split-sequence:split-sequence #\: message)
+      (unless (= chat-id (base64:base64-string-to-integer cid))
+        (error "Wrong chat id."))
+      (unless (>= (base64:base64-string-to-integer expire)
+                  (local-time:timestamp-to-universal (local-time:now)))
+        (error "Expired."))
+      (unless (equal hmac (token-hmac message hmac-length))
+        (error "Bad data."))
+      (values data section))))
+
 (defmacro def-message-handler (name (message) &body body)
   `(progn
      (defun ,name (,message)