chatikbot/plugins/music.lisp

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

(defvar *cookies* (cl-cookie:make-cookie-jar))
(defvar *deluge-api* "http://localhost:8112/json")
(defvar *deluge-password* "chads")
(defvar *deluge-request-id* 1)
(defvar *chad-music-stats-url* "http://localhost:5000/api/stats")
(defvar *chad-music-rescan-url* "http://localhost:5000/api/rescan")
(defvar *slskd-api* "http://localhost:5015/api/v0")
(defvar *slskd-downloads-dir* "/data/uploads/batch2/")

(defun jojo-request (url &rest args &key method parameters content headers basic-auth bearer cookie-jar keep-alive use-connection-pool timeout ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent (as :plist))
  (declare (ignore method parameters basic-auth cookie-jar keep-alive use-connection-pool timeout ssl-key-file ssl-cert-file ssl-key-password stream verbose proxy insecure ca-path user-agent))
  (remf args :as)
  (remf args :bearer)
  (when content
    (push (cons :content-type "application/json") headers))
  (when bearer
    (push (cons :authorization (format nil "Bearer ~a" bearer)) headers))
  (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))
    (unless (stringp body)
      (setf body (trivial-utf-8:utf-8-bytes-to-string body)))
    (values (jojo:parse body :as as) status headers uri)))

