Adding a local player agent

2026-08-27 10:24:40 +02:00
parent d22a7ad529
commit 577b0aa729
8 changed files with 1321 additions and 37 deletions
@@ -2,8 +2,10 @@

 (require racket-audio
         racket-audio-dlna
+         file/sha1
         racket/list
         racket/path
+         racket/random
         racket/string
         racket-sonos
         racket-upnp
@@ -14,12 +16,27 @@
         player-state->jsexpr
         player-command!
         player-discover!
+         player-agent-register!
+         player-agent-poll!
+         player-agent-media
         player-close!)

 (sl-def-log web-player)

 (struct renderer
-  (id name kind device)
+  (id [name #:mutable] kind device)
+  #:transparent)
+
+(struct playback-agent
+  (app-id
+   [name #:mutable]
+   [last-seen #:mutable]
+   [reported-state #:mutable]
+   [commands #:mutable]
+   [next-command-id #:mutable]
+   [media-token #:mutable]
+   [media-file #:mutable]
+   [ended-counter #:mutable])
  #:transparent)

 (struct playlist-tab
@@ -28,6 +45,7 @@

 (struct player
  (libraries
+   [agents #:mutable]
   [current-library-id #:mutable]
   [browser-path #:mutable]
   [browser-entries #:mutable]
@@ -68,6 +86,80 @@
           (string=? (renderer-id item) id))
         (player-renderers value)))

+(define (agent-renderer-id app-id)
+  (string-append "agent:" app-id))
+
+(define (agent-by-id value app-id)
+  (findf (λ (agent)
+           (string=? (playback-agent-app-id agent) app-id))
+         (player-agents value)))
+
+(define (agent-renderer value agent)
+  (renderer-by-id value
+                  (agent-renderer-id
+                   (playback-agent-app-id agent))))
+
+(define (valid-agent-id? value)
+  (and (string? value)
+       (regexp-match? #px"^[0-9a-fA-F]{64}$" value)))
+
+(define (fresh-media-token)
+  (bytes->hex-string (crypto-random-bytes 32)))
+
+(define (enqueue-agent-command! value agent action [data (hasheq)])
+  (with-state-lock
+   value
+   (λ ()
+     (let* ((id (playback-agent-next-command-id agent))
+            (command (hasheq 'id id
+                             'action action
+                             'data data)))
+       (set-playback-agent-next-command-id! agent (+ id 1))
+       (set-playback-agent-commands!
+        agent
+        (append (playback-agent-commands agent)
+                (list command)))
+       command))))
+
+(define agent-heartbeat-timeout-seconds 10)
+
+(define (prune-stale-agents! value)
+  (with-state-lock
+   value
+   (λ ()
+     (let* ((cutoff (- (current-seconds)
+                       agent-heartbeat-timeout-seconds))
+            (stale
+             (filter (λ (agent)
+                       (< (playback-agent-last-seen agent) cutoff))
+                     (player-agents value)))
+            (stale-ids
+             (map (λ (agent)
+                    (agent-renderer-id
+                     (playback-agent-app-id agent)))
+                  stale)))
+       (unless (null? stale)
+         (set-player-agents!
+          value
+          (filter (λ (agent)
+                    (not (member (agent-renderer-id
+                                  (playback-agent-app-id agent))
+                                 stale-ids)))
+                  (player-agents value)))
+         (set-player-renderers!
+          value
+          (filter (λ (item)
+                    (not (member (renderer-id item) stale-ids)))
+                  (player-renderers value)))
+         (when (member (player-selected-id value) stale-ids)
+           (set-player-selected-id! value "local")
+           (set-player-backend! value #f)
+           (set-player-backend-kind! value #f)
+           (set-player-state! value 'stopped)
+           (set-player-position! value 0)
+           (set-player-duration! value #f)
+           (reset-audio-info! value)))))))
+
 (define (library-by-id value id)
  (findf (λ (library)
           (string=? (music-library-id library) id))
@@ -177,6 +269,8 @@
                 (make-network-backend
                  value
                  (renderer-device selected)))
+                ((eq? kind 'agent)
+                 (renderer-device selected))
                (else
                 (raise-arguments-error
                  'player-command!
@@ -200,9 +294,13 @@
               "Could not close ~a player: ~a"
               kind
               (exn-message exception)))))
-        (if (eq? kind 'local)
-            (audio-quit! backend)
-            (dlna-player-close! backend))))
+        (cond
+          ((eq? kind 'local)
+           (audio-quit! backend))
+          ((eq? kind 'agent)
+           (enqueue-agent-command! value backend "stop"))
+          (else
+           (dlna-player-close! backend)))))
    (with-state-lock
     value
     (λ ()
@@ -215,9 +313,15 @@

 (define (stop-playback! value)
  (when (player-backend value)
-    (if (eq? (player-backend-kind value) 'local)
-        (audio-stop! (player-backend value))
-        (dlna-player-stop! (player-backend value))))
+    (cond
+      ((eq? (player-backend-kind value) 'local)
+       (audio-stop! (player-backend value)))
+      ((eq? (player-backend-kind value) 'agent)
+       (enqueue-agent-command! value
+                               (player-backend value)
+                               "stop"))
+      (else
+       (dlna-player-stop! (player-backend value)))))
  (with-state-lock
   value
   (λ ()
@@ -245,9 +349,27 @@
       (set-player-state! value 'starting)
       (set-player-position! value 0)
       (set-player-duration! value (track-duration item))))
-    (if (eq? kind 'local)
-        (audio-play! backend (track-file item))
-        (dlna-player-play! backend (track-file item)))
+    (cond
+      ((eq? kind 'local)
+       (audio-play! backend (track-file item)))
+      ((eq? kind 'agent)
+       (let ((token (fresh-media-token)))
+         (with-state-lock
+          value
+          (λ ()
+            (set-playback-agent-media-token! backend token)
+            (set-playback-agent-media-file! backend (track-file item))))
+         (enqueue-agent-command!
+          value
+          backend
+          "play"
+          (hasheq 'mediaToken token
+                  'filename
+                  (path->string
+                   (or (file-name-from-path (track-file item))
+                       (track-file item)))))))
+      (else
+       (dlna-player-play! backend (track-file item))))
    (clear-error! value)))

 (define (next-index value direction)
@@ -274,8 +396,50 @@
        ((exn:fail?
          (λ (exception)
            (set-error! value (exn-message exception)))))
-      (let* ((info (dlna-player-info (player-backend value)))
-             (track-info (dlna-info-track info)))
+      (if (eq? (player-backend-kind value) 'agent)
+          (let ((reported
+                 (playback-agent-reported-state
+                  (player-backend value))))
+            ;; Keep the server's optimistic command state visible until the
+            ;; agent acknowledges all queued work. Its report in the poll that
+            ;; receives a command still describes the state before execution.
+            (when (and (hash? reported)
+                       (null? (playback-agent-commands
+                               (player-backend value))))
+              (with-state-lock
+               value
+               (λ ()
+                 (let ((state (hash-ref reported 'state #f)))
+                   (when (string? state)
+                     (set-player-state!
+                      value
+                      (normalize-state (string->symbol state)))))
+                 (set-player-position!
+                  value
+                  (or (json-number reported 'position #f) 0))
+                 (set-player-duration!
+                  value
+                  (json-number reported 'duration #f))
+                 (set-player-rate!
+                  value
+                  (json-number reported 'rate #f))
+                 (set-player-channels!
+                  value
+                  (json-number reported 'channels #f))
+                 (set-player-bits!
+                  value
+                  (json-number reported 'bits #f))
+                 (let ((decoder (json-string reported 'format #f)))
+                   (set-player-decoder!
+                    value
+                    (and decoder (string->symbol decoder))))
+                 (let ((volume (json-number reported 'volume #f)))
+                   (when volume
+                     (set-player-volume! value volume)))
+                 (let ((error (json-string reported 'error #f)))
+                   (set-player-error! value error))))))
+          (let* ((info (dlna-player-info (player-backend value)))
+                 (track-info (dlna-info-track info)))
        (with-state-lock
         value
         (λ ()
@@ -300,7 +464,7 @@
           (set-player-decoder! value 'dlna)
           (when (number? (dlna-info-volume info))
             (set-player-volume! value
-                                 (dlna-info-volume info)))))))))
+                                 (dlna-info-volume info))))))))))

 (define (entry-by-index value index)
  (and (exact-nonnegative-integer? index)
@@ -685,14 +849,22 @@
          0)))
    ((string=? command "pause")
     (let ((backend (ensure-backend! value)))
-       (if (eq? (player-backend-kind value) 'local)
-           (audio-pause! backend #t)
-           (dlna-player-pause! backend))))
+       (cond
+         ((eq? (player-backend-kind value) 'local)
+          (audio-pause! backend #t))
+         ((eq? (player-backend-kind value) 'agent)
+          (enqueue-agent-command! value backend "pause"))
+         (else
+          (dlna-player-pause! backend)))))
    ((string=? command "resume")
     (let ((backend (ensure-backend! value)))
-       (if (eq? (player-backend-kind value) 'local)
-           (audio-pause! backend #f)
-           (dlna-player-resume! backend))))
+       (cond
+         ((eq? (player-backend-kind value) 'local)
+          (audio-pause! backend #f))
+         ((eq? (player-backend-kind value) 'agent)
+          (enqueue-agent-command! value backend "resume"))
+         (else
+          (dlna-player-resume! backend)))))
    ((string=? command "stop")
     (stop-playback! value))
    ((string=? command "next")
@@ -711,9 +883,15 @@
          'player-command!
          "seek requires a numeric percentage"))
       (let ((backend (ensure-backend! value)))
-         (if (eq? (player-backend-kind value) 'local)
-             (audio-seek! backend percentage)
-             (dlna-player-seek-percentage! backend percentage)))))
+         (cond
+           ((eq? (player-backend-kind value) 'local)
+            (audio-seek! backend percentage))
+           ((eq? (player-backend-kind value) 'agent)
+            (enqueue-agent-command!
+             value backend "seek"
+             (hasheq 'percentage percentage)))
+           (else
+            (dlna-player-seek-percentage! backend percentage))))))
    ((string=? command "volume")
     (let ((percentage (json-number data 'value #f)))
       (unless percentage
@@ -722,12 +900,18 @@
          "volume requires a numeric value"))
       (let* ((clamped (min 100 (max 0 percentage)))
              (backend (ensure-backend! value)))
-         (if (eq? (player-backend-kind value) 'local)
-             (let ((logical-volume (/ clamped 100.0)))
-               (audio-volume!
-                backend
-                (* 100.0 logical-volume logical-volume)))
-             (dlna-player-volume! backend clamped))
+         (cond
+           ((eq? (player-backend-kind value) 'local)
+            (let ((logical-volume (/ clamped 100.0)))
+              (audio-volume!
+               backend
+               (* 100.0 logical-volume logical-volume))))
+           ((eq? (player-backend-kind value) 'agent)
+            (enqueue-agent-command!
+             value backend "volume"
+             (hasheq 'value clamped)))
+           (else
+            (dlna-player-volume! backend clamped)))
         (with-state-lock
          value
          (λ ()
@@ -757,7 +941,7 @@
         (with-state-lock
          value
          (λ ()
-            (set-player-selected-id! value id))))))
+           (set-player-selected-id! value id))))))
    (else
     (raise-arguments-error
      'player-command!
@@ -782,13 +966,14 @@
              '()))
         (tab (playlist-tab "default" "Default" '())))
    (player libraries
+            '()
            (and library (music-library-id library))
            '()
            browser-entries
            '()
            (list tab)
            0
-            (list (renderer "local" "Dit apparaat" 'local #f))
+            (list (renderer "local" "Server audio output" 'local #f))
            "local"
            #f
            #f
@@ -816,6 +1001,7 @@
 ; result : A JSON-compatible hash.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (player-state->jsexpr value)
+  (prune-stale-agents! value)
  (refresh-network-state! value)
  (with-state-lock
   value
@@ -922,11 +1108,15 @@
              (λ ()
                (set-player-renderers!
                 value
-                 (cons (renderer "local"
-                                 "Dit apparaat"
-                                 'local
-                                 #f)
-                       found))
+                 (append
+                  (list (renderer "local"
+                                  "Server audio output"
+                                  'local
+                                  #f))
+                  found
+                  (filter (λ (item)
+                            (eq? (renderer-kind item) 'agent))
+                          (player-renderers value))))
                (set-player-error! value #f)))))
         (with-state-lock
          value
@@ -934,6 +1124,145 @@
            (set-player-discovering?! value #f))))))
    can-start?))

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Register or refresh one polling playback agent.
+; pre    : Data contains a 256-bit hexadecimal application id.
+; post   : The agent is available as a renderer under its advertised name.
+; result : Agent configuration for the polling client.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (player-agent-register! value data)
+  (let* ((app-id (json-string data 'appId #f))
+         (suggested-name
+          (string-trim
+           (or (json-string data 'name #f)
+               "RKT playback agent"))))
+    (unless (valid-agent-id? app-id)
+      (raise-arguments-error
+       'player-agent-register!
+       "appId must contain exactly 64 hexadecimal characters"
+       "appId" app-id))
+    (with-state-lock
+     value
+     (λ ()
+       (let ((existing (agent-by-id value app-id)))
+         (if existing
+             (begin
+               (set-playback-agent-name! existing suggested-name)
+               (let ((agent-output (agent-renderer value existing)))
+                 (when agent-output
+                   (set-renderer-name! agent-output suggested-name)))
+               (set-playback-agent-last-seen!
+                existing
+                (current-seconds))
+               (hasheq 'name (playback-agent-name existing)
+                       'pollIntervalMs 1000))
+             (let* ((name
+                     (if (string=? suggested-name "")
+                         "RKT playback agent"
+                         suggested-name))
+                    (agent
+                     (playback-agent
+                      app-id name (current-seconds)
+                      (hasheq 'state "stopped"
+                              'position 0
+                              'volume 50)
+                      '() 1 #f #f 0)))
+               (set-player-agents!
+                value
+                (append (player-agents value) (list agent)))
+               (set-player-renderers!
+                value
+                (append
+                 (player-renderers value)
+                 (list (renderer (agent-renderer-id app-id)
+                                 name
+                                 'agent
+                                 agent))))
+               (hasheq 'name name
+                       'pollIntervalMs 1000))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Accept agent state and return its oldest unacknowledged command.
+; pre    : The agent was registered with player-agent-register!.
+; post   : State, heartbeat, acknowledgements and end-of-track are incorporated.
+; result : Poll response containing the current agent name and optional command.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (player-agent-poll! value data)
+  (let ((app-id (json-string data 'appId #f))
+        (name (json-string data 'name #f)))
+    (unless (valid-agent-id? app-id)
+      (raise-arguments-error
+       'player-agent-poll!
+       "appId must contain exactly 64 hexadecimal characters"
+       "appId" app-id))
+    (call-with-semaphore
+     (player-command-lock value)
+     (λ ()
+       (let ((agent (agent-by-id value app-id)))
+         (unless agent
+           (raise-arguments-error
+            'player-agent-poll!
+            "playback agent is not registered"
+            "appId" app-id))
+         (let* ((ack (json-number data 'ack #f))
+                (reported (hash-ref data 'state #f))
+                (ended (json-number data 'endedCounter 0))
+                (previous-ended
+                 (playback-agent-ended-counter agent)))
+           (with-state-lock
+            value
+            (λ ()
+              (set-playback-agent-last-seen! agent (current-seconds))
+              (when (and name
+                         (not (string=? (string-trim name) "")))
+                (let ((trimmed (string-trim name))
+                      (agent-output (agent-renderer value agent)))
+                  (set-playback-agent-name! agent trimmed)
+                  (when agent-output
+                    (set-renderer-name! agent-output trimmed))))
+              (when (hash? reported)
+                (set-playback-agent-reported-state! agent reported))
+              (when (exact-nonnegative-integer? ack)
+                (set-playback-agent-commands!
+                 agent
+                 (filter
+                  (λ (command)
+                    (> (hash-ref command 'id) ack))
+                  (playback-agent-commands agent))))
+              (when (exact-nonnegative-integer? ended)
+                (set-playback-agent-ended-counter! agent ended))))
+           (when (and (> ended previous-ended)
+                      (string=? (player-selected-id value)
+                                (agent-renderer-id app-id))
+                      (eq? (player-backend value) agent))
+             (let ((index (next-index value 1)))
+               (if index
+                   (play-index! value index)
+                   (stop-playback! value))))
+           (hasheq
+            'name (playback-agent-name agent)
+            'command
+            (if (null? (playback-agent-commands agent))
+                'null
+                (car (playback-agent-commands agent))))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Resolve the current opaque media token for one playback agent.
+; pre    : App id and token came from a play command returned by agent polling.
+; post   : No state changes.
+; result : The local track path, or #f when the token is invalid or expired.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (player-agent-media value app-id token)
+  (with-state-lock
+   value
+   (λ ()
+     (let ((agent (and (valid-agent-id? app-id)
+                       (agent-by-id value app-id))))
+       (and agent
+            (string? token)
+            (equal? token (playback-agent-media-token agent))
+            (playback-agent-media-file agent))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Stop playback and release all player resources.
 ; pre    : Value was created with make-player.
@@ -1026,6 +1355,81 @@
           (hasheq 'index 1)))

        (check-equal? (length (hash-ref deleted-state 'tabs)) 1)
+
+        (define test-agent-id
+          (make-string 64 #\a))
+
+        (define registration
+          (player-agent-register!
+           example-player
+           (hasheq 'appId test-agent-id
+                   'name "Test laptop")))
+
+        (check-equal? (hash-ref registration 'name) "Test laptop")
+
+        (define agent-renderer-state
+          (player-command!
+           example-player
+           "renderer"
+           (hasheq 'id (agent-renderer-id test-agent-id))))
+
+        (check-equal?
+         (hash-ref agent-renderer-state 'rendererId)
+         (agent-renderer-id test-agent-id))
+
+        (player-command!
+         example-player
+         "volume"
+         (hasheq 'value 25))
+
+        (define first-poll
+          (player-agent-poll!
+           example-player
+           (hasheq 'appId test-agent-id
+                   'ack 0
+                   'endedCounter 0
+                   'state
+                   (hasheq 'state "stopped"
+                           'position 0
+                           'volume 25))))
+
+        (check-equal?
+         (hash-ref (hash-ref first-poll 'command) 'action)
+         "volume")
+
+        (define first-command-id
+          (hash-ref (hash-ref first-poll 'command) 'id))
+
+        (define acknowledged-poll
+          (player-agent-poll!
+           example-player
+           (hasheq 'appId test-agent-id
+                   'ack first-command-id
+                   'endedCounter 0
+                   'state
+                   (hasheq 'state "stopped"
+                           'position 0
+                           'volume 25))))
+
+        (check-eq? (hash-ref acknowledged-poll 'command) 'null)
+
+        (check-equal?
+         (hash-ref
+          (player-agent-register!
+           example-player
+           (hasheq 'appId test-agent-id
+                   'name "Office laptop"))
+          'name)
+         "Office laptop")
+        (check-equal?
+         (renderer-name
+          (findf
+           (λ (item)
+             (string=? (renderer-id item)
+                       (agent-renderer-id test-agent-id)))
+           (player-renderers example-player)))
+         "Office laptop")
+
        (check-exn exn:fail?
                   (λ ()
                     (player-command!