Transmission location inline keyboards

plugins/transmission.lisp

@@ -1,6 +1,7 @@
 (in-package #:chatikbot)
 
 (defsetting *transmission-settings* nil "ALIST of (chat-id . url)")
+(defsetting *transmission-locations* nil "ALIST of (name . location)")
 
 (defvar *transmission-sessions* nil "ALIST of (url . x-transmission-session-id)")
 
@@ -49,7 +50,8 @@
 
 (defun transmission-add-torrent (url &key filename metainfo)
   (let ((torrent-added (transmission-request url :torrent-add :filename filename :metainfo metainfo)))
-   (car (transmission-get-torrents url (list (aget "id" (aget "torrent-added" torrent-added)))))))
+    (car (transmission-get-torrents url (list (aget "id" (or (aget "torrent-added" torrent-added)
+                                                             (aget "torrent-duplicate" torrent-added))))))))
 
 (defun %format-torrent-status (status)
   (case status
@@ -81,12 +83,23 @@
                                                            (transmission-get-torrents url))))
         (bot-send-message chat-id "Бота настрой!"))))
 
-(defparameter +magnet-regex+ (ppcre:create-scanner "magnet:\\?\\S+"))
+(defun %torrent-add-and-respond (chat-id &key filename metainfo)
+  (alexandria:when-let (url (aget chat-id *transmission-settings*))
+    (let* ((new-torrent (transmission-add-torrent url :filename filename :metainfo metainfo))
+           (markup (loop for (name . location) in *transmission-locations*
+                      collect (list :text (format nil "💾 ~A" name)
+                                    :callback-data (encode-callback-data
+                                                    chat-id :tm
+                                                    (format nil "l-~A-~A" name
+                                                            (aget "id" new-torrent))
+                                                    86400)))))
+      (bot-send-message chat-id (%format-torrent new-torrent)
+                        :reply-markup (and markup (telegram-inline-keyboard-markup (list markup)))))))
 
+(defparameter +magnet-regex+ (ppcre:create-scanner "magnet:\\?\\S+"))
 (def-message-handler handle-magnet (message)
-  (alexandria:when-let* ((url (aget chat-id *transmission-settings*))
-                         (magnet (ppcre:scan-to-strings +magnet-regex+ text)))
-    (bot-send-message chat-id (%format-torrent (transmission-add-torrent url :filename magnet)))))
+  (alexandria:when-let (magnet (ppcre:scan-to-strings +magnet-regex+ text))
+    (%torrent-add-and-respond chat-id :filename magnet)))
 
 (def-message-handler handle-torrent (message)
   (alexandria:when-let* ((url (aget chat-id *transmission-settings*))
@@ -95,5 +108,20 @@
                          (file-id (aget "file_id" doc)))
     (when (and (equal "torrent" (pathname-type (pathname file-name)))
                (< (aget "file_size" doc) (* 512 1024)))
-      (let ((contents (telegram-file-content file-id)))
-        (bot-send-message chat-id (%format-torrent (transmission-add-torrent url :metainfo (cl-base64:usb8-array-to-base64-string contents))))))))
+      (%torrent-add-and-respond chat-id :metainfo (cl-base64:usb8-array-to-base64-string
+                                                   (telegram-file-contents file-id))))))
+
+(defun %handle-torrent-move (query-id chat-id torrent-id name)
+  (alexandria:when-let* ((url (aget chat-id *transmission-settings*))
+                         (location (aget name *transmission-locations*)))
+    (transmission-request url :torrent-set-location
+                          :ids torrent-id
+                          :location location
+                          :move t)
+    (telegram-answer-callback-query query-id :text (format nil "Moved to '~A'" location))))
+
+(def-callback-section-handler cb-handle-tm (:tm)
+  (destructuring-bind (type val id)
+      (split-sequence:split-sequence #\- data :count 3)
+    (case (intern (string-upcase type) "KEYWORD")
+      (:l (%handle-torrent-move query-id chat-id (parse-integer id) val)))))

telegram.lisp

@@ -3,6 +3,7 @@
 (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)
@@ -189,15 +190,17 @@
     (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)))
+  (when 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)))
+  (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)))

utils.lisp

@@ -270,18 +270,23 @@ is replaced with replacement."
      (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))))
+  (when (find #\: data)
+    (error "Bad data."))
+  (let* ((message (format nil "~A:~A:~A:~A"
+                          (base64:integer-to-base64-string chat-id)
+                          (base64:integer-to-base64-string
+                           (+ ttl (local-time:timestamp-to-universal (local-time:now))))
+                          section data))
+         (encoded (format nil "~A$~A" message (token-hmac message hmac-length))))
+    (when (> (length encoded) +telegram-max-callback-data-length+)
+      (error "Max callback length exceeded"))
+    encoded))
 
 (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)
+    (destructuring-bind (cid expire section data)
+        (split-sequence:split-sequence #\: message :count 4)
       (unless (= chat-id (base64:base64-string-to-integer cid))
         (error "Wrong chat id."))
       (unless (>= (base64:base64-string-to-integer expire)
@@ -289,7 +294,7 @@ is replaced with replacement."
         (error "Expired."))
       (unless (equal hmac (token-hmac message hmac-length))
         (error "Bad data."))
-      (values data section))))
+      (values data (intern (string-upcase section) "KEYWORD")))))
 
 (defmacro def-message-handler (name (message) &body body)
   `(progn
@@ -326,6 +331,35 @@ is replaced with replacement."
            ,@body
            t)))))
 
+(defmacro def-callback-handler (name (callback) &body body)
+  `(progn
+     (defun ,name (,callback)
+       (let* ((query-id (aget "id" ,callback))
+              (from (aget "from" ,callback))
+              (raw-data (aget "data" ,callback))
+              (message (aget "message" ,callback))
+              (inline-message-id (aget "inline_message_id" ,callback))
+              (from-id (aget "id" from))
+              (chat-id (aget "id" (aget "chat" message)))
+              (message-id (aget "message_id" message)))
+         (declare (ignorable query-id from raw-data message inline-message-id from-id chat-id message-id))
+         (handler-case (progn ,@body)
+           (error (e)
+             (log:error "~A" e)
+             (bot-send-message (or chat-id from-id)
+                               (format nil "Ошибочка вышла~@[: ~A~]"
+                                       (when (member chat-id *admins*) e)))))))
+     (add-hook :update-callback-query ',name)))
+
+(defmacro def-callback-section-handler (name (&rest sections) &body body)
+  `(def-callback-handler ,name (callback)
+     (when chat-id
+       (multiple-value-bind (data section) (decode-callback-data chat-id raw-data)
+         (when (member section (list ,@sections))
+           (log:info query-id from-id chat-id message-id section data)
+           ,@body
+           t)))))
+
 ;; Schedule
 (defmacro defcron (name (&rest schedule) &body body)
   (let ((schedule (or schedule '(:minute '* :hour '*))))