(defun deluge-request (method &optional params is-auth)
  (let* ((content (trivial-utf-8:string-to-utf-8-bytes
                   (jojo:to-json `(:|id| ,(incf *deluge-request-id*)
                                    :|method| ,method
                                    :|params| ,params))))
         (response (jojo-request *deluge-api* :method :post
                                 :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 method params t)) ;; Retry original request
            (error (format nil "Deluge error: ~a" error-message)))
        (getf response :|result|))))  

(defun infohash-magnet (info-hash)
  (concatenate 'string "magnet:?xt=urn:btih:" info-hash))

(defun deluge-add-info-hash (info-hashes)
  (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)))))
    (deluge-request "web.add_torrents" (list torrents))))

(defun deluge-get-torrents ()
  (deluge-request "core.get_session_state"))

(defun deluge-get-torrent-status (info-hash fields)
  (deluge-request "core.get_torrent_status" (list info-hash fields)))

(defun deluge-get-torrents-status (filter fields)
  (deluge-request "core.get_torrents_status" (list filter fields)))

(defun deluge-remove-torrent (ih &optional from-disk)
  (deluge-request "core.remove_torrent" (list ih from-disk)))

(defparameter +deluge-default-status-fields+ '("name" "state" "save_path" "files" "file_priorities" "total_size" "total_wanted" "total_done" "num_files"))
(defun raw-pathname (pathspec)
  (values (cl-ppcre:regex-replace-all "\\[" pathspec "\\\\[")))

(defun deluge-get-torrent-files (info-hash)
  (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)))

(defun deluge-add-torrent-magnet (uri &optional options)
  (deluge-request "core.add_torrent_magnet" (list uri options)))

(defun get-non-skipped (files)
  (remove 0 files :key (lambda (f) (getf f :|prio|))))

(defun get-files-folders (files)
  (delete-duplicates (mapcar (lambda (f) (uiop:pathname-directory-pathname (getf f :|path|))) files)))

(defparameter +media-exts+ '("mp3" "flac" "ac3"))
(defun media-p (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)
  (labels ((f (field)
             (getf status field)))
    (let ((wanted-dirs (loop for file in (f :|files|)
                             for prio in (f :|file_priorities|)
                             for path = (getf file :|path|)
                             when (media-p path)
                             unless (= prio 0)
                             collect (subseq path 0 (1+ (position #\/ path :from-end t))))))
      (list
       :name (f :|name|)
       :state (keyify (f :|state|))
       :save-path (f :|save_path|)
       :total-files (f :|num_files|)
       :total-size (f :|total_size|)
       :total-size-left (- (f :|total_size|) (f :|total_done|))
       :wanted-files (length wanted-dirs)
       :wanted-size (f :|total_wanted|)
       :media-dirs (remove-duplicates wanted-dirs :test #'equal)))))

(defun get-import-notify (info action)
  (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))))))

(defun get-root-paths (info)
  (let ((roots (delete-duplicates (loop for dir in (getf info :media-dirs)
                                        collect (subseq dir 0 (1+ (position #\/ dir))))
                                  :test #'equal))
        (save (getf info :save-path)))
    (mapcar #'(lambda (r) (concatenate 'string save "/" r)) roots)))

(defvar *beet-bin* '("sudo" "-u" "uploader" "/home/uploader/.local/bin/beet"))
(defun beets-import-cmd (paths)
  (append *beet-bin*
          (list "import" "--move" "--quiet")
          paths))

(defun run-import (paths &optional dry)
  (let ((cmd (beets-import-cmd paths)))
    (if dry (format t "Running ~{~a~^ ~}" cmd)
        (handler-case (uiop:run-program cmd)
          (error (e) (log:error "Error importing" paths e))))))

(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|))))

(defun deluge-pause-torrents (&rest torrents)
  (deluge-request "core.pause_torrent" (list torrents)))

(defun deluge-delete-skipped (torrent &optional dry)
  (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)))))

(defun send-notify (msg &optional dry)
  (if dry (format t "~a~%" msg)
      (loop for *chat-id* in (lists-get :music-notify)
            do (bot-send-message msg :parse-mode "markdown"))))

(defun request-chad-music-rescan ()
  (json-request *chad-music-rescan-url* :method :post))

(defun process-downloaded-torrent (ih &optional dry)
  (let* ((status (deluge-get-torrent-status ih +deluge-default-status-fields+))
         (info (get-torrent-info status))
         (notify (get-import-notify info "Добавляем"))
         (paths (get-root-paths info)))
    (send-notify notify dry)
    (deluge-pause-torrents ih)
    (deluge-delete-skipped ih dry)
    (run-import paths dry)
    (request-chad-music-rescan)
    (if dry (format t "Removing torrent ~a" 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)))))
    (handler-case (jojo-request (format nil "~a/~a" *slskd-api* path)
				:bearer *slskd-bearer*
				:method method				
                                :content content
				: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))))))


(defun slskd-get-download-directories ()
  (loop for dl in (slskd-request "transfers/downloads" :method :get)
        append (getf dl :|directories|)))

(defun slskd-file-succeeded-p (file)
  (equal (getf file :|state|) "Completed, Succeeded"))

(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, "))))

(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|))))))

(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"))))

(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)))))
(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|)
              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 
              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)))
      (list
       :name (f :|directory|)
       :save-path (slskd-get-download-path dir)
       :total-files total-files
       :total-files-left total-files-left
       :total-size total-size
       :total-size-left total-size-left
       :wanted-files wanted-files
       :wanted-files-left wanted-files-left
       :wanted-size wanted-size
       :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|)))

(defun slskd-process-download-dir (dir)
  (let ((files (getf dir :|files|)))
    ;; Retry failed
    (when (some #'slskd-file-succeeded-p files)
      (loop for file in files
            when (slskd-file-complete-error-p 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))))
    (loop for dir in (slskd-get-download-directories)
          do (handler-case (slskd-process-download-dir dir)
               (error (c) (log:error "Error processing slskd" c))))
    (sleep 1)))

(defvar *watcher* nil "Importer thread ")
(defvar *lock* (bordeaux-threads:make-recursive-lock "Music watch"))
(defun ensure-watcher ()
  (bt:with-recursive-lock-held (*lock*)
    (if (lists-get :music-watch)
        (unless *watcher*
          (setf *watcher* (bt:make-thread 'process-imports :name "music watch")))
        (when *watcher*
          (bt:destroy-thread *watcher*)
          (setf *watcher* nil))))
  (values))

(defun handle-set-watch (enable)
  (lists-set-entry :music-watch *chat-id* enable)
  (ensure-watcher)
  (bot-send-message (if enable "[🎶] Импортим музло" "[🎶] Пусть мешки парятся")))

(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")))


(defparameter +magnet-regex+ (ppcre:create-scanner "magnet:\\?\\S+"))
(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)
  (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))))))

(add-hook :starting #'ensure-watcher)