#lang racket/base

(require file/sha1
         json
         net/url
         racket-audio
         racket/class
         racket/file
         racket/format
         racket/gui/base
         racket/os
         racket/path
         racket/port
         racket/random
         racket/string
         simple-ini
         simple-log
         "windows-tray.rkt")

(provide run-player-agent-gui)

(sl-def-log player-agent)

(define config-file
  (get-ini-file 'rkt-web-player-agent))

(define log-file
  (build-path (find-system-path 'pref-dir)
              "rkt-web-player-agent.log"))

(define (fresh-app-id)
  (bytes->hex-string (crypto-random-bytes 32)))

(define (valid-app-id? value)
  (and (string? value)
       (regexp-match? #px"^[0-9a-fA-F]{64}$" value)))

(define config
  (file->ini config-file))

(define app-id
  (let ((configured (ini-get config 'agent 'app-id #f)))
    (if (valid-app-id? configured)
        (string-downcase configured)
        (fresh-app-id))))

(define server-url
  (ini-get config 'server 'url "http://127.0.0.1:8080"))

(define assigned-name
  (ini-get config 'agent 'name
           (format "~a playback" (gethostname))))

(define tray-enabled?
  (ini-get config 'agent 'system-tray #t))

(define (save-config!)
  (ini-set! config 'agent 'app-id app-id)
  (ini-set! config 'agent 'name assigned-name)
  (ini-set! config 'agent 'system-tray tray-enabled?)
  (ini-set! config 'server 'url server-url)
  (ini->file config config-file #:private? #t))

(save-config!)

(define (base-url value)
  (string->url
   (regexp-replace #px"/+$" (string-trim value) "")))

(define (endpoint-url base path)
  (combine-url/relative (base-url base) path))

(define (post-json base path data)
  (let ((input
         (post-pure-port
          (endpoint-url base path)
          (jsexpr->bytes data)
          (list "Content-Type: application/json"
                "Cache-Control: no-store"))))
    (dynamic-wind
      void
      (λ ()
        (let ((response (read-json input)))
          (when (and (hash? response)
                     (string? (hash-ref response 'error #f)))
            (error 'player-agent
                   (hash-ref response 'error)))
          response))
      (λ ()
        (close-input-port input)))))

(define (normal-state state)
  (cond
    ((eq? state 'transitioning) "starting")
    ((eq? state 'initialized) "stopped")
    ((eq? state 'no-media) "stopped")
    (else (symbol->string state))))

(define (safe-delete-file file)
  (when (and file (file-exists? file))
    (with-handlers ((exn:fail?
                     (λ (exception)
                       (warn-player-agent
                        "Could not remove temporary media file ~a: ~a"
                        file
                        (exn-message exception)))))
      (delete-file file))))

(define (run-player-agent-gui)
  (sl-log-to-file log-file)

  (define state-lock (make-semaphore 1))
  (define worker #f)
  (define command-worker #f)
  (define executing-command-id 0)
  (define running? #f)
  (define audio #f)
  (define temporary-media #f)
  (define current-track #f)
  (define acknowledged-command 0)
  (define ended-counter 0)
  (define logical-volume 50)
  (define agent-state
    (hasheq 'state "stopped"
            'position 0
            'duration 'null
            'rate 'null
            'channels 'null
            'bits 'null
            'format ""
            'volume logical-volume
            'error 'null))

  (define (format-time value)
    (let* ((seconds
            (if (and (number? value) (>= value 0))
                (inexact->exact (floor value))
                0))
           (hours (quotient seconds 3600))
           (minutes (quotient (remainder seconds 3600) 60))
           (remaining (remainder seconds 60)))
      (format "~a:~a:~a"
              (~r hours #:min-width 2 #:pad-string "0")
              (~r minutes #:min-width 2 #:pad-string "0")
              (~r remaining #:min-width 2 #:pad-string "0"))))

  (define (with-agent-state proc)
    (call-with-semaphore state-lock proc))

  (define (state-value value fallback)
    (if (eq? value #f) fallback value))

  (define (update-from-audio! state full-state)
    (with-agent-state
     (λ ()
       (set! agent-state
             (hasheq
              'state (normal-state state)
              'position
              (state-value (hash-ref full-state 'at-second #f) 0)
              'duration
              (state-value (hash-ref full-state 'duration #f) 'null)
              'rate
              (state-value (hash-ref full-state 'rate #f) 'null)
              'channels
              (state-value (hash-ref full-state 'channels #f) 'null)
              'bits
              (state-value (hash-ref full-state 'bits #f) 'null)
              'format
              (let ((decoder (hash-ref full-state 'decoder #f)))
                (if decoder (format "~a" decoder) ""))
              'volume logical-volume
              'error 'null)))))

  (define (set-agent-error! message)
    (with-agent-state
     (λ ()
       (set! agent-state
             (hash-set agent-state 'error message)))))

  (define (clear-agent-error!)
    (with-agent-state
     (λ ()
       (set! agent-state
             (hash-set agent-state 'error 'null)))))

  (define (state-snapshot)
    (with-agent-state
     (λ () agent-state)))

  (define (ensure-audio!)
    (unless audio
      (set! audio
            (make-audio-player
             (λ (_handle state full-state)
               (update-from-audio! state full-state))
             (λ (_handle)
                (with-agent-state
                (λ ()
                  (set! ended-counter (+ ended-counter 1)))))))
      (audio-ao-buf-ms! audio 500)
      (audio-buf-seconds! audio 4 10)
      (let ((scaled (/ logical-volume 100.0)))
        (audio-volume! audio (* 100.0 scaled scaled))))
    audio)

  (define (download-media! token filename)
    (let* ((extension
            (or (path-get-extension (string->path filename)) #""))
           (template
            (string-append "rkt-player-agent-~a"
                           (bytes->string/utf-8 extension)))
           (target (make-temporary-file template))
           (path
            (format "/api/agent/media/~a/~a" app-id token))
           (input (get-pure-port (endpoint-url server-url path))))
      (with-handlers
          ((exn:fail?
            (λ (exception)
              (close-input-port input)
              (safe-delete-file target)
              (raise exception))))
        (call-with-output-file
         target
         (λ (output)
           (copy-port input output))
         #:exists 'truncate/replace)
        (close-input-port input)
        target)))

  (define (execute-command! command)
    (let* ((action (hash-ref command 'action ""))
           (data (hash-ref command 'data (hasheq))))
      (info-player-agent "Executing command ~a" action)
      (cond
        ((string=? action "play")
         (set! current-track data)
         (with-agent-state
          (λ ()
            (set! agent-state
                  (hash-set
                   (hash-set agent-state 'state "starting")
                   'error
                   'null))))
         (let ((next-media
                (download-media!
                 (hash-ref data 'mediaToken)
                 (hash-ref data 'filename "track"))))
           (when audio (audio-stop! audio))
           (safe-delete-file temporary-media)
           (set! temporary-media next-media)
           (audio-play! (ensure-audio!) temporary-media)))
        ((string=? action "pause")
         (audio-pause! (ensure-audio!) #t))
        ((string=? action "resume")
         (audio-pause! (ensure-audio!) #f))
        ((string=? action "stop")
         (when audio (audio-stop! audio)))
        ((string=? action "seek")
         (audio-seek! (ensure-audio!)
                      (hash-ref data 'percentage 0)))
        ((string=? action "volume")
         (set! logical-volume
               (min 100 (max 0 (hash-ref data 'value 50))))
         (let ((scaled (/ logical-volume 100.0)))
           (audio-volume! (ensure-audio!)
                          (* 100.0 scaled scaled)))
         (with-agent-state
          (λ ()
            (set! agent-state
                  (hash-set agent-state
                            'volume
                            logical-volume)))))
        (else
         (error 'player-agent "unknown command: ~a" action)))))

  (define frame #f)
  (define status-message #f)
  (define playback-message #f)
  (define playback-details #f)
  (define name-field #f)
  (define server-field #f)
  (define connect-button #f)
  (define tray-checkbox #f)
  (define tray-stop #f)
  (define shutting-down? #f)
  (define playback-timer #f)

  (define (show-status! message)
    (queue-callback
     (λ ()
       (when status-message
         (send status-message set-label message)))
     #f))

  (define (show-name! name)
    (queue-callback
     (λ ()
       (when name-field
         (send name-field set-value name)))
     #f))

  (define (refresh-playback-status!)
    (when (and playback-message playback-details)
      (let* ((snapshot (state-snapshot))
             (state (hash-ref snapshot 'state "stopped"))
             (title
              (and current-track
                   (hash-ref current-track 'title #f)))
             (artist
              (and current-track
                   (hash-ref current-track 'artist #f)))
             (track-label
              (cond
                ((and artist (not (string=? artist "")) title)
                 (format "~a — ~a" artist title))
                (title title)
                (else "Geen track geselecteerd")))
             (prefix
              (cond
                ((string=? state "playing") "Speelt")
                ((string=? state "paused") "Gepauzeerd")
                ((string=? state "starting") "Laden")
                ((string=? state "stopped") "Gestopt")
                (else state)))
             (position (hash-ref snapshot 'position 0))
             (duration (hash-ref snapshot 'duration 'null))
             (format-name (hash-ref snapshot 'format ""))
             (rate (hash-ref snapshot 'rate 'null))
             (details
              (filter
               (λ (value) (not (string=? value "")))
               (list
                (format "~a / ~a"
                        (format-time position)
                        (if (number? duration)
                            (format-time duration)
                            "--:--:--"))
                (if (string=? format-name "") format-name
                    (string-upcase format-name))
                (if (number? rate)
                    (format "~a kHz" (~r (/ rate 1000.0)
                                         #:precision '(= 1)))
                    "")))))
        (send playback-message
              set-label
              (if current-track
                  (format "~a: ~a" prefix track-label)
                  "Er wordt niets afgespeeld"))
        (send playback-details set-label (string-join details "  ·  ")))))

  (define (poll-loop)
    (with-handlers
        ((exn:fail?
          (λ (exception)
            (warn-player-agent "Connection cycle failed: ~a"
                               (exn-message exception))
            (set-agent-error! (exn-message exception))
            (show-status! (format "Niet verbonden: ~a"
                                  (exn-message exception)))
            (when running?
              (sleep 3)
              (poll-loop)))))
      (let ((registration
             (post-json
              server-url
              "/api/agent/register"
              (hasheq 'appId app-id
                      'name assigned-name))))
        (show-name! assigned-name)
        (clear-agent-error!)
        (show-status! "Verbonden")
        (info-player-agent "Registered at ~a as ~a"
                           server-url assigned-name)
        (let loop ()
          (when running?
            (let* ((response
                    (post-json
                     server-url
                     "/api/agent/poll"
                     (hasheq 'appId app-id
                             'name assigned-name
                             'ack acknowledged-command
                             'endedCounter ended-counter
                             'state (state-snapshot))))
                   (command
                    (hash-ref response 'command 'null)))
              (when (and (hash? command)
                         (> (hash-ref command 'id 0)
                            acknowledged-command)
                         (not (= (hash-ref command 'id 0)
                                 executing-command-id)))
                (set! executing-command-id
                      (hash-ref command 'id))
                (set!
                 command-worker
                 (thread
                  (λ ()
                    (with-handlers
                        ((exn:fail?
                          (λ (exception)
                            (warn-player-agent "Command failed: ~a"
                                               (exn-message exception))
                            (set-agent-error!
                             (exn-message exception)))))
                      (clear-agent-error!)
                      (execute-command! command))
                    (set! acknowledged-command
                          (hash-ref command 'id))
                    (set! executing-command-id 0)
                    (set! command-worker #f)))))
              (sleep 1)
              (loop)))))))

  (define (start-worker!)
    (set! running? #t)
    (set! worker (thread poll-loop))
    (send connect-button set-label "Opnieuw verbinden"))

  (define (stop-worker!)
    (set! running? #f)
    (when (and worker (not (thread-dead? worker)))
      (kill-thread worker))
    (when (and command-worker
               (not (thread-dead? command-worker)))
      (kill-thread command-worker))
    (set! worker #f)
    (set! command-worker #f)
    (set! executing-command-id 0))

  (define (reconnect!)
    (stop-worker!)
    (set! server-url (string-trim (send server-field get-value)))
    (let ((new-name (string-trim (send name-field get-value))))
      (set! assigned-name
            (if (string=? new-name "")
                (format "~a playback" (gethostname))
                new-name)))
    (save-config!)
    (show-status! "Verbinden…")
    (start-worker!))

  (define (stop-tray!)
    (when tray-stop
      (tray-stop)
      (set! tray-stop #f)))

  (define (shutdown!)
    (unless shutting-down?
      (set! shutting-down? #t)
      (stop-worker!)
      (stop-tray!)
      (when playback-timer
        (send playback-timer stop))
      (when audio
        (with-handlers ((exn:fail? void))
          (audio-quit! audio))
        (set! audio #f))
      (safe-delete-file temporary-media)))

  (define (ensure-tray!)
    (cond
      ((and tray-enabled? (not tray-stop))
       (set!
        tray-stop
        (start-windows-tray!
         (λ ()
           (queue-callback
            (λ ()
              (send frame show #t)
              (send frame focus))
            #f))
         (λ ()
           (queue-callback
            (λ ()
              (shutdown!)
              (send frame show #f))
            #f))))
       (when (and tray-enabled? (not tray-stop))
         (set! tray-enabled? #f)
         (save-config!)
         (when tray-checkbox
           (send tray-checkbox set-value #f))))
      ((not tray-enabled?)
       (stop-tray!))))

  (define agent-frame%
    (class frame%
      (super-new)
      (define/augment (on-close)
        (unless (and tray-enabled? tray-stop)
          (shutdown!))
        (inner (void) on-close))))

  (set! frame
        (new agent-frame%
             (label "RKT Web Player Agent")
             (width 560)
             (height 310)))
  (define panel
    (new vertical-panel%
         (parent frame)
         (alignment '(left top))
         (border 12)
         (spacing 8)))
  (set! server-field
        (new text-field%
             (parent panel)
             (label "RKT Web Player server")
             (init-value server-url)))
  (set! name-field
        (new text-field%
             (parent panel)
             (label "Naam")
             (init-value assigned-name)))
  (define id-field
    (new text-field%
         (parent panel)
         (label "Applicatie-ID")
         (init-value app-id)))
  ;; Lock just the editor instead of disabling the complete widget. Windows
  ;; renders disabled native controls in grey, which made the label and ID look
  ;; as though their glyphs were damaged.
  (send (send id-field get-editor) lock #t)

  (define playback-panel
    (new group-box-panel%
         (parent panel)
         (label "Afspelen")
         (alignment '(left top))
         (stretchable-height #f)))
  (set! playback-message
        (new message%
             (parent playback-panel)
             (label "Er wordt niets afgespeeld")
             (auto-resize #t)))
  (set! playback-details
        (new message%
             (parent playback-panel)
             (label "00:00:00 / --:--:--")
             (auto-resize #t)))

  (define controls
    (new horizontal-panel%
         (parent panel)
         (alignment '(left center))))
  (set! connect-button
        (new button%
             (parent controls)
             (label "Opslaan en verbinden")
             (callback (λ (_button _event)
                         (reconnect!)))))
  (set! status-message
        (new message%
             (parent controls)
             (label "Verbinden…")
             (auto-resize #t)))

  (set! tray-checkbox
        (new check-box%
             (parent panel)
             (label "In het systeemvak actief blijven na sluiten")
             (value (and tray-enabled? (windows-tray-available?)))
             (enabled (windows-tray-available?))
             (callback
              (λ (box _event)
                (set! tray-enabled? (send box get-value))
                (save-config!)
                (ensure-tray!)))))

  (set! playback-timer
        (new timer%
             (notify-callback refresh-playback-status!)
             (interval 500)))
  (refresh-playback-status!)

  (send frame show #t)
  (ensure-tray!)
  (start-worker!)
  frame)