dotfiles/dot_local/bin/executable_peertube

#!/usr/bin/env -S guile --no-auto-compile -e main -s
!#

;;; convert-music --- Convert video clips to audio only
;;; Copyright © 2019, 2022 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of convert-music.
;;;
;;; convert-music is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; convert-music is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with convert-music.  If not, see <http://www.gnu.org/licenses/>.


;; Convert video clips in /srv/music directory to audio files without a video
;; part and store them in /srv/audio directory.  To do that, run:
;;
;; peertube /srv/music

(use-modules (ice-9 format)
             (ice-9 ftw)
             (ice-9 match)
             (ice-9 popen)
             (ice-9 rdelim)
             (ice-9 readline)
             (json)
             (srfi srfi-1)
             (srfi srfi-26)
             (srfi srfi-34)
             (srfi srfi-37)

             (guix build utils))

(define (list-files dir)
  (filter (match-lambda
            ((name #(_ _ _ _ _ _ _ _ _ _ _ _ _ 'regular _ _ _ _)) name)
            (_ #f))
          (file-system-tree dir)))

(define %options
  (let ((display-and-exit-proc (lambda (msg)
                                 (lambda (opt name arg loads)
                                   (display msg) (quit)))))
    (list (option '(#\v "version") #f #f
                  (display-and-exit-proc "convert-music version 0.0.1\n"))
          (option '(#\h "help") #f #f
                  (display-and-exit-proc
                   "Usage: convert-music /srv/music /srv/audio ...")))))

(define %default-options
  '())

(define %peertube-api-url
  (and=> (getenv "PEERTUBE_API_URL")
         (lambda (peertube-api-url)
           peertube-api-url)))

(define %peertube-username
  (and=> (getenv "PEERTUBE_USERNAME")
         (lambda (peertube-username)
           peertube-username)))

(define %peertube-password
  (and=> (getenv "PEERTUBE_PASSWORD")
         (lambda (peertube-password)
           peertube-password)))

(define %peertube-channel-id
  (and=> (getenv "PEERTUBE_CHANNEL_ID")
         (lambda (peertube-channel-id)
           peertube-channel-id)))

(define %peertube-category
  (and=> (getenv "PEERTUBE_CATEGORY")
         (lambda (peertube-category)
           peertube-category)))

(define %peertube-playlist-id
  (and=> (getenv "PEERTUBE_PLAYLIST_ID")
         (lambda (peertube-playlist-id)
           peertube-playlist-id)))

(define %peertube-privacy
  (and=> (getenv "PEERTUBE_PRIVACY")
         (lambda (peertube-privacy)
           peertube-privacy)))

(define (peertube-client-id)
  (let* ((port   (open-pipe* OPEN_READ "curl"
                             (string-append
                              %peertube-api-url "/oauth-clients/local")
                             "--silent"))
         (output (read-string port)))
    (close-port port)
    (string-trim-right output #\newline)))

(define (peertube-access-token client-id client-secret)
  (let* ((port (open-pipe* OPEN_READ "curl"
                           (string-append %peertube-api-url "/users/token")
                           "--silent"
                           "--data" (format #f "client_id=~a" client-id)
                           "--data" (format #f "client_secret=~a" client-secret)
                           "--data" "grant_type=password"
                           "--data" "response_type=code"
                           "--data" (format #f "username=~a" %peertube-username)
                           "--data" (format #f "password=~a" %peertube-password)))
         (output (read-string port)))
    (close-port port)
    (string-trim-right output #\newline)))

(define (append-to-file name body)
  (let ((file (open-file name "a")))
    (display body file)
    (close-port file)))

(define (main . args)
  (define opts
    (args-fold (cdr (program-arguments))
               %options
               (lambda (opt name arg loads)
                 (error "Unrecognized option `~A'" name))
               (lambda (op loads)
                 (cons op loads))
               %default-options))
  (define input-directory
    (first (reverse opts)))

  (define client-id+secret
   (json-string->scm (peertube-client-id)))
  (define client-id
   (assoc-ref client-id+secret "client_id"))
  (define client-secret
   (assoc-ref client-id+secret "client_secret"))
  (define access-token
   (assoc-ref
    (json-string->scm
     (peertube-access-token client-id client-secret))
    "access_token"))

  (for-each (lambda (file)
              (match file
                ((n ... ext)
                 (let* ((input (string-append input-directory "/"
                                              (string-join file ".")))
                        (output-file-name
                         (match (string-split (basename input) #\.)
                           ((file-name ... file-extension)
                            (string-join file-name "."))
                           ((file-name file-extension)
                            file-name)))
                        (video-upload-output (string-append output-file-name ".json")))

                   (if (any (lambda (file)
                              (string= file input))
                            (string-split
                             (with-input-from-file "peertube.log"
                               read-string)
                             #\newline))
                       (format #t "~%Skip already uploaded ~a file.~%" input)
                       (begin
                         (format #t "input: ~a~%" input)
                         (format #t "output: ~a~%" output-file-name)
                         (guard (c ((invoke-error? c)
                                    (report-invoke-error c)
                                    (append-to-file "peertube-error.log" (string-append "\n" input))
                                    #f))
                           (invoke
                            "curl" (string-append %peertube-api-url "/videos/upload")
                            "--fail"
                            "--max-time" "6000"
                            "--header" (format #f "Authorization: Bearer ~a" access-token)
                            "--form" (format #f "videofile=@~a" input)
                            "--form" (format #f "name=~a" output-file-name)
                            "--form" (format #f "channelId=~a" %peertube-channel-id)
                            "--form" (format #f "privacy=~a" %peertube-privacy)
                            "--form" (format #f "category=~a" %peertube-category)
                            "--form" "waitTranscoding=1"
                            "--output" video-upload-output))

                         (display "\nSleep for 30 to wait for API.\n")
                         (sleep 30)

                         (let ((uuid (assoc-ref (assoc-ref (json-string->scm
                                                            (with-input-from-file video-upload-output
                                                              read-string))
                                                           "video")
                                                "uuid")))
                           
                           (guard (c ((invoke-error? c)
                                      (report-invoke-error c)
                                      (append-to-file "peertube-playlist-error.log" (string-append "\n" input))
                                      #f))
                             (invoke "curl"
                                     (string-append %peertube-api-url "/video-playlists/" %peertube-playlist-id "/videos")
                                     "--fail"
                                     "--header" (format #f "Authorization: Bearer ~a" access-token)
                                     "--data" (format #f "videoId=~a" uuid))))

                         (let loop ()
                           (if (= (system* "pgrep" "--full" "--list-full" "ffmpeg")
                                  256)
                               #t
                               (begin
                                 (display "Wait until ffmpeg processes do not exist.\n")
                                 (sleep 30)
                                 (loop))))
                         (newline)

                         (append-to-file "peertube.log" (string-append "\n" input))))))))
            (map (cut string-split <> #\.)
                 (map (match-lambda ((file _ ...) file))
                      (list-files input-directory)))))