#lang racket/base

(require json
         net/url
         racket-audio
         racket/file
         racket/path
         racket/port
         racket/string
         simple-log)

(provide (struct-out player-agent-runtime)
         make-player-agent-runtime)

(sl-def-log player-agent)

(struct exn:fail:agent-denied exn:fail () #:transparent)

(struct player-agent-runtime
  (start! reconnect! shutdown! snapshot current-track running? app-id)
  #:transparent)

(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)
  (define input
    (post-pure-port
     (endpoint-url base path)
     (jsexpr->bytes data)
     (list "Content-Type: application/json"
           "Cache-Control: no-store")))
  (dynamic-wind
    void
    (lambda ()
      (define response (read-json input))
      (when (and (hash? response)
                 (string? (hash-ref response 'error #f)))
        (if (equal? (hash-ref response 'code #f) "agent-not-authorized")
            (raise
             (exn:fail:agent-denied
              (hash-ref response 'error)
              (current-continuation-marks)))
            (error 'player-agent (hash-ref response 'error))))
      response)
    (lambda () (close-input-port input))))

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

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

(define (make-player-agent-runtime initial-server-url
                                   initial-name
                                   app-id
                                   #:status-callback
                                   [status-callback void]
                                   #:denied-callback
                                   [denied-callback void])
  (define server-url initial-server-url)
  (define assigned-name initial-name)
  (define state-lock (make-semaphore 1))
  (define worker #f)
  (define command-worker #f)
  (define executing-command-id 0)
  (define running #f)
  (define authorization-notified? #f)
  (define audio #f)
  (define current-media-key #f)
  (define cached-media (make-hash))
  (define prefetched-track #f)
  (define auto-started-key #f)
  (define pending-auto-music-id #f)
  (define music-tracks (make-hash))
  (define current-track-value #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 (with-agent-state proc)
    (call-with-semaphore state-lock proc))

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

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

  (define (current-track)
    (with-agent-state (lambda () current-track-value)))

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

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

  (define (update-from-audio! state full-state)
    (with-agent-state
     (lambda ()
       (define audible-music-id (hash-ref full-state 'at-music-id #f))
       (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))
       (when (and pending-auto-music-id
                  (number? audible-music-id)
                  (= pending-auto-music-id audible-music-id))
         (define audible-track
           (hash-ref music-tracks audible-music-id #f))
         (when audible-track
           (set! current-track-value audible-track)
           (hash-clear! music-tracks)
           (hash-set! music-tracks audible-music-id audible-track))
         (set! pending-auto-music-id #f)
         (set! ended-counter (+ ended-counter 1))))))

  (define (ensure-audio!)
    (unless audio
      (set! audio
            (make-audio-player
             (lambda (_handle state full-state)
               (update-from-audio! state full-state))
             (lambda (handle)
               (advance-at-decoder-eof! handle))))
      (audio-ao-buf-ms! audio 500)
      (audio-buf-seconds! audio 4 10)
      (define scaled (/ logical-volume 100.0))
      (audio-volume! audio (* 100.0 scaled scaled)))
    audio)

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

  (define (command-cache-key data)
    (hash-ref data 'cacheKey (hash-ref data 'mediaToken)))

  (define (ensure-media-cached! data)
    (define key (command-cache-key data))
    (define found (hash-ref cached-media key #f))
    (if (and found (file-exists? found))
        found
        (let ((downloaded
               (download-media!
                (hash-ref data 'mediaToken)
                (hash-ref data 'filename "track"))))
          (hash-set! cached-media key downloaded)
          downloaded)))

  (define (discard-unused-media! keep-key)
    (for ((entry (in-list (hash->list cached-media))))
      (unless (equal? (car entry) keep-key)
        (safe-delete-file (cdr entry))
        (hash-remove! cached-media (car entry)))))

  ;; Decoder EOF occurs before audible EOF. Queueing the prefetched decoder at
  ;; this point appends it behind racket-audio's remaining output buffer.
  (define (advance-at-decoder-eof! handle)
    (define prepared
      (with-agent-state
       (lambda ()
         (define value prefetched-track)
         (set! prefetched-track #f)
         value)))
    (cond
      (prepared
       (define data (car prepared))
       (define path (cdr prepared))
       (define key (command-cache-key data))
       (with-handlers
           ((exn:fail?
             (lambda (exception)
               (warn-player-agent "Could not start prefetched track: ~a"
                                  (exn-message exception))
               (set-agent-error! (exn-message exception))
               (with-agent-state
                (lambda () (set! ended-counter (+ ended-counter 1)))))))
         (define music-id (audio-play! handle path))
         (info-player-agent "Queued prefetched track ~a as music id ~a"
                            (hash-ref data 'filename "track")
                            music-id)
         (set! current-media-key key)
         (discard-unused-media! key)
         (with-agent-state
          (lambda ()
            (hash-set! music-tracks music-id data)
            (set! auto-started-key key)
            (set! pending-auto-music-id music-id)))))
      (else
       (warn-player-agent
        "Decoder reached EOF before the next track was prefetched")
       (with-agent-state
        (lambda () (set! ended-counter (+ ended-counter 1)))))))

  (define (execute-command! command)
    (define action (hash-ref command 'action ""))
    (define data (hash-ref command 'data (hasheq)))
    (info-player-agent "Executing command ~a" action)
    (cond
      ((string=? action "play")
       (define next-key (command-cache-key data))
       (define already-started?
         (with-agent-state
          (lambda ()
            (define matches?
              (and auto-started-key (equal? auto-started-key next-key)))
            (when matches? (set! auto-started-key #f))
            matches?)))
       (with-agent-state
        (lambda () (set! current-track-value data)))
       (unless already-started?
         (with-agent-state
          (lambda ()
            (set! prefetched-track #f)
            (set! auto-started-key #f)
            (set! pending-auto-music-id #f)
            (set! agent-state
                  (hash-set
                   (hash-set agent-state 'state "starting")
                   'error 'null))))
         (define next-media (ensure-media-cached! data))
         ;; audio-play! interrupts and closes the previous decoder itself.
         (define music-id (audio-play! (ensure-audio!) next-media))
         (with-agent-state
          (lambda ()
            (hash-clear! music-tracks)
            (hash-set! music-tracks music-id data)))
         (set! current-media-key next-key)
         (discard-unused-media! next-key)))
      ((string=? action "prefetch")
       (define key (command-cache-key data))
       (define path (ensure-media-cached! data))
       (with-agent-state
        (lambda () (set! prefetched-track (cons data path))))
       (info-player-agent "Prefetched ~a" (hash-ref data 'filename "track"))
       (for ((entry (in-list (hash->list cached-media))))
         (unless (or (equal? (car entry) current-media-key)
                     (equal? (car entry) key))
           (safe-delete-file (cdr entry))
           (hash-remove! cached-media (car entry)))))
      ((string=? action "pause")
       (audio-pause! (ensure-audio!) #t))
      ((string=? action "resume")
       (audio-pause! (ensure-audio!) #f))
      ((string=? action "stop")
       (with-agent-state
        (lambda ()
          (set! prefetched-track #f)
          (set! auto-started-key #f)
          (set! pending-auto-music-id #f)))
       (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))))
       (define scaled (/ logical-volume 100.0))
       (audio-volume! (ensure-audio!) (* 100.0 scaled scaled))
       (with-agent-state
        (lambda ()
          (set! agent-state
                (hash-set agent-state 'volume logical-volume)))))
      (else
       (error 'player-agent "unknown command: ~a" action))))

  (define (poll-loop)
    (with-handlers
        ((exn:fail:agent-denied?
          (lambda (exception)
            (define message
              (string-append
               "Deze playback agent is niet toegelaten door de server. "
               "Voeg het volgende applicatie-ID toe aan [playback-agents] "
               "in de server-INI:\n\n"
               app-id))
            (warn-player-agent "Agent authorization refused: ~a"
                               (exn-message exception))
            (set-agent-error! message)
            (status-callback
             "Niet geautoriseerd — applicatie-ID staat niet in de server-INI")
            (unless authorization-notified?
              (set! authorization-notified? #t)
              (denied-callback message))
            (when running
              (sleep 3)
              (poll-loop))))
         (exn:fail?
          (lambda (exception)
            (warn-player-agent "Connection cycle failed: ~a"
                               (exn-message exception))
            (set-agent-error! (exn-message exception))
            (status-callback
             (format "Niet verbonden: ~a" (exn-message exception)))
            (when running
              (sleep 3)
              (poll-loop)))))
      (post-json server-url
                 "/api/agent/register"
                 (hasheq 'appId app-id 'name assigned-name))
      (clear-agent-error!)
      (status-callback "Verbonden")
      (info-player-agent "Registered at ~a as ~a" server-url assigned-name)
      (let loop ()
        (when running
          (define response
            (post-json
             server-url
             "/api/agent/poll"
             (hasheq 'appId app-id
                     'name assigned-name
                     'ack acknowledged-command
                     'endedCounter ended-counter
                     'state (snapshot))))
          (define 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
                   (lambda ()
                     (with-handlers
                         ((exn:fail?
                           (lambda (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!)
    (unless running
      (set! running #t)
      (status-callback "Verbinden…")
      (set! worker (thread poll-loop))))

  (define (stop!)
    (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! new-server-url new-name)
    (stop!)
    (set! authorization-notified? #f)
    (set! server-url (string-trim new-server-url))
    (set! assigned-name (string-trim new-name))
    (start!))

  (define (shutdown!)
    (stop!)
    (when audio
      (with-handlers ((exn:fail? void))
        (audio-quit! audio))
      (set! audio #f))
    (for ((path (in-hash-values cached-media)))
      (safe-delete-file path))
    (hash-clear! cached-media))

  (player-agent-runtime start!
                        reconnect!
                        shutdown!
                        snapshot
                        current-track
                        (lambda () running)
                        app-id))