chatikbot/plugins/transmission.lisp

(in-package :cl-user)
(defpackage chatikbot.plugins.transmission
  (:use :cl :chatikbot.common))
(in-package :chatikbot.plugins.transmission)

(defsetting *transmission-settings* nil "ALIST of (chat-id . url)")
(defsetting *transmission-locations* nil "ALIST of (name . location)")
(defsetting *transmission-monitor* nil "LIST of chat-ids where to send status updates")

(defvar *transmission-sessions* nil "ALIST of (url . x-transmission-session-id)")

(defun transmission-get-session (url)
  (multiple-value-bind (body status headers)
      (handler-bind ((dex:http-request-conflict #'dex:ignore-and-continue))
        (http-request url))
    (declare (ignore body status))
    (gethash "x-transmission-session-id" headers)))

(defun transmission-set-session (url session-id)
  (setf *transmission-sessions*
    (cons (cons url session-id)
          (remove url *transmission-sessions* :test #'equal :key #'car))))

(defun transmission-request (url method &rest arguments)
  (let ((retries (getf arguments :retries 0)))
    (when (> retries 5)
      (error "Too many retries"))
    (remf arguments :retries)
    (let ((session-id (aget url *transmission-sessions*))
      (content
       (with-output-to-string (stream)
         (yason:encode (alexandria:plist-hash-table
                (list "method" (dekeyify method t)
                  "arguments" (alexandria:plist-hash-table
                           (loop for (key value) on arguments by #'cddr
                          when value
                          appending (list (dekeyify key) value)))))
               stream))))
      (handler-case
      (let* ((response (json-request url :method :post :content content
                     :headers (list (cons :x-transmission-session-id session-id))))
         (result (aget "result" response)))
        (unless (equal "success" result)
          (error result))
        (aget "arguments" response))
    (dex:http-request-conflict (e)
      (transmission-set-session url (gethash "x-transmission-session-id" (dex:response-headers e)))
      (apply #'transmission-request url method :retries (1+ retries) arguments))))))

(defun transmission-get-torrents (url &optional ids (fields '("id" "name" "status" "percentDone" "eta" "totalSize")))
  (aget "torrents" (transmission-request url :torrent-get :ids ids :fields fields)))

(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" (or (aget "torrent-added" torrent-added)
                                                             (aget "torrent-duplicate" torrent-added))))))))

(defun %format-torrent-status (status)
  (case status
    (0 "⏹") ;; Stopped
    (1 "🔂") ;; Check wait
    (2 "🔁") ;; Check
    (3 "⏸") ;; Queued to download
    (4 "▶️") ;; Downloading
    (5 "⏸") ;; Queued to seed
    (6 "⏺") ;; Seeding
    ))

(defun %format-torrent (torrent)
  (let ((eta (aget "eta" torrent)))
    (format nil "~A ~A ~A (~A)~:[~; (~A%~@[, eta ~A~])~]"
            (aget "id" torrent)
            (%format-torrent-status (aget "status" torrent))
            (aget "name" torrent)
            (format-size (aget "totalSize" torrent))
            (eq 4 (aget "status" torrent))
            (smart-f (* 100 (aget "percentDone" torrent)) 1)
            (when (not (= -1 eta)) (format-interval eta)))))

;; Command handlers
(def-message-cmd-handler handle-torrents (:torrents)
  (let ((url (aget *chat-id* *transmission-settings*)))
    (if url
        (let ((torrents (transmission-get-torrents url)))
          (bot-send-message (if torrents (format nil "~{~A~^~%~}" (mapcar #'%format-torrent torrents))
                                "Пустой список!")))
        (bot-send-message "Бота настрой!"))))

(defun %torrent-add-and-respond (&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 (%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 ()
  (alexandria:when-let (magnet (ppcre:scan-to-strings +magnet-regex+ *text*))
    (%torrent-add-and-respond :filename magnet)))

(def-message-handler handle-torrent ()
  (alexandria:when-let* ((url (aget *chat-id* *transmission-settings*))
                         (doc (aget "document" *message*))
                         (file-name (aget "file_name" doc))
                         (file-id (aget "file_id" doc)))
    (when (and (equal "torrent" (pathname-type (pathname file-name)))
               (< (aget "file_size" doc) (* 512 1024)))
      (%torrent-add-and-respond :metainfo (cl-base64:usb8-array-to-base64-string
                                           (telegram-file-contents file-id))))))

;; Callback handlers
(defun %handle-torrent-move (torrent-id name)
  (alexandria:when-let* ((url (aget *source-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 (parse-integer id) val)))))

;; Cron
(defvar *transmission-last-results* (make-hash-table) "Last check results for each chat-id")
(defcron process-transmission ()
  (dolist (*chat-id* *transmission-monitor*)
    (alexandria:when-let (url (aget *chat-id* *transmission-settings*))
      (let ((old-result (gethash *chat-id* *transmission-last-results*))
            (new-result (loop for torrent in (transmission-get-torrents url nil '("id" "status"))
                           collect (cons (aget "id" torrent) (aget "status" torrent)))))
        (when old-result
          (alexandria:when-let (updated (mapcar #'car (set-difference new-result old-result :test #'equal)))
            (bot-send-message (format nil "~{~A~^~%~}"
                                      (mapcar #'%format-torrent
                                              (transmission-get-torrents url updated))))))
        (setf (gethash *chat-id* *transmission-last-results*) new-result)))))