[music] Allow add magnet through web hook

plugins/music.lisp

@@ -23,9 +23,9 @@
   (remf args :headers)
   (multiple-value-bind (body status headers uri)
       (handler-bind
-	  ((sb-int:broken-pipe #'(lambda (c) (declare (ignorable c))
-				   (invoke-restart (find-restart 'dexador:retry-request)))))
-	(apply #'http-request url :headers headers args))
+          ((sb-int:broken-pipe #'(lambda (c) (declare (ignorable c))
+                                   (invoke-restart (find-restart 'dexador:retry-request)))))
+        (apply #'http-request url :headers headers args))
     (unless (stringp body)
       (setf body (trivial-utf-8:utf-8-bytes-to-string body)))
     (values (jojo:parse body :as as) status headers uri)))
@@ -36,17 +36,17 @@
                                     :|method| ,method
                                     :|params| ,params))))
          (response (jojo-request *deluge-api* :method :post
-                                 :content content
-                                 :cookie-jar *cookies*))
+                                              :content content
+                                              :cookie-jar *cookies*))
          (error-message (getf (getf response :|error|) :|message|)))
     (if error-message
         (if (and (null is-auth)
                  (equal error-message "Not authenticated"))
             (progn
-	      (deluge-request "auth.login" (list *deluge-password*) t)
+              (deluge-request "auth.login" (list *deluge-password*) t)
               (deluge-request method params t)) ;; Retry original request
             (error (format nil "Deluge error: ~a" error-message)))
-        (getf response :|result|))))  
+        (getf response :|result|))))
 
 (defun infohash-magnet (info-hash)
   (concatenate 'string "magnet:?xt=urn:btih:" info-hash))
@@ -55,8 +55,8 @@
   (unless (listp info-hashes)
     (setf info-hashes (list info-hashes)))
   (let ((torrents (loop for ih in info-hashes
-                     collect (list :|path| (infohash-magnet ih)
-                                   :|options| '(:|add_paused| :true)))))
+                        collect (list :|path| (infohash-magnet ih)
+                                      :|options| '(:|add_paused| :true)))))
     (deluge-request "web.add_torrents" (list torrents))))
 
 (defun deluge-get-torrents ()
@@ -79,10 +79,10 @@
   (let* ((status (deluge-request "core.get_torrent_status" (list info-hash +deluge-default-status-fields+)))
          (save-path (getf status :|save_path|)))
     (loop for file in (getf status :|files|)
-       for prio in (getf status :|file_priorities|)
-       do (setf (getf file :|prio|) prio
-                (getf file :|path|) (pathname (raw-pathname (format nil "~A/~A" save-path (getf file :|path|)))))
-	  collect file)))
+          for prio in (getf status :|file_priorities|)
+          do (setf (getf file :|prio|) prio
+                   (getf file :|path|) (pathname (raw-pathname (format nil "~A/~A" save-path (getf file :|path|)))))
+          collect file)))
 
 (defun deluge-add-torrent-magnet (uri &optional options)
   (deluge-request "core.add_torrent_magnet" (list uri options)))
@@ -95,7 +95,7 @@
 
 (defparameter +media-exts+ '("mp3" "flac" "ac3"))
 (defun media-p (path)
-  (let* ((ext (subseq path (1+ (or (position #\. path :from-end t) (1- (length path)))))))
+  (let ((ext (subseq path (1+ (or (position #\. path :from-end t) (1- (length path)))))))
     (member (string-downcase ext) +media-exts+ :test #'equal)))
 
 (defun get-torrent-info (status)
@@ -122,13 +122,13 @@
   (labels ((f (fl) (getf info fl)))
     (format nil "[[🎶]] ~a *~a*, ~a альбомов с ~a треками. Весит ~a.~@[ Осталось ~a треков, ~a~]" action
             (f :name)
-	    (length (f :media-dirs))
-	    (f :wanted-files)
-	    (format-size (f :wanted-size))
-	    (when (and (f :wanted-files-left) (positive-integer-p (f :wanted-files-left)))
-	      (f :wanted-files-left))
-	    (when (and (f :wanted-size-left) (positive-integer-p (f :wanted-size-left)))
-	      (format-size (f :wanted-size-left))))))
+            (length (f :media-dirs))
+            (f :wanted-files)
+            (format-size (f :wanted-size))
+            (when (and (f :wanted-files-left) (positive-integer-p (f :wanted-files-left)))
+              (f :wanted-files-left))
+            (when (and (f :wanted-size-left) (positive-integer-p (f :wanted-size-left)))
+              (format-size (f :wanted-size-left))))))
 
 (defun get-root-paths (info)
   (let ((roots (delete-duplicates (loop for dir in (getf info :media-dirs)
@@ -151,7 +151,7 @@
 
 (defun deluge-get-seeding-torrents ()
   (loop for (torrent state) on (deluge-get-torrents-status '(:|state| "Seeding") '("name")) by #'cddr
-     collect (cons (string torrent) (getf state :|name|))))
+        collect (cons (string torrent) (getf state :|name|))))
 
 (defun deluge-pause-torrents (&rest torrents)
   (deluge-request "core.pause_torrent" (list torrents)))
@@ -160,12 +160,12 @@
   (let* ((status (deluge-request "core.get_torrent_status" (list torrent +deluge-default-status-fields+)))
          (save-path (getf status :|save_path|)))
     (loop for file in (getf status :|files|)
-       for prio in (getf status :|file_priorities|)
-       for path = (pathname (raw-pathname (format nil "~A/~A" save-path (getf file :|path|))))
-       when (zerop prio)
-       when (probe-file path)
-       do (if dry (format t "Deleting '~A'~%" path)
-              (uiop:delete-file-if-exists path)))))
+          for prio in (getf status :|file_priorities|)
+          for path = (pathname (raw-pathname (format nil "~A/~A" save-path (getf file :|path|))))
+          when (zerop prio)
+          when (probe-file path)
+          do (if dry (format t "Deleting '~A'~%" path)
+                 (uiop:delete-file-if-exists path)))))
 
 (defun send-notify (msg &optional dry)
   (if dry (format t "~a~%" msg)
@@ -186,28 +186,28 @@
     (run-import paths dry)
     (request-chad-music-rescan)
     (if dry (format t "Removing torrent ~a" ih)
-	(deluge-remove-torrent ih))))
+        (deluge-remove-torrent ih))))
 
 (defvar *slskd-bearer* nil)
 (defun slskd-request (path &key method parameters content is-auth)
   (let* ((content (when content (trivial-utf-8:string-to-utf-8-bytes
-				 (jojo:to-json content)))))
+                                 (jojo:to-json content)))))
     (handler-case (jojo-request (format nil "~a/~a" *slskd-api* path)
-				:bearer *slskd-bearer*
-				:method method				
+                                :bearer *slskd-bearer*
+                                :method method
                                 :content content
-				:parameters parameters)
+                                :parameters parameters)
       (dex:http-request-unauthorized ()
-	(unless is-auth
-	  (with-secret ((&optional username password) '(:slskd))
-	    (setf *slskd-bearer*
-		  (getf (slskd-request "session"
-				       :method :post
-                   		       :content `(:|username| ,username
-						   :|password| ,password)
-				       :is-auth t)
-			:|token|)))
-	  (slskd-request path :method method :parameters parameters :content content))))))
+        (unless is-auth
+          (with-secret ((&optional username password) '(:slskd))
+            (setf *slskd-bearer*
+                  (getf (slskd-request "session"
+                                       :method :post
+                                       :content `(:|username| ,username
+                                                   :|password| ,password)
+                                       :is-auth t)
+                        :|token|)))
+          (slskd-request path :method method :parameters parameters :content content))))))
 
 
 (defun slskd-get-download-directories ()
@@ -220,46 +220,46 @@
 (defun slskd-file-complete-error-p (file)
   (let ((state (getf file :|state|)))
     (and (not (slskd-file-succeeded-p file))
-	 (equal (subseq state 0 (min (length state) 11))
-		"Completed, "))))
+         (equal (subseq state 0 (min (length state) 11))
+                "Completed, "))))
 
 (defun slskd-download-file (file)
-  (jojo-request (format nil "~a/~a" *slskd-downloads-url* (getf file :|username|))
-		:method :post
-		:content (trivial-utf-8:string-to-utf-8-bytes
-			  (jojo:to-json `(:|filename| ,(getf file :|filename|)
-                                           :|size| ,(getf file :|size|))))))
+  (slskd-request (format nil "transfers/downloads/~a" (getf file :|username|))
+                 :method :post
+                 :content `(:|filename| ,(getf file :|filename|)
+                             :|size| ,(getf file :|size|))))
 
 (defun slskd-remove-download (file)
-  (jojo-request (format nil "~a/~a/~a" *slskd-downloads-url*
-			(getf file :|username|)
-			(getf file :|id|))
-		:method :delete
-		:parameters `(("remove" . "true"))))
+  (slskd-request (format nil "transfers/downloads/~a/~a"
+                         (getf file :|username|)
+                         (getf file :|id|))
+                 :method :delete
+                 :parameters `(("remove" . "true"))))
 
 (defun slskd-get-download-path (dir)
   (format nil "~a~a" *slskd-downloads-dir*
-	  (subseq (getf dir :|directory|)
-		  (1+ (position #\\ (getf dir :|directory|) :from-end t)))))
+          (subseq (getf dir :|directory|)
+                  (1+ (position #\\ (getf dir :|directory|) :from-end t)))))
+
 (defun get-slskd-dir-info (dir)
   (labels ((f (field)
              (getf dir field)))
     (multiple-value-bind (total-files total-files-left total-size total-size-left wanted-files wanted-files-left wanted-size wanted-size-left)
-	(loop for file in (f :|files|)
+        (loop for file in (f :|files|)
               for path = (getf file :|filename|)
-	      for file-left = (not (slskd-file-succeeded-p file))
-	      for size = (getf file :|size|)
-	      for size-left = (getf file :|bytesRemaining|)
-	      count file into total-files
-	      count file-left into total-files-left
-	      sum size into total-size
-	      sum size-left into total-size-left 
+              for file-left = (not (slskd-file-succeeded-p file))
+              for size = (getf file :|size|)
+              for size-left = (getf file :|bytesRemaining|)
+              count file into total-files
+              count file-left into total-files-left
+              sum size into total-size
+              sum size-left into total-size-left
               when (media-p path)
               count file into wanted-files and
-	      count file-left into wanted-files-left and
-	      sum size into wanted-size and
-	      sum size-left into wanted-size-left
-	      finally (return (values total-files total-files-left total-size total-size-left wanted-files wanted-files-left wanted-size wanted-size-left)))
+              count file-left into wanted-files-left and
+              sum size into wanted-size and
+              sum size-left into wanted-size-left
+              finally (return (values total-files total-files-left total-size total-size-left wanted-files wanted-files-left wanted-size wanted-size-left)))
       (list
        :name (f :|directory|)
        :save-path (slskd-get-download-path dir)
@@ -273,7 +273,6 @@
        :wanted-size-left wanted-size-left
        :media-dirs (list (f :|directory|))))))
 
-
 (defun slskd-download-complete-p (dir)
   (every #'slskd-file-succeeded-p (getf dir :|files|)))
 
@@ -283,19 +282,19 @@
     (when (some #'slskd-file-succeeded-p files)
       (loop for file in files
             when (slskd-file-complete-error-p file)
-              do (slskd-download-file file)))
+            do (slskd-download-file file)))
     ;; Import complete
     (when (every #'slskd-file-succeeded-p files)
       (send-notify (get-import-notify (get-slskd-dir-info dir) "Добавляем"))
       (run-import (slskd-get-download-path dir))
       (loop for file in files do (slskd-remove-download file))
       (request-chad-music-rescan))))
-  
+
 (defun process-imports ()
   (loop
     (loop for (ih . name) in (deluge-get-seeding-torrents)
-	  do (handler-case (process-downloaded-torrent ih)
-	       (error (c) (log:error "Error processing torrent" name c))))
+          do (handler-case (process-downloaded-torrent ih)
+               (error (c) (log:error "Error processing torrent" name c))))
     (loop for dir in (slskd-get-download-directories)
           do (handler-case (slskd-process-download-dir dir)
                (error (c) (log:error "Error processing slskd" c))))
@@ -320,41 +319,63 @@
 
 (defun handle-status ()
   (let* ((db-stats (when *chad-music-stats-url*
-		     (json-request *chad-music-stats-url*)))
-	 (stats (loop
-		 for (torrent status) on (deluge-get-torrents-status nil '("state" "name" "total_wanted")) by #'cddr
-		 for state = (getf status :|state|)
-		 when (equal state "Downloading") counting t into down
-		 when (equal state "Seeding") counting t into seed
-		 summing (getf status :|total_wanted|) into size
-		 finally (return (list :down down :seed seed :size size)))))
-	 (bot-send-message (format nil "[[🎶]] Осталось скачать ~a, заимпортить ~a торрентов, общий объём ~a.~%Сейчас в базе ~a исполнителей с ~a альбомами и ~a треками, общей длительностью ~a"
-				   (getf stats :down) (getf stats :seed) (format-size (getf stats :size))
-				   (agets db-stats "artists")
-				   (agets db-stats "albums")
-				   (agets db-stats "tracks")
-				   (agets db-stats "duration"))
-		      :parse-mode "markdown")))
+                     (json-request *chad-music-stats-url*)))
+         (stats (loop
+                  for (torrent status) on (deluge-get-torrents-status nil '("state" "name" "total_wanted")) by #'cddr
+                  for state = (getf status :|state|)
+                  when (equal state "Downloading") counting t into down
+                  when (equal state "Seeding") counting t into seed
+                  summing (getf status :|total_wanted|) into size
+                  finally (return (list :down down :seed seed :size size)))))
+    (bot-send-message
+     (format nil "[[🎶]] Осталось скачать ~a, заимпортить ~a торрентов, общий объём ~a.~%Сейчас в базе ~a исполнителей с ~a альбомами и ~a треками, общей длительностью ~a"
+             (getf stats :down) (getf stats :seed) (format-size (getf stats :size))
+             (agets db-stats "artists")
+             (agets db-stats "albums")
+             (agets db-stats "tracks")
+             (agets db-stats "duration"))
+     :parse-mode "markdown")))
 
 
 (defparameter +magnet-regex+ (ppcre:create-scanner "magnet:\\?\\S+"))
+(defun magnetp (str)
+  (ppcre:scan-to-strings +magnet-regex+ str))
+
 (defun handle-add-torrent (magnet)
   (let ((ih (deluge-add-torrent-magnet magnet)))
     (bot-send-message
      (if ih
-	 (let* ((status (deluge-get-torrent-status ih +deluge-default-status-fields+))
-		(info (get-torrent-info status)))
-	   (get-import-notify info "Качаем"))
-	 "Не добавил. Может уже?"))))
-
-(def-message-cmd-handler handle-cmd-music (:music)
+         (let* ((status (deluge-get-torrent-status ih +deluge-default-status-fields+))
+                (info (get-torrent-info status)))
+           (get-import-notify info "Качаем"))
+         "Не добавил. Может уже?"))))
+
+(defun web-action-hmac (action &optional (chat-id *chat-id*))
+  (token-hmac (format nil "~a-~a" chat-id action)))
+
+(def-webhook-handler ledger/handle-webhook ("music")
+  (destructuring-bind (chat-id hmac action) *paths*
+    (let ((*chat-id* (parse-integer chat-id)))
+      (when (and (string= (web-action-hmac action) hmac)
+                 (member *chat-id* (lists-get :music-admins)))
+        (case (keyify action)
+          (:magnet (let ((url (agets *data* "url")))
+                     (if (magnetp url)
+                         (progn (handle-add-torrent url) "OK")
+                         "Bad magnet"))))))))
+
+(def-message-cmd-handler handle-cmd-music (:music :m)
   (with-chat-in-list :music-admins
-    (let ((arg (car *args*)))
-    (cond
-      ((and (= 1 (length *args*)) (member (string-downcase arg) '("on" "off") :test 'equal))
-       (handle-set-watch (equal "on" arg)))
-      ((ppcre:scan-to-strings +magnet-regex+ arg)
-       (handle-add-torrent (ppcre:scan-to-strings +magnet-regex+ arg)))
-      (:otherwise (handle-status))))))
+   (let ((arg (car *args*)))
+     (cond
+       ((and (= 1 (length *args*)) (member (string-downcase arg) '("on" "off") :test 'equal))
+        (handle-set-watch (equal "on" arg)))
+       ((equal arg "url")
+        (bot-send-message (format nil "`curl ~a -D {\"url\": <magnet>}`"
+                                  (get-webhook-url "music" *chat-id*
+                                                   (web-action-hmac "magnet") "magnet"))
+                          :parse-mode "markdown"))
+       ((magnetp arg) (handle-add-torrent arg))
+       (:otherwise (handle-status))))))
 
 (add-hook :starting #'ensure-watcher)