Compare commits
5 Commits
09121df0d7
..
main
| Author | SHA1 | Date | |
|---|---|---|---|
| 2eb9a9590e | |||
| 4b9e6c5651 | |||
| 365a7b8317 | |||
| a5a53b7efc | |||
| b3a5a0b345 |
@@ -25,3 +25,8 @@ rkt-web-player.ini
|
|||||||
|
|
||||||
# Runtime playlist keystore
|
# Runtime playlist keystore
|
||||||
data/*.keystore*
|
data/*.keystore*
|
||||||
|
/.scribble-build
|
||||||
|
|
||||||
|
# Logging
|
||||||
|
*.log
|
||||||
|
*.log.*
|
||||||
|
|||||||
+47
-17
@@ -47,9 +47,9 @@ flowchart TB
|
|||||||
Audio[racket-audio<br/>local backend]
|
Audio[racket-audio<br/>local backend]
|
||||||
Discovery[racket-upnp + racket-sonos<br/>device discovery]
|
Discovery[racket-upnp + racket-sonos<br/>device discovery]
|
||||||
DLNA[racket-audio-dlna<br/>transport, seeking and media publication]
|
DLNA[racket-audio-dlna<br/>transport, seeking and media publication]
|
||||||
AgentGUI[private/player-agent-gui.rkt<br/>GUI adapter]
|
AgentGUI[private-player-agent/player-agent-gui.rkt<br/>GUI adapter]
|
||||||
AgentCLI[player-agent-cli.rkt<br/>CLI adapter]
|
AgentCLI[player-agent-cli.rkt<br/>CLI adapter]
|
||||||
AgentCore[private/player-agent-core.rkt<br/>polling and audio runtime]
|
AgentCore[private-player-agent/player-agent-core.rkt<br/>polling and audio runtime]
|
||||||
|
|
||||||
Main --> Server
|
Main --> Server
|
||||||
Main --> Player
|
Main --> Player
|
||||||
@@ -139,7 +139,14 @@ volume, and repeat mode.
|
|||||||
Selecting, deleting, or creating a tab stops playback. Tracks are de-duplicated
|
Selecting, deleting, or creating a tab stops playback. Tracks are de-duplicated
|
||||||
by normalized source path when they are appended. Every playlist mutation is
|
by normalized source path when they are appended. Every playlist mutation is
|
||||||
written in one `keystore` transaction. `playlists-for-<username>` contains the
|
written in one `keystore` transaction. `playlists-for-<username>` contains the
|
||||||
ordered playlist GUIDs; each GUID key contains that playlist's name and tracks.
|
ordered open playlist GUIDs; `saved-playlists-for-<username>` contains the saved
|
||||||
|
library playlist GUIDs. Each GUID key contains one playlist's name and tracks.
|
||||||
|
Both indexes are persisted atomically; a value is deleted only when neither
|
||||||
|
index refers to it. Closing a saved tab retains its library entry.
|
||||||
|
`restore-playlist-context` reuses the same in-memory object for a saved playlist
|
||||||
|
and its open tab, so track edits and renaming update both views. Old stores
|
||||||
|
without a saved index restore their original tabs without automatically saving
|
||||||
|
them in the library.
|
||||||
Loading validates every stored track independently against all configured
|
Loading validates every stored track independently against all configured
|
||||||
library roots, so one playlist can safely combine multiple libraries.
|
library roots, so one playlist can safely combine multiple libraries.
|
||||||
`language-for-<username>` stores the user's selected interface language in the
|
`language-for-<username>` stores the user's selected interface language in the
|
||||||
@@ -224,7 +231,7 @@ serves static assets from [`public/`](public/) and exposes these API endpoints:
|
|||||||
|
|
||||||
| Method | Route | Responsibility |
|
| Method | Route | Responsibility |
|
||||||
| --- | --- | --- |
|
| --- | --- | --- |
|
||||||
| `GET` | `/api/state` | Return the complete current state; also refresh network-renderer information. |
|
| `GET` | `/api/state` | Return current state, omitting unchanged tracks when `playlistVersion` matches; also refresh network-renderer information. |
|
||||||
| `POST` | `/api/discover` | Start asynchronous discovery and return the current state. |
|
| `POST` | `/api/discover` | Start asynchronous discovery and return the current state. |
|
||||||
| `POST` | `/api/command/:command` | Execute a command with its JSON request body and return the updated state. |
|
| `POST` | `/api/command/:command` | Execute a command with its JSON request body and return the updated state. |
|
||||||
| `GET` | `/api/preferences` | Return the current user's durable UI preferences. |
|
| `GET` | `/api/preferences` | Return the current user's durable UI preferences. |
|
||||||
@@ -241,20 +248,40 @@ header. Command failures are returned as HTTP 400 JSON responses with an
|
|||||||
|
|
||||||
[`public/app.js`](public/app.js) implements a framework-free client. It:
|
[`public/app.js`](public/app.js) implements a framework-free client. It:
|
||||||
|
|
||||||
- fetches a full state snapshot once per second;
|
- polls status once per second, receiving tracks only when the playlist version changes;
|
||||||
- temporarily suppresses polling while a browser-initiated command is active;
|
- temporarily suppresses polling while a browser-initiated command is active;
|
||||||
- immediately renders the state returned by successful commands;
|
- immediately renders the state returned by successful commands;
|
||||||
- renders library navigation, playlists, tabs, transport status, and output
|
- renders library navigation, playlists, tabs, transport status, and output
|
||||||
selection;
|
selection;
|
||||||
- implements keyboard actions and playlist drag-and-drop in the browser.
|
- implements keyboard actions and playlist drag-and-drop in the browser.
|
||||||
|
|
||||||
|
[`public/playlist-library.js`](public/playlist-library.js) renders the library's
|
||||||
|
Folders/Playlists tabs and saved playlist summaries. `playlist-save` adds an
|
||||||
|
open tab to the library by UUID. `playlist-open` reveals its own tab, reusing an
|
||||||
|
already open tab, and `playlist-play` also starts playback. Neither action copies
|
||||||
|
tracks into an unrelated tab. Only summary metadata is sent in `savedPlaylists`.
|
||||||
|
|
||||||
|
[`public/player-state.js`](public/player-state.js) keeps the active track array
|
||||||
|
in memory and queues state, command and discovery requests. Each request sends
|
||||||
|
the last received `playlistVersion` as a query parameter. A matching response
|
||||||
|
contains `tracks: null`; the client supplies its cached tracks to the renderers.
|
||||||
|
Requests without a version still receive the full list. Queueing prevents
|
||||||
|
responses from being applied out of order.
|
||||||
|
|
||||||
|
The player caches track JSON, count, duration and an opaque version per tab.
|
||||||
|
`save-current-tab!` invalidates this snapshot when the track list changes.
|
||||||
|
Renaming a tab leaves its track snapshot intact. Versions are unique across
|
||||||
|
tabs, users and server restarts. `renderPlaylist` uses the version to decide
|
||||||
|
when to rebuild rows instead of comparing all track metadata on every poll.
|
||||||
|
|
||||||
[`public/translate.js`](public/translate.js) follows the key-based translation
|
[`public/translate.js`](public/translate.js) follows the key-based translation
|
||||||
model used by rktplayer. It supports Dutch, English, German, French, Spanish,
|
model used by rktplayer. It supports Dutch, English, German, French, Spanish,
|
||||||
Italian, Swedish, Norwegian, Finnish and Icelandic with English fallback.
|
Italian, Swedish, Norwegian, Finnish and Icelandic with English fallback.
|
||||||
Browser preferences select the initial language; a
|
Browser preferences select the initial language; a
|
||||||
manual selection is stored server-side per username and therefore follows the
|
manual selection is stored server-side per username and therefore follows the
|
||||||
user across browsers. The native agent uses the equivalent
|
user across browsers. The native agent uses the equivalent
|
||||||
[`private/translate.rkt`](private/translate.rkt) module and the operating-system
|
[`private-player-agent/player-agent-translate.rkt`](private-player-agent/player-agent-translate.rkt)
|
||||||
|
module and the operating-system
|
||||||
language.
|
language.
|
||||||
|
|
||||||
DOM signatures prevent rebuilding unchanged library, tab, and playlist
|
DOM signatures prevent rebuilding unchanged library, tab, and playlist
|
||||||
@@ -313,9 +340,9 @@ sequenceDiagram
|
|||||||
participant D as DLNA renderer
|
participant D as DLNA renderer
|
||||||
|
|
||||||
loop Browser state polling
|
loop Browser state polling
|
||||||
B->>H: GET /api/state
|
B->>H: GET /api/state?playlistVersion=known-version
|
||||||
H->>P: player-state->jsexpr
|
H->>P: player-state->jsexpr
|
||||||
P-->>H: Full state snapshot
|
P-->>H: State and version; tracks only if changed
|
||||||
H-->>B: JSON response
|
H-->>B: JSON response
|
||||||
end
|
end
|
||||||
|
|
||||||
@@ -342,10 +369,11 @@ generally performed outside it, with their results committed in short locked
|
|||||||
sections. Audio callbacks use only the short-lived state lock and update the
|
sections. Audio callbacks use only the short-lived state lock and update the
|
||||||
playback session captured when their backend was created.
|
playback session captured when their backend was created.
|
||||||
|
|
||||||
The server module stores the player in a module-level `current-player` variable.
|
The server module creates one request-dispatcher closure for each `serve-player`
|
||||||
This matches the intended one-player-per-process deployment, but it prevents
|
call. That closure captures its player and authentication manager and binds them
|
||||||
multiple independent player instances from being served safely within the same
|
to every HTTP handler. No player or authentication state is stored in module
|
||||||
Racket process.
|
variables, so independent server instances do not overwrite each other's
|
||||||
|
context within the same Racket process.
|
||||||
|
|
||||||
## 6. Configuration and deployment
|
## 6. Configuration and deployment
|
||||||
|
|
||||||
@@ -386,9 +414,10 @@ random application ID therefore acts as a shared bearer credential, but must
|
|||||||
not be treated as strong authentication when transported over unencrypted HTTP.
|
not be treated as strong authentication when transported over unencrypted HTTP.
|
||||||
|
|
||||||
The GUI and CLI playback agents share one headless runtime. The GUI only adapts
|
The GUI and CLI playback agents share one headless runtime. The GUI only adapts
|
||||||
configuration and state to widgets. Optional tray integration is loaded
|
configuration and state to widgets. It uses `racket-tray` directly for its
|
||||||
dynamically through SDL3, so CLI use and the default GUI installation do not
|
native tray icon, symbolic Open/Exit menu and portable hide-on-minimize
|
||||||
acquire a mandatory SDL dependency.
|
behaviour. The previous SDL3 adapter and its update timer are no longer part of
|
||||||
|
the process.
|
||||||
|
|
||||||
The configured library roots define the intended filesystem boundary. Clients
|
The configured library roots define the intended filesystem boundary. Clients
|
||||||
operate on opaque indexes instead of sending paths directly. The DLNA backend
|
operate on opaque indexes instead of sending paths directly. The DLNA backend
|
||||||
@@ -426,8 +455,9 @@ The main extension points are:
|
|||||||
- **Per-user pipelines, shared outputs:** playlist and transport state are
|
- **Per-user pipelines, shared outputs:** playlist and transport state are
|
||||||
isolated by username. Distinct outputs run concurrently; selecting an
|
isolated by username. Distinct outputs run concurrently; selecting an
|
||||||
occupied output explicitly stops its previous owner and transfers it.
|
occupied output explicitly stops its previous owner and transfers it.
|
||||||
- **Full-state snapshots:** a small and predictable client protocol, at the cost
|
- **Versioned playlists:** cached tracks are transferred only when the selected
|
||||||
of repeatedly transferring all tracks and browser entries.
|
playlist version changes. Other status fields, including browser entries,
|
||||||
|
remain part of each response.
|
||||||
- **One-second polling:** robust and dependency-free, but introduces periodic
|
- **One-second polling:** robust and dependency-free, but introduces periodic
|
||||||
traffic and up to one second of display latency.
|
traffic and up to one second of display latency.
|
||||||
- **Lazy filesystem and backend initialization:** fast startup and low idle
|
- **Lazy filesystem and backend initialization:** fast startup and low idle
|
||||||
|
|||||||
@@ -100,13 +100,24 @@ betrouwbare next-ondersteuning krijgen na het natuurlijke trackeinde een
|
|||||||
servergestuurde fallback. Een expliciet stopcommando start nooit de volgende
|
servergestuurde fallback. Een expliciet stopcommando start nooit de volgende
|
||||||
track.
|
track.
|
||||||
|
|
||||||
|
De bibliotheek links heeft de tabs **Mappen** en **Afspeellijsten**. Met
|
||||||
|
**Afspeellijst opslaan** boven de huidige playlist geef je de tab een naam en
|
||||||
|
bewaar je hem in de bibliotheek. **+** bij een bewaarde playlist opent of
|
||||||
|
selecteert zijn eigen tab; **▶** opent die tab en speelt de playlist af.
|
||||||
|
Een playlist die al open is, krijgt geen tweede tab. De inhoud van andere
|
||||||
|
tabs blijft behouden. Wijzigingen in een bewaarde playlist worden automatisch
|
||||||
|
opgeslagen, ook wanneer je de tab hernoemt. Het kruisje sluit een bewaarde tab;
|
||||||
|
de playlist blijft beschikbaar in de bibliotheek.
|
||||||
|
|
||||||
Playlisttabs kunnen worden toegevoegd, geselecteerd, hernoemd door dubbel te
|
Playlisttabs kunnen worden toegevoegd, geselecteerd, hernoemd door dubbel te
|
||||||
klikken en verwijderd. Tracks kunnen worden afgespeeld, verwijderd en met
|
klikken en gesloten. Tracks kunnen worden afgespeeld, verwijderd en met
|
||||||
drag-and-drop verplaatst. Tabnamen, tabvolgorde en alle tracklijsten worden na
|
drag-and-drop verplaatst. Tabnamen, tabvolgorde en alle tracklijsten worden na
|
||||||
iedere wijziging transactioneel opgeslagen. Een verwijderde
|
iedere wijziging transactioneel opgeslagen. Alleen een gesloten tab die niet
|
||||||
tab verdwijnt daarbij ook uit de keystore. Voor iedere gebruiker bevat de key
|
in de bibliotheek is bewaard, verdwijnt ook uit de keystore. Voor iedere gebruiker
|
||||||
`playlists-for-<username>` de geordende lijst met playlist-GUIDs. Onder iedere
|
bevat `playlists-for-<username>` de geordende lijst met geopende playlist-GUIDs,
|
||||||
GUID-key staan de naam en tracks van die playlist. Tracks uit verschillende
|
en `saved-playlists-for-<username>` de bewaarde playlists. Onder iedere
|
||||||
|
GUID-key staan de naam en tracks van die playlist. Bestaande tabs worden niet
|
||||||
|
automatisch aan de bibliotheek toegevoegd. Tracks uit verschillende
|
||||||
geconfigureerde libraries mogen in dezelfde playlist staan; ontbrekende of
|
geconfigureerde libraries mogen in dezelfde playlist staan; ontbrekende of
|
||||||
buiten de libraries gelegen bestanden worden bij het laden overgeslagen.
|
buiten de libraries gelegen bestanden worden bij het laden overgeslagen.
|
||||||
Iedere aangemelde gebruiker heeft daarbij een eigen playlistverzameling. Als
|
Iedere aangemelde gebruiker heeft daarbij een eigen playlistverzameling. Als
|
||||||
@@ -193,22 +204,20 @@ opgeruimd zodra ze niet meer nodig zijn en bij afsluiten van de agent.
|
|||||||
|
|
||||||
### Systeemvak
|
### Systeemvak
|
||||||
|
|
||||||
De GUI gebruikt optioneel de open-source SDL3-tray-API. Als zowel het Racket-
|
De GUI gebruikt het Racket-pakket `racket-tray`. Minimaliseren en de
|
||||||
pakket `sdl3` als de native SDL3-, SDL3_image- en SDL3_ttf-libraries aanwezig
|
vensterknop verbergen de agent in het systeemvak. Het menu bevat
|
||||||
zijn, sluit de vensterknop de agent naar het systeemvak. Het menu bevat
|
**RKT Web Player Agent openen** en **Afsluiten**; openen herstelt ook een
|
||||||
**RKT Web Player Agent openen** en **Afsluiten**. Zonder SDL3 blijft de agent
|
geminimaliseerd venster. De tray is onderdeel van de normale package-
|
||||||
gewoon werken en sluit de vensterknop het proces af. Er wordt geen PowerShell-
|
dependencies en vereist geen SDL3-pakket of SDL3-libraries meer.
|
||||||
proces of externe tray-helper gestart.
|
|
||||||
|
Windows en macOS gebruiken de native systeemvoorzieningen zonder aanvullende
|
||||||
|
runtime. Op Linux gebruikt `racket-tray` Ayatana AppIndicator voor GTK3. Op
|
||||||
|
Debian en Ubuntu kan die runtime zo worden geïnstalleerd:
|
||||||
|
|
||||||
```console
|
```console
|
||||||
raco pkg install sdl3
|
sudo apt install libayatana-appindicator3-1
|
||||||
```
|
```
|
||||||
|
|
||||||
SDL3 is bewust geen verplichte package-dependency: de agent blijft daardoor
|
|
||||||
klein voor gebruikers die geen systeemvak nodig hebben. Op Windows moeten de
|
|
||||||
bijbehorende native DLL's daarnaast vindbaar zijn, bijvoorbeeld naast het
|
|
||||||
gebouwde executable of via `PATH`.
|
|
||||||
|
|
||||||
### CLI playback agent
|
### CLI playback agent
|
||||||
|
|
||||||
De headless agent gebruikt exact dezelfde polling-, download-, audio- en
|
De headless agent gebruikt exact dezelfde polling-, download-, audio- en
|
||||||
@@ -244,6 +253,8 @@ geen TLS heeft.
|
|||||||
|
|
||||||
```console
|
```console
|
||||||
raco test private/users.rkt private/library.rkt private/player.rkt \
|
raco test private/users.rkt private/library.rkt private/player.rkt \
|
||||||
private/player-agent-config.rkt
|
private/server.rkt private-player-agent/player-agent-config.rkt
|
||||||
|
node tests/player-state.test.mjs
|
||||||
|
node tests/playlist-library.test.mjs
|
||||||
raco setup --check-pkg-deps rkt-web-player
|
raco setup --check-pkg-deps rkt-web-player
|
||||||
```
|
```
|
||||||
|
|||||||
@@ -12,14 +12,16 @@
|
|||||||
"gui-lib"
|
"gui-lib"
|
||||||
"keystore"
|
"keystore"
|
||||||
"libargon2"
|
"libargon2"
|
||||||
|
"net-ip-lib"
|
||||||
"net-lib"
|
"net-lib"
|
||||||
"web-server-lib"
|
"web-server-lib"
|
||||||
"racket-audio"
|
"racket-audio"
|
||||||
"racket-audio-dlna"
|
"racket-audio-dlna"
|
||||||
"racket-mimetypes"
|
"racket-mimetypes"
|
||||||
"racket-sonos"
|
"racket-sonos"
|
||||||
|
"racket-tray"
|
||||||
"racket-upnp"
|
"racket-upnp"
|
||||||
"simple-ini"
|
("simple-ini" #:version "0.3.3")
|
||||||
"simple-log"
|
"simple-log"
|
||||||
"uuid"))
|
"uuid"))
|
||||||
|
|
||||||
|
|||||||
@@ -3,7 +3,6 @@
|
|||||||
(require racket/cmdline
|
(require racket/cmdline
|
||||||
racket/contract
|
racket/contract
|
||||||
racket/list
|
racket/list
|
||||||
racket/mpair
|
|
||||||
racket/runtime-path
|
racket/runtime-path
|
||||||
racket/string
|
racket/string
|
||||||
simple-ini
|
simple-ini
|
||||||
@@ -24,19 +23,19 @@
|
|||||||
(define-runtime-path default-playlist-keystore
|
(define-runtime-path default-playlist-keystore
|
||||||
"data/playlists.keystore")
|
"data/playlists.keystore")
|
||||||
|
|
||||||
|
(define-runtime-path default-log-file
|
||||||
|
"data/rkt-web-player.log")
|
||||||
|
|
||||||
|
;;; Returns the key/value pairs from one INI section in source order.
|
||||||
(define (ini-section-key-values config section-name)
|
(define (ini-section-key-values config section-name)
|
||||||
(let ((section (assoc section-name (mcdr config))))
|
(map (λ (key)
|
||||||
(if section
|
(cons (symbol->string key)
|
||||||
(for/list ((line (in-list (cdr section)))
|
(ini-get config section-name key #f)))
|
||||||
#:when (and (pair? line)
|
(ini-keys config section-name)))
|
||||||
(eq? (car line) 'keyval)))
|
|
||||||
(cons (symbol->string (cadr line))
|
|
||||||
(caddr line)))
|
|
||||||
'())))
|
|
||||||
|
|
||||||
(define (configuration-list value defaults)
|
(define (configuration-list value defaults)
|
||||||
(cond
|
(cond
|
||||||
((list? value) (map (lambda (item) (format "~a" item)) value))
|
((list? value) (map (λ (item) (format "~a" item)) value))
|
||||||
((and (string? value)
|
((and (string? value)
|
||||||
(not (string=? (string-trim value) "")))
|
(not (string=? (string-trim value) "")))
|
||||||
(map string-trim (string-split value ";")))
|
(map string-trim (string-split value ";")))
|
||||||
@@ -65,6 +64,12 @@
|
|||||||
#:local-output? [local-output? #t]
|
#:local-output? [local-output? #t]
|
||||||
#:playlist-keystore
|
#:playlist-keystore
|
||||||
[playlist-keystore default-playlist-keystore]
|
[playlist-keystore default-playlist-keystore]
|
||||||
|
#:log-file
|
||||||
|
[log-file default-log-file]
|
||||||
|
#:log-retention-days
|
||||||
|
[log-retention-days 7]
|
||||||
|
#:log-level
|
||||||
|
[log-level 'debug]
|
||||||
#:launch-browser? [launch-browser? #t])
|
#:launch-browser? [launch-browser? #t])
|
||||||
(->* ((listof library-spec/c))
|
(->* ((listof library-spec/c))
|
||||||
(#:allowed-agent-ids (listof string?)
|
(#:allowed-agent-ids (listof string?)
|
||||||
@@ -76,8 +81,15 @@
|
|||||||
#:dlna-port exact-positive-integer?
|
#:dlna-port exact-positive-integer?
|
||||||
#:local-output? boolean?
|
#:local-output? boolean?
|
||||||
#:playlist-keystore (or/c path-string? #f)
|
#:playlist-keystore (or/c path-string? #f)
|
||||||
|
#:log-file path-string?
|
||||||
|
#:log-retention-days exact-positive-integer?
|
||||||
|
#:log-level symbol?
|
||||||
#:launch-browser? boolean?)
|
#:launch-browser? boolean?)
|
||||||
any)
|
any)
|
||||||
|
|
||||||
|
(sl-log-to-rotating-file log-file log-retention-days)
|
||||||
|
(sl-set-log-level log-level)
|
||||||
|
|
||||||
(let* ((libraries (make-music-libraries music-paths))
|
(let* ((libraries (make-music-libraries music-paths))
|
||||||
(player (make-player libraries
|
(player (make-player libraries
|
||||||
#:allowed-agent-ids allowed-agent-ids
|
#:allowed-agent-ids allowed-agent-ids
|
||||||
@@ -104,6 +116,23 @@
|
|||||||
(λ ()
|
(λ ()
|
||||||
(player-close! player)))))
|
(player-close! player)))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Tests for module main.rkt
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(require rackunit)
|
||||||
|
|
||||||
|
(let ((config (make-ini)))
|
||||||
|
(ini-set! config 'libraries 'music "/srv/music")
|
||||||
|
(ini-set! config 'server 'port 8080)
|
||||||
|
(ini-set! config 'libraries 'archive "/srv/archive")
|
||||||
|
(check-equal?
|
||||||
|
(ini-section-key-values config 'libraries)
|
||||||
|
'(("music" . "/srv/music")
|
||||||
|
("archive" . "/srv/archive")))
|
||||||
|
(check-equal? (ini-section-key-values config 'missing) '())))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Command line
|
;; Command line
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
@@ -115,6 +144,7 @@
|
|||||||
(define playlist-keystore #f)
|
(define playlist-keystore #f)
|
||||||
(define launch-browser? #t)
|
(define launch-browser? #t)
|
||||||
(define config-file #f)
|
(define config-file #f)
|
||||||
|
(define log-file #f)
|
||||||
|
|
||||||
(define music-paths
|
(define music-paths
|
||||||
(command-line
|
(command-line
|
||||||
@@ -138,6 +168,9 @@
|
|||||||
[("--no-browser")
|
[("--no-browser")
|
||||||
"Do not open the web interface automatically"
|
"Do not open the web interface automatically"
|
||||||
(set! launch-browser? #f)]
|
(set! launch-browser? #f)]
|
||||||
|
[("--log-file") path
|
||||||
|
"Log file path, retention is normally set to 7 days, but can be changed in the INI file"
|
||||||
|
(set! log-file path)]
|
||||||
#:args paths
|
#:args paths
|
||||||
paths))
|
paths))
|
||||||
|
|
||||||
@@ -189,7 +222,6 @@
|
|||||||
music-paths
|
music-paths
|
||||||
configured-paths))
|
configured-paths))
|
||||||
|
|
||||||
(sl-log-to-display)
|
|
||||||
(run-web-player
|
(run-web-player
|
||||||
all-libraries
|
all-libraries
|
||||||
#:allowed-agent-ids allowed-agent-ids
|
#:allowed-agent-ids allowed-agent-ids
|
||||||
@@ -211,4 +243,17 @@
|
|||||||
(not (string=? (string-trim (format "~a" configured)) ""))
|
(not (string=? (string-trim (format "~a" configured)) ""))
|
||||||
configured))
|
configured))
|
||||||
default-playlist-keystore)
|
default-playlist-keystore)
|
||||||
#:launch-browser? launch-browser?))
|
#:launch-browser? launch-browser?
|
||||||
|
#:log-file
|
||||||
|
(if (eq? log-file #f)
|
||||||
|
default-log-file
|
||||||
|
(if (eq? (ini-get config 'logging 'log-file #f) #f)
|
||||||
|
log-file
|
||||||
|
(ini-get config 'logging 'log-file default-log-file)))
|
||||||
|
#:log-retention-days
|
||||||
|
(ini-get config 'logging 'log-retention-days 7)
|
||||||
|
#:log-level
|
||||||
|
(string->symbol
|
||||||
|
(format "~a" (ini-get config 'logging 'log-level 'debug)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|||||||
+66
-32
@@ -1,95 +1,129 @@
|
|||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(require racket/cmdline
|
(require racket/cmdline
|
||||||
|
racket/contract
|
||||||
racket/format
|
racket/format
|
||||||
racket/string
|
racket/string
|
||||||
simple-log
|
simple-log
|
||||||
"private/player-agent-config.rkt"
|
"private-player-agent/player-agent-config.rkt"
|
||||||
"private/player-agent-core.rkt")
|
"private-player-agent/player-agent-core.rkt")
|
||||||
|
|
||||||
(provide run-player-agent-cli)
|
(provide run-player-agent-cli)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Supporting functions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Produce a concise description of the current agent track.
|
||||||
|
; pre : track is #f or a server-supplied track hash.
|
||||||
|
; post : No state is changed.
|
||||||
|
; result : Artist and title when available, otherwise title or filename.
|
||||||
|
; internals:
|
||||||
|
; The CLI deliberately uses server metadata and does not reopen the
|
||||||
|
; downloaded media file solely for display purposes.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (track-description track)
|
(define (track-description track)
|
||||||
(cond
|
(cond
|
||||||
((not track) "geen track")
|
((not track) "geen track")
|
||||||
(else
|
(else
|
||||||
(define title (hash-ref track 'title #f))
|
(let ((title (hash-ref track 'title #f))
|
||||||
(define artist (hash-ref track 'artist #f))
|
(artist (hash-ref track 'artist #f))
|
||||||
(define filename (hash-ref track 'filename "onbekend"))
|
(filename (hash-ref track 'filename "onbekend")))
|
||||||
(cond
|
(cond
|
||||||
((and artist title (not (string=? artist "")))
|
((and artist title (not (string=? artist "")))
|
||||||
(format "~a — ~a" artist title))
|
(format "~a — ~a" artist title))
|
||||||
(title title)
|
(title title)
|
||||||
(else filename)))))
|
(else filename))))))
|
||||||
|
|
||||||
(define (run-player-agent-cli #:server-url [server-override #f]
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Provided functions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Run the headless polling playback agent.
|
||||||
|
; pre : Overrides are #f or valid strings/paths and the configured server
|
||||||
|
; is reachable for useful operation.
|
||||||
|
; post : Configuration is persisted; runtime resources are released after
|
||||||
|
; interruption or an exception.
|
||||||
|
; result : Void after the agent has shut down.
|
||||||
|
; internals:
|
||||||
|
; One monitor thread prints only changed playback summaries. The
|
||||||
|
; shared runtime owns polling, downloads, audio and prefetch state.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define/contract (run-player-agent-cli #:server-url [server-override #f]
|
||||||
#:name [name-override #f]
|
#:name [name-override #f]
|
||||||
#:config-file [config-file #f])
|
#:config-file [config-file #f])
|
||||||
|
(->* ()
|
||||||
|
(#:server-url (or/c string? #f)
|
||||||
|
#:name (or/c string? #f)
|
||||||
|
#:config-file (or/c path-string? #f))
|
||||||
|
void?)
|
||||||
(sl-log-to-display)
|
(sl-log-to-display)
|
||||||
(define loaded
|
(let* ((loaded
|
||||||
(if config-file
|
(if config-file
|
||||||
(load-player-agent-config config-file)
|
(load-player-agent-config config-file)
|
||||||
(load-player-agent-config)))
|
(load-player-agent-config)))
|
||||||
(define server-url
|
(server-url
|
||||||
(string-trim (or server-override
|
(string-trim (or server-override
|
||||||
(player-agent-config-server-url loaded))))
|
(player-agent-config-server-url loaded))))
|
||||||
(define name
|
(name
|
||||||
(string-trim (or name-override
|
(string-trim (or name-override
|
||||||
(player-agent-config-name loaded))))
|
(player-agent-config-name loaded))))
|
||||||
(define config
|
(config
|
||||||
(struct-copy player-agent-config loaded
|
(struct-copy player-agent-config loaded
|
||||||
(server-url server-url)
|
(server-url server-url)
|
||||||
(name name)))
|
(name name)))
|
||||||
(save-player-agent-config! config)
|
(write-status
|
||||||
|
(λ (message)
|
||||||
(define (write-status message)
|
|
||||||
(printf "[agent] ~a~n" message)
|
(printf "[agent] ~a~n" message)
|
||||||
(flush-output))
|
(flush-output)))
|
||||||
|
(runtime
|
||||||
(define runtime
|
|
||||||
(make-player-agent-runtime
|
(make-player-agent-runtime
|
||||||
server-url
|
server-url
|
||||||
name
|
name
|
||||||
(player-agent-config-app-id config)
|
(player-agent-config-app-id config)
|
||||||
#:status-callback write-status
|
#:status-callback write-status
|
||||||
#:denied-callback
|
#:denied-callback
|
||||||
(lambda (message)
|
(λ (message)
|
||||||
(eprintf "~a~n" message)
|
(eprintf "~a~n" message)
|
||||||
(flush-output (current-error-port)))))
|
(flush-output (current-error-port)))))
|
||||||
|
(monitor #f))
|
||||||
|
(save-player-agent-config! config)
|
||||||
(printf "RKT Web Player CLI Agent~n")
|
(printf "RKT Web Player CLI Agent~n")
|
||||||
(printf "Naam: ~a~n" name)
|
(printf "Naam: ~a~n" name)
|
||||||
(printf "Server: ~a~n" server-url)
|
(printf "Server: ~a~n" server-url)
|
||||||
(printf "Applicatie-ID: ~a~n" (player-agent-config-app-id config))
|
(printf "Applicatie-ID: ~a~n" (player-agent-config-app-id config))
|
||||||
(printf "Stoppen: Ctrl+C~n")
|
(printf "Stoppen: Ctrl+C~n")
|
||||||
(flush-output)
|
(flush-output)
|
||||||
|
|
||||||
(define monitor #f)
|
|
||||||
(dynamic-wind
|
(dynamic-wind
|
||||||
(lambda ()
|
(λ ()
|
||||||
((player-agent-runtime-start! runtime))
|
((player-agent-runtime-start! runtime))
|
||||||
(set! monitor
|
(set! monitor
|
||||||
(thread
|
(thread
|
||||||
(lambda ()
|
(λ ()
|
||||||
(let loop ((previous #f))
|
(let loop ((previous #f))
|
||||||
(define snapshot
|
(let* ((snapshot
|
||||||
((player-agent-runtime-snapshot runtime)))
|
((player-agent-runtime-snapshot runtime)))
|
||||||
(define summary
|
(summary
|
||||||
(cons (hash-ref snapshot 'state "stopped")
|
(cons
|
||||||
|
(hash-ref snapshot 'state "stopped")
|
||||||
(track-description
|
(track-description
|
||||||
((player-agent-runtime-current-track runtime)))))
|
((player-agent-runtime-current-track runtime))))))
|
||||||
(unless (equal? summary previous)
|
(unless (equal? summary previous)
|
||||||
(printf "[playback] ~a — ~a~n" (car summary) (cdr summary))
|
(printf "[playback] ~a — ~a~n"
|
||||||
|
(car summary)
|
||||||
|
(cdr summary))
|
||||||
(flush-output))
|
(flush-output))
|
||||||
(sleep 1)
|
(sleep 1)
|
||||||
(loop summary))))))
|
(loop summary)))))))
|
||||||
(lambda ()
|
(λ ()
|
||||||
(with-handlers ((exn:break? void))
|
(with-handlers ((exn:break? void))
|
||||||
(sync never-evt)))
|
(sync never-evt)))
|
||||||
(lambda ()
|
(λ ()
|
||||||
(when (and monitor (not (thread-dead? monitor)))
|
(when (and monitor (not (thread-dead? monitor)))
|
||||||
(kill-thread monitor))
|
(kill-thread monitor))
|
||||||
((player-agent-runtime-shutdown! runtime)))))
|
((player-agent-runtime-shutdown! runtime))))))
|
||||||
|
|
||||||
(module+ main
|
(module+ main
|
||||||
(define server-url #f)
|
(define server-url #f)
|
||||||
|
|||||||
+18
-3
@@ -1,5 +1,8 @@
|
|||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
|
(require racket/class
|
||||||
|
racket/contract)
|
||||||
|
|
||||||
(provide run-player-agent
|
(provide run-player-agent
|
||||||
run-player-agent-cli)
|
run-player-agent-cli)
|
||||||
|
|
||||||
@@ -8,9 +11,13 @@
|
|||||||
; pre : A graphical desktop is available.
|
; pre : A graphical desktop is available.
|
||||||
; post : The agent remains active until its window is closed.
|
; post : The agent remains active until its window is closed.
|
||||||
; result : The GUI frame returned by the implementation.
|
; result : The GUI frame returned by the implementation.
|
||||||
|
; internals:
|
||||||
|
; The GUI module is loaded only when this procedure is called. This
|
||||||
|
; keeps command-line use independent of racket/gui initialization.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (run-player-agent)
|
(define/contract (run-player-agent)
|
||||||
((dynamic-require "private/player-agent-gui.rkt"
|
(-> object?)
|
||||||
|
((dynamic-require "private-player-agent/player-agent-gui.rkt"
|
||||||
'run-player-agent-gui)))
|
'run-player-agent-gui)))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
@@ -18,10 +25,18 @@
|
|||||||
; pre : The configured server is reachable.
|
; pre : The configured server is reachable.
|
||||||
; post : The agent remains active until interrupted.
|
; post : The agent remains active until interrupted.
|
||||||
; result : Void after the agent has shut down.
|
; result : Void after the agent has shut down.
|
||||||
|
; internals:
|
||||||
|
; Delayed loading keeps the graphical and headless entrypoints
|
||||||
|
; separate while preserving the existing public module API.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (run-player-agent-cli #:server-url [server-url #f]
|
(define/contract (run-player-agent-cli #:server-url [server-url #f]
|
||||||
#:name [name #f]
|
#:name [name #f]
|
||||||
#:config-file [config-file #f])
|
#:config-file [config-file #f])
|
||||||
|
(->* ()
|
||||||
|
(#:server-url (or/c string? #f)
|
||||||
|
#:name (or/c string? #f)
|
||||||
|
#:config-file (or/c path-string? #f))
|
||||||
|
void?)
|
||||||
((dynamic-require "player-agent-cli.rkt" 'run-player-agent-cli)
|
((dynamic-require "player-agent-cli.rkt" 'run-player-agent-cli)
|
||||||
#:server-url server-url
|
#:server-url server-url
|
||||||
#:name name
|
#:name name
|
||||||
|
|||||||
@@ -0,0 +1,114 @@
|
|||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(require file/sha1
|
||||||
|
racket/contract
|
||||||
|
racket/os
|
||||||
|
racket/path
|
||||||
|
racket/random
|
||||||
|
racket/string
|
||||||
|
simple-ini)
|
||||||
|
|
||||||
|
(provide (struct-out player-agent-config)
|
||||||
|
load-player-agent-config
|
||||||
|
save-player-agent-config!
|
||||||
|
valid-app-id?)
|
||||||
|
|
||||||
|
(struct player-agent-config (file ini app-id server-url name) #:transparent)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Supporting functions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(define (fresh-app-id)
|
||||||
|
(bytes->hex-string (crypto-random-bytes 32)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Provided functions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Recognize a playback-agent application identifier.
|
||||||
|
; pre : value is any Racket value.
|
||||||
|
; post : No state is changed.
|
||||||
|
; result : #t only for a 256-bit identifier encoded as 64 hexadecimal digits.
|
||||||
|
; internals:
|
||||||
|
; Identifiers are accepted case-insensitively and normalized while
|
||||||
|
; loading configuration.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define/contract (valid-app-id? value)
|
||||||
|
(-> any/c boolean?)
|
||||||
|
(and (string? value)
|
||||||
|
(regexp-match? #px"^[0-9a-fA-F]{64}$" value)
|
||||||
|
#t))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Load the playback-agent INI configuration.
|
||||||
|
; pre : file is a writable path-string understood by simple-ini.
|
||||||
|
; post : Missing defaults and a generated application ID are persisted.
|
||||||
|
; result : A player-agent-config value containing normalized settings.
|
||||||
|
; internals:
|
||||||
|
; Reusing the stored application ID preserves the server allowlist;
|
||||||
|
; only a missing or malformed identifier is replaced.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define/contract (load-player-agent-config
|
||||||
|
[file (get-ini-file 'rkt-web-player-agent)])
|
||||||
|
(->* () (path-string?) player-agent-config?)
|
||||||
|
(let* ((ini (file->ini file))
|
||||||
|
(configured-id (ini-get ini 'agent 'app-id #f))
|
||||||
|
(value
|
||||||
|
(player-agent-config
|
||||||
|
file
|
||||||
|
ini
|
||||||
|
(if (valid-app-id? configured-id)
|
||||||
|
(string-downcase configured-id)
|
||||||
|
(fresh-app-id))
|
||||||
|
(ini-get ini 'server 'url "http://127.0.0.1:8080")
|
||||||
|
(ini-get ini 'agent 'name
|
||||||
|
(format "~a playback" (gethostname))))))
|
||||||
|
(save-player-agent-config! value)
|
||||||
|
value))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Persist a playback-agent configuration.
|
||||||
|
; pre : value is a player-agent-config with a writable file path.
|
||||||
|
; post : Its ID, name and server URL are stored in a private INI file.
|
||||||
|
; result : The result returned by simple-ini's ini->file procedure.
|
||||||
|
; internals:
|
||||||
|
; The existing parsed INI value is updated directly so unrelated
|
||||||
|
; settings remain intact.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define/contract (save-player-agent-config! value)
|
||||||
|
(-> player-agent-config? void?)
|
||||||
|
(let ((ini (player-agent-config-ini value)))
|
||||||
|
(ini-set! ini 'agent 'app-id (player-agent-config-app-id value))
|
||||||
|
(ini-set! ini 'agent 'name (player-agent-config-name value))
|
||||||
|
(ini-set! ini 'server 'url (player-agent-config-server-url value))
|
||||||
|
(ini->file ini (player-agent-config-file value) #:private? #t)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Tests for module library.rkt
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(require rackunit
|
||||||
|
racket/file)
|
||||||
|
|
||||||
|
(define test-directory (make-temporary-file "rkt-agent-config-~a" 'directory))
|
||||||
|
(define test-file (build-path test-directory "agent.ini"))
|
||||||
|
(dynamic-wind
|
||||||
|
void
|
||||||
|
(λ ()
|
||||||
|
(let* ((first (load-player-agent-config test-file))
|
||||||
|
(changed
|
||||||
|
(struct-copy player-agent-config first
|
||||||
|
(server-url "https://music.example.test")
|
||||||
|
(name "Test output"))))
|
||||||
|
(check-true (valid-app-id? (player-agent-config-app-id first)))
|
||||||
|
(save-player-agent-config! changed)
|
||||||
|
(let ((second (load-player-agent-config test-file)))
|
||||||
|
(check-equal? (player-agent-config-app-id second)
|
||||||
|
(player-agent-config-app-id first))
|
||||||
|
(check-equal? (player-agent-config-server-url second)
|
||||||
|
"https://music.example.test")
|
||||||
|
(check-equal? (player-agent-config-name second) "Test output"))))
|
||||||
|
(λ () (delete-directory/files test-directory))))
|
||||||
@@ -0,0 +1,524 @@
|
|||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(require json
|
||||||
|
net/url
|
||||||
|
racket-audio
|
||||||
|
racket/contract
|
||||||
|
racket/file
|
||||||
|
racket/path
|
||||||
|
racket/port
|
||||||
|
racket/string
|
||||||
|
simple-log
|
||||||
|
"player-agent-translate.rkt")
|
||||||
|
|
||||||
|
(provide (struct-out player-agent-runtime)
|
||||||
|
make-player-agent-runtime)
|
||||||
|
|
||||||
|
(sl-def-log player-agent)
|
||||||
|
|
||||||
|
(struct exn:fail:agent-denied exn:fail () #:transparent)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Expose the small procedure-based interface of a running agent.
|
||||||
|
; pre : Constructor fields are lifecycle/query procedures and a stable ID.
|
||||||
|
; post : Creating or recognizing a value changes no external state.
|
||||||
|
; result : player-agent-runtime? recognizes values returned by the factory.
|
||||||
|
; internals: make-player-agent-runtime stores its local start!, reconnect!,
|
||||||
|
; shutdown!, snapshot and current-track procedures in this struct.
|
||||||
|
; Those procedures retain access to the factory closure, keeping the
|
||||||
|
; shared polling and audio state private without introducing a class.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(struct player-agent-runtime
|
||||||
|
(start! reconnect! shutdown! snapshot current-track running? app-id)
|
||||||
|
#:transparent)
|
||||||
|
|
||||||
|
;;; Normalizes a configured server address and converts it to a URL value.
|
||||||
|
(define (base-url value)
|
||||||
|
(string->url
|
||||||
|
(regexp-replace #px"/+$" (string-trim value) "")))
|
||||||
|
|
||||||
|
;;; Resolves an agent API path relative to a normalized server URL.
|
||||||
|
(define (endpoint-url base path)
|
||||||
|
(combine-url/relative (base-url base) path))
|
||||||
|
|
||||||
|
;;; Posts JSON to an agent API endpoint and reads its JSON response.
|
||||||
|
;;; Authorization failures receive a distinct exception for poll-loop.
|
||||||
|
(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)))
|
||||||
|
(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))
|
||||||
|
(λ () (close-input-port input)))))
|
||||||
|
|
||||||
|
;;; Converts racket-audio states to the state names sent to the web player.
|
||||||
|
(define (normal-state state)
|
||||||
|
(cond
|
||||||
|
((memq state '(initialized no-media)) "stopped")
|
||||||
|
((eq? state 'transitioning) "starting")
|
||||||
|
(else (symbol->string state))))
|
||||||
|
|
||||||
|
;;; Deletes a temporary media file and logs recoverable deletion failures.
|
||||||
|
(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))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Provided functions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Create the headless polling and audio runtime for one agent.
|
||||||
|
; pre : Server URL, display name and application ID are strings; callbacks
|
||||||
|
; accept the status/denial messages supplied to them.
|
||||||
|
; post : Mutable state is initialized but no worker thread or audio backend
|
||||||
|
; is started until the returned start! procedure is called.
|
||||||
|
; result : A player-agent-runtime containing its lifecycle/query procedures.
|
||||||
|
; internals: start! launches poll-loop, which registers through post-json and
|
||||||
|
; sends snapshots until it receives a command. A command worker runs
|
||||||
|
; execute-command! and acknowledges it only after completion.
|
||||||
|
; ensure-audio! connects racket-audio callbacks to update-from-audio!
|
||||||
|
; and advance-at-decoder-eof!. with-agent-state protects their shared
|
||||||
|
; state; stop! and shutdown! stop threads, audio and cached files.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define/contract (make-player-agent-runtime initial-server-url
|
||||||
|
initial-name
|
||||||
|
app-id
|
||||||
|
#:status-callback
|
||||||
|
[status-callback void]
|
||||||
|
#:denied-callback
|
||||||
|
[denied-callback void])
|
||||||
|
(->* (string? string? string?)
|
||||||
|
(#:status-callback (-> string? any/c)
|
||||||
|
#:denied-callback (-> string? any/c))
|
||||||
|
player-agent-runtime?)
|
||||||
|
(let* ((server-url initial-server-url)
|
||||||
|
(assigned-name initial-name)
|
||||||
|
(state-lock (make-semaphore 1))
|
||||||
|
(worker #f)
|
||||||
|
(command-worker #f)
|
||||||
|
(executing-command-id 0)
|
||||||
|
(running #f)
|
||||||
|
(authorization-notified? #f)
|
||||||
|
(audio #f)
|
||||||
|
(current-media-key #f)
|
||||||
|
(cached-media (make-hash))
|
||||||
|
(prefetched-track #f)
|
||||||
|
(auto-started-key #f)
|
||||||
|
(pending-auto-music-id #f)
|
||||||
|
(music-tracks (make-hash))
|
||||||
|
(current-track-value #f)
|
||||||
|
(acknowledged-command 0)
|
||||||
|
(ended-counter 0)
|
||||||
|
(logical-volume 50)
|
||||||
|
(agent-state
|
||||||
|
(hasheq 'state "stopped"
|
||||||
|
'position 0
|
||||||
|
'duration 'null
|
||||||
|
'rate 'null
|
||||||
|
'channels 'null
|
||||||
|
'bits 'null
|
||||||
|
'format ""
|
||||||
|
'volume logical-volume
|
||||||
|
'error 'null)))
|
||||||
|
|
||||||
|
;;; Runs a procedure while holding the semaphore for shared agent state.
|
||||||
|
(define (with-agent-state proc)
|
||||||
|
(call-with-semaphore state-lock proc))
|
||||||
|
|
||||||
|
;;; Replaces an unavailable state value with its JSON fallback.
|
||||||
|
(define (state-value value fallback)
|
||||||
|
(if (eq? value #f) fallback value))
|
||||||
|
|
||||||
|
;;; Returns the latest audio state while holding the state semaphore.
|
||||||
|
(define (snapshot)
|
||||||
|
(with-agent-state (λ () agent-state)))
|
||||||
|
|
||||||
|
;;; Returns the currently audible track while holding the state semaphore.
|
||||||
|
(define (current-track)
|
||||||
|
(with-agent-state (λ () current-track-value)))
|
||||||
|
|
||||||
|
;;; Stores an error in the state reported by the next poll.
|
||||||
|
(define (set-agent-error! message)
|
||||||
|
(with-agent-state
|
||||||
|
(λ ()
|
||||||
|
(set! agent-state (hash-set agent-state 'error message)))))
|
||||||
|
|
||||||
|
;;; Removes an earlier error from the state reported by the next poll.
|
||||||
|
(define (clear-agent-error!)
|
||||||
|
(with-agent-state
|
||||||
|
(λ ()
|
||||||
|
(set! agent-state (hash-set agent-state 'error 'null)))))
|
||||||
|
|
||||||
|
;;; Copies racket-audio state into the agent snapshot.
|
||||||
|
;;; It also confirms when a prefetched track has become audible.
|
||||||
|
(define (update-from-audio! state full-state)
|
||||||
|
(with-agent-state
|
||||||
|
(λ ()
|
||||||
|
(let ((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))
|
||||||
|
(let ((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)))))))
|
||||||
|
|
||||||
|
;;; Creates and configures the audio player on first use.
|
||||||
|
;;; Its callbacks update reported state and continue prefetched playback.
|
||||||
|
(define (ensure-audio!)
|
||||||
|
(unless audio
|
||||||
|
(set! audio
|
||||||
|
(make-audio-player
|
||||||
|
(λ (_handle state full-state)
|
||||||
|
(update-from-audio! state full-state))
|
||||||
|
(λ (handle)
|
||||||
|
(advance-at-decoder-eof! handle))))
|
||||||
|
(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)
|
||||||
|
|
||||||
|
;;; Downloads one protected media resource to a temporary local file.
|
||||||
|
;;; A failed download closes its port and removes its partial file.
|
||||||
|
(define (download-media! token filename)
|
||||||
|
(let* ((extension
|
||||||
|
(or (path-get-extension (string->path filename)) #""))
|
||||||
|
(target
|
||||||
|
(make-temporary-file
|
||||||
|
(string-append "rkt-player-agent-~a"
|
||||||
|
(bytes->string/utf-8 extension))))
|
||||||
|
(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)))
|
||||||
|
|
||||||
|
;;; Selects the stable cache key carried by a playback command.
|
||||||
|
(define (command-cache-key data)
|
||||||
|
(hash-ref data 'cacheKey (hash-ref data 'mediaToken)))
|
||||||
|
|
||||||
|
;;; Returns cached media or downloads and records it when absent.
|
||||||
|
(define (ensure-media-cached! data)
|
||||||
|
(let* ((key (command-cache-key data))
|
||||||
|
(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))))
|
||||||
|
|
||||||
|
;;; Removes every cached media file except the entry identified by keep-key.
|
||||||
|
(define (discard-unused-media! keep-key)
|
||||||
|
(let loop ((remaining (hash->list cached-media)))
|
||||||
|
(unless (null? remaining)
|
||||||
|
(let ((entry (car remaining)))
|
||||||
|
(unless (equal? (car entry) keep-key)
|
||||||
|
(safe-delete-file (cdr entry))
|
||||||
|
(hash-remove! cached-media (car entry))))
|
||||||
|
(loop (cdr remaining)))))
|
||||||
|
|
||||||
|
;;; Continues with prefetched media when the current decoder reaches EOF.
|
||||||
|
;;; Decoder EOF precedes audible EOF, so audio-play! queues behind the buffer.
|
||||||
|
(define (advance-at-decoder-eof! handle)
|
||||||
|
(let ((prepared
|
||||||
|
(with-agent-state
|
||||||
|
(λ ()
|
||||||
|
(let ((value prefetched-track))
|
||||||
|
(set! prefetched-track #f)
|
||||||
|
value)))))
|
||||||
|
(cond
|
||||||
|
(prepared
|
||||||
|
(let* ((data (car prepared))
|
||||||
|
(path (cdr prepared))
|
||||||
|
(key (command-cache-key data)))
|
||||||
|
(with-handlers
|
||||||
|
((exn:fail?
|
||||||
|
(λ (exception)
|
||||||
|
(warn-player-agent "Could not start prefetched track: ~a"
|
||||||
|
(exn-message exception))
|
||||||
|
(set-agent-error! (exn-message exception))
|
||||||
|
(with-agent-state
|
||||||
|
(λ () (set! ended-counter (+ ended-counter 1)))))))
|
||||||
|
(let ((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
|
||||||
|
(λ ()
|
||||||
|
(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
|
||||||
|
(λ () (set! ended-counter (+ ended-counter 1))))))))
|
||||||
|
|
||||||
|
;;; Applies one server command to audio, cache and reported agent state.
|
||||||
|
;;; Play and prefetch commands also maintain gapless track bookkeeping.
|
||||||
|
(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")
|
||||||
|
(let* ((next-key (command-cache-key data))
|
||||||
|
(already-started?
|
||||||
|
(with-agent-state
|
||||||
|
(λ ()
|
||||||
|
(let ((matches?
|
||||||
|
(and auto-started-key
|
||||||
|
(equal? auto-started-key next-key))))
|
||||||
|
(when matches?
|
||||||
|
(set! auto-started-key #f))
|
||||||
|
matches?)))))
|
||||||
|
(with-agent-state
|
||||||
|
(λ () (set! current-track-value data)))
|
||||||
|
(unless already-started?
|
||||||
|
(with-agent-state
|
||||||
|
(λ ()
|
||||||
|
(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))))
|
||||||
|
(let* ((next-media (ensure-media-cached! data))
|
||||||
|
;; audio-play! interrupts and closes the previous decoder.
|
||||||
|
(music-id (audio-play! (ensure-audio!) next-media)))
|
||||||
|
(with-agent-state
|
||||||
|
(λ ()
|
||||||
|
(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")
|
||||||
|
(let ((key (command-cache-key data))
|
||||||
|
(path (ensure-media-cached! data)))
|
||||||
|
(with-agent-state
|
||||||
|
(λ () (set! prefetched-track (cons data path))))
|
||||||
|
(info-player-agent "Prefetched ~a"
|
||||||
|
(hash-ref data 'filename "track"))
|
||||||
|
(let loop ((remaining (hash->list cached-media)))
|
||||||
|
(unless (null? remaining)
|
||||||
|
(let ((entry (car remaining)))
|
||||||
|
(unless (or (equal? (car entry) current-media-key)
|
||||||
|
(equal? (car entry) key))
|
||||||
|
(safe-delete-file (cdr entry))
|
||||||
|
(hash-remove! cached-media (car entry))))
|
||||||
|
(loop (cdr remaining))))))
|
||||||
|
((string=? action "pause")
|
||||||
|
(audio-pause! (ensure-audio!) #t))
|
||||||
|
((string=? action "resume")
|
||||||
|
(audio-pause! (ensure-audio!) #f))
|
||||||
|
((string=? action "stop")
|
||||||
|
(with-agent-state
|
||||||
|
(λ ()
|
||||||
|
(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))))
|
||||||
|
(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)))))
|
||||||
|
|
||||||
|
;;; Registers the agent and repeatedly exchanges state for server commands.
|
||||||
|
;;; Connection and authorization failures are reported before a delayed retry.
|
||||||
|
(define (poll-loop)
|
||||||
|
(with-handlers
|
||||||
|
((exn:fail:agent-denied?
|
||||||
|
(λ (exception)
|
||||||
|
(let ((message (format (tr 'denied-message) app-id)))
|
||||||
|
(warn-player-agent "Agent authorization refused: ~a"
|
||||||
|
(exn-message exception))
|
||||||
|
(set-agent-error! message)
|
||||||
|
(status-callback
|
||||||
|
(tr 'unauthorized-status))
|
||||||
|
(unless authorization-notified?
|
||||||
|
(set! authorization-notified? #t)
|
||||||
|
(denied-callback message))
|
||||||
|
(when running
|
||||||
|
(sleep 3)
|
||||||
|
(poll-loop)))))
|
||||||
|
(exn:fail?
|
||||||
|
(λ (exception)
|
||||||
|
(warn-player-agent "Connection cycle failed: ~a"
|
||||||
|
(exn-message exception))
|
||||||
|
(set-agent-error! (exn-message exception))
|
||||||
|
(status-callback
|
||||||
|
(format (tr 'disconnected) (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 (tr 'connected))
|
||||||
|
(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 (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)))))
|
||||||
|
|
||||||
|
;;; Starts the polling worker once and reports the connecting state.
|
||||||
|
(define (start!)
|
||||||
|
(unless running
|
||||||
|
(set! running #t)
|
||||||
|
(status-callback (tr 'connecting))
|
||||||
|
(set! worker (thread poll-loop))))
|
||||||
|
|
||||||
|
;;; Stops polling and command workers and clears their lifecycle state.
|
||||||
|
(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))
|
||||||
|
|
||||||
|
;;; Restarts the runtime with a new normalized server address and name.
|
||||||
|
(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!))
|
||||||
|
|
||||||
|
;;; Stops the runtime, closes audio and removes all cached media files.
|
||||||
|
(define (shutdown!)
|
||||||
|
(stop!)
|
||||||
|
(when audio
|
||||||
|
(with-handlers ((exn:fail? void))
|
||||||
|
(audio-quit! audio))
|
||||||
|
(set! audio #f))
|
||||||
|
(let loop ((paths (hash-values cached-media)))
|
||||||
|
(unless (null? paths)
|
||||||
|
(safe-delete-file (car paths))
|
||||||
|
(loop (cdr paths))))
|
||||||
|
(hash-clear! cached-media))
|
||||||
|
|
||||||
|
(player-agent-runtime start!
|
||||||
|
reconnect!
|
||||||
|
shutdown!
|
||||||
|
snapshot
|
||||||
|
current-track
|
||||||
|
(λ () running)
|
||||||
|
app-id)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Tests for module player-agent-core.rkt
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(require rackunit)
|
||||||
|
|
||||||
|
(check-equal? (normal-state 'initialized) "stopped")
|
||||||
|
(check-equal? (normal-state 'transitioning) "starting")
|
||||||
|
(check-equal? (normal-state 'playing) "playing")
|
||||||
|
|
||||||
|
(let* ((app-id (make-string 64 #\a))
|
||||||
|
(runtime
|
||||||
|
(make-player-agent-runtime "http://127.0.0.1:1234"
|
||||||
|
"Test agent"
|
||||||
|
app-id)))
|
||||||
|
(check-false ((player-agent-runtime-running? runtime)))
|
||||||
|
(check-false ((player-agent-runtime-current-track runtime)))
|
||||||
|
(check-equal?
|
||||||
|
(hash-ref ((player-agent-runtime-snapshot runtime)) 'state)
|
||||||
|
"stopped")
|
||||||
|
(check-equal? (player-agent-runtime-app-id runtime) app-id)))
|
||||||
@@ -0,0 +1,417 @@
|
|||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(require racket/class
|
||||||
|
racket/contract
|
||||||
|
racket/format
|
||||||
|
racket/gui/base
|
||||||
|
racket/os
|
||||||
|
racket/runtime-path
|
||||||
|
racket/string
|
||||||
|
racket-tray
|
||||||
|
simple-log
|
||||||
|
"player-agent-config.rkt"
|
||||||
|
"player-agent-core.rkt"
|
||||||
|
"player-agent-translate.rkt")
|
||||||
|
|
||||||
|
(provide run-player-agent-gui)
|
||||||
|
|
||||||
|
(sl-def-log player-agent-gui)
|
||||||
|
|
||||||
|
(define log-file
|
||||||
|
(build-path (find-system-path 'pref-dir)
|
||||||
|
"rkt-web-player-agent.log"))
|
||||||
|
|
||||||
|
(define-runtime-path tray-icon
|
||||||
|
"../public/rkt-web-player.png")
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Supporting functions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Create a labelled text field with compact editor padding.
|
||||||
|
; pre : label and init-value are strings; panel accepts GUI children.
|
||||||
|
; post : A text field has been added to panel.
|
||||||
|
; result : The newly created text-field% object.
|
||||||
|
; internals:
|
||||||
|
; Padding is set on the editor because it renders consistently on
|
||||||
|
; the supported desktop platforms.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define (input-field label init-value panel)
|
||||||
|
(let ((field
|
||||||
|
(new text-field%
|
||||||
|
(parent panel)
|
||||||
|
(label label)
|
||||||
|
(init-value init-value))))
|
||||||
|
(send (send field get-editor) set-padding 0 2 0 2)
|
||||||
|
field))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Format a playback position as hours, minutes and seconds.
|
||||||
|
; pre : value is any Racket value.
|
||||||
|
; post : No state is changed.
|
||||||
|
; result : A zero-padded HH:MM:SS string; invalid values are treated as zero.
|
||||||
|
; internals:
|
||||||
|
; Fractional seconds are deliberately rounded down so the displayed
|
||||||
|
; position never runs ahead of the audio runtime.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(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"))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Provided functions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Start the graphical polling playback agent.
|
||||||
|
; pre : A graphical desktop and the platform support required by
|
||||||
|
; racket-tray are available.
|
||||||
|
; post : The agent runtime is started, its frame and tray icon are visible,
|
||||||
|
; and closing or minimizing the frame hides it in the system tray.
|
||||||
|
; result : The live frame% object belonging to the playback agent.
|
||||||
|
; internals:
|
||||||
|
; The GUI owns only widgets, configuration and lifecycle callbacks.
|
||||||
|
; Playback and polling remain in player-agent-core.rkt. racket-tray
|
||||||
|
; owns native tray resources and the portable minimize watcher.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define/contract (run-player-agent-gui)
|
||||||
|
(-> (is-a?/c frame%))
|
||||||
|
(sl-log-to-file log-file)
|
||||||
|
(let ((config (load-player-agent-config))
|
||||||
|
(frame #f)
|
||||||
|
(runtime #f)
|
||||||
|
(status-message #f)
|
||||||
|
(playback-message #f)
|
||||||
|
(playback-details #f)
|
||||||
|
(playback-filename #f)
|
||||||
|
(name-field #f)
|
||||||
|
(server-field #f)
|
||||||
|
(connect-button #f)
|
||||||
|
(playback-timer #f)
|
||||||
|
(tray #f)
|
||||||
|
(shutting-down? #f))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Queue a status-label update in the GUI eventspace.
|
||||||
|
; pre : message is a string supplied by the agent runtime.
|
||||||
|
; post : The status widget shows message when it has been created.
|
||||||
|
; result : Unspecified.
|
||||||
|
; internals:
|
||||||
|
; Runtime callbacks can originate outside the GUI eventspace, so
|
||||||
|
; widget access is always forwarded with queue-callback.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define (show-status! message)
|
||||||
|
(queue-callback
|
||||||
|
(λ ()
|
||||||
|
(when status-message
|
||||||
|
(send status-message set-label message)))
|
||||||
|
#f))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Show a playback-agent authorization failure.
|
||||||
|
; pre : message is a string supplied by the agent runtime.
|
||||||
|
; post : A modal error dialog is queued for the agent frame.
|
||||||
|
; result : Unspecified.
|
||||||
|
; internals:
|
||||||
|
; The callback is eventspace-safe for the same reason as the
|
||||||
|
; status callback above.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define (show-denial! message)
|
||||||
|
(queue-callback
|
||||||
|
(λ ()
|
||||||
|
(message-box (tr 'denied-title)
|
||||||
|
message
|
||||||
|
frame
|
||||||
|
'(ok stop)))
|
||||||
|
#f))
|
||||||
|
|
||||||
|
(set! runtime
|
||||||
|
(make-player-agent-runtime
|
||||||
|
(player-agent-config-server-url config)
|
||||||
|
(player-agent-config-name config)
|
||||||
|
(player-agent-config-app-id config)
|
||||||
|
#:status-callback show-status!
|
||||||
|
#:denied-callback show-denial!))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Refresh the visible playback summary from the runtime cache.
|
||||||
|
; pre : runtime exists; the widgets may still be uninitialized.
|
||||||
|
; post : Initialized playback widgets reflect one coherent cached
|
||||||
|
; snapshot and its current track.
|
||||||
|
; result : Unspecified.
|
||||||
|
; internals:
|
||||||
|
; This procedure never performs network I/O. The timer reads only
|
||||||
|
; the cache maintained by player-agent-core.rkt.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define (refresh-playback-status!)
|
||||||
|
(when (and playback-message playback-details playback-filename)
|
||||||
|
(let* ((snapshot ((player-agent-runtime-snapshot runtime)))
|
||||||
|
(track ((player-agent-runtime-current-track runtime)))
|
||||||
|
(state (hash-ref snapshot 'state "stopped"))
|
||||||
|
(title (and track (hash-ref track 'title #f)))
|
||||||
|
(artist (and track (hash-ref track 'artist #f)))
|
||||||
|
(filename (and track (hash-ref track 'filename #f)))
|
||||||
|
(track-number (and track (hash-ref track 'trackNumber #f)))
|
||||||
|
(track-label
|
||||||
|
(cond
|
||||||
|
((and artist (not (string=? artist "")) title)
|
||||||
|
(format "~a — ~a" artist title))
|
||||||
|
(title title)
|
||||||
|
(else (tr 'no-track-selected))))
|
||||||
|
(prefix
|
||||||
|
(cond
|
||||||
|
((string=? state "playing") (tr 'playing))
|
||||||
|
((string=? state "paused") (tr 'paused))
|
||||||
|
((string=? state "starting") (tr 'loading))
|
||||||
|
((string=? state "stopped") (tr 'stopped))
|
||||||
|
(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))
|
||||||
|
(bits (hash-ref snapshot 'bits 'null))
|
||||||
|
(channels (hash-ref snapshot 'channels 'null))
|
||||||
|
(details
|
||||||
|
(filter
|
||||||
|
(λ (value) (not (string=? value "")))
|
||||||
|
(list
|
||||||
|
(format "~a / ~a"
|
||||||
|
(format-time position)
|
||||||
|
(if (number? duration)
|
||||||
|
(format-time duration)
|
||||||
|
"--:--:--"))
|
||||||
|
(if (number? bits) (format "~a bit" bits) "")
|
||||||
|
(if (number? rate)
|
||||||
|
(format "~a kHz"
|
||||||
|
(~r (/ rate 1000.0) #:precision '(= 1)))
|
||||||
|
"")
|
||||||
|
(if (number? channels)
|
||||||
|
(format "~a ~a"
|
||||||
|
channels
|
||||||
|
(tr (if (= channels 1) 'channel 'channels)))
|
||||||
|
"")
|
||||||
|
(if (and (string? format-name)
|
||||||
|
(not (string=? format-name "")))
|
||||||
|
format-name
|
||||||
|
"")))))
|
||||||
|
(send playback-message
|
||||||
|
set-label
|
||||||
|
(if track
|
||||||
|
(format "~a~a: ~a"
|
||||||
|
prefix
|
||||||
|
(if (number? track-number)
|
||||||
|
(format " #~a" track-number)
|
||||||
|
"")
|
||||||
|
track-label)
|
||||||
|
(tr 'no-track)))
|
||||||
|
(send playback-details set-label (string-join details " · "))
|
||||||
|
(send playback-filename
|
||||||
|
set-label
|
||||||
|
(if (and (string? filename)
|
||||||
|
(not (string=? filename "")))
|
||||||
|
filename
|
||||||
|
"—")))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Persist edited connection settings and reconnect the runtime.
|
||||||
|
; pre : The name, server and connect widgets have been initialized.
|
||||||
|
; post : config and the INI file contain normalized values; the runtime
|
||||||
|
; reconnects with them and the button becomes a reconnect button.
|
||||||
|
; result : Unspecified.
|
||||||
|
; internals:
|
||||||
|
; An empty name receives the same hostname-based default used by
|
||||||
|
; initial configuration loading.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define (reconnect!)
|
||||||
|
(let* ((next-server (string-trim (send server-field get-value)))
|
||||||
|
(entered-name (string-trim (send name-field get-value)))
|
||||||
|
(next-name
|
||||||
|
(if (string=? entered-name "")
|
||||||
|
(format "~a playback" (gethostname))
|
||||||
|
entered-name)))
|
||||||
|
(set! config
|
||||||
|
(struct-copy player-agent-config config
|
||||||
|
(server-url next-server)
|
||||||
|
(name next-name)))
|
||||||
|
(save-player-agent-config! config)
|
||||||
|
(send name-field set-value next-name)
|
||||||
|
((player-agent-runtime-reconnect! runtime) next-server next-name)
|
||||||
|
(send connect-button set-label (tr 'reconnect))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Release resources owned by the GUI agent exactly once.
|
||||||
|
; pre : runtime has been created; timer and tray may be #f.
|
||||||
|
; post : Playback polling, audio, the GUI timer and native tray resources
|
||||||
|
; have stopped; subsequent calls do nothing.
|
||||||
|
; result : Unspecified.
|
||||||
|
; internals:
|
||||||
|
; The guard makes this procedure safe from both the window close
|
||||||
|
; path and the tray Exit action.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define (shutdown!)
|
||||||
|
(unless shutting-down?
|
||||||
|
(set! shutting-down? #t)
|
||||||
|
(when playback-timer
|
||||||
|
(send playback-timer stop))
|
||||||
|
((player-agent-runtime-shutdown! runtime))
|
||||||
|
(when tray
|
||||||
|
(tray-close tray)
|
||||||
|
(set! tray #f))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Terminate the graphical agent from its tray menu.
|
||||||
|
; pre : frame and runtime have been initialized.
|
||||||
|
; post : Resources are released and the frame is hidden.
|
||||||
|
; result : Unspecified.
|
||||||
|
; internals:
|
||||||
|
; racket-tray invokes actions in the frame eventspace, so no
|
||||||
|
; additional GUI callback queue is needed here.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define (quit!)
|
||||||
|
(shutdown!)
|
||||||
|
(send frame show #f))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Restore the agent frame from the tray.
|
||||||
|
; pre : frame has been initialized and has not been destroyed.
|
||||||
|
; post : frame is visible and no longer iconized.
|
||||||
|
; result : Unspecified.
|
||||||
|
; internals:
|
||||||
|
; De-iconizing is needed because racket-tray hides minimized
|
||||||
|
; frames instead of changing their iconized state.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define (show-window!)
|
||||||
|
(send frame show #t)
|
||||||
|
(when (send frame is-iconized?)
|
||||||
|
(send frame iconize #f)))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Dispatch a symbolic racket-tray action.
|
||||||
|
; pre : action is installed in the tray menu below.
|
||||||
|
; post : 'open restores the frame; 'exit shuts down the agent.
|
||||||
|
; result : Unspecified.
|
||||||
|
; internals:
|
||||||
|
; One callback handles both direct tray activation and menu
|
||||||
|
; selection on every platform.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define (tray-action! action)
|
||||||
|
(case action
|
||||||
|
((open) (show-window!))
|
||||||
|
((exit) (quit!))))
|
||||||
|
|
||||||
|
(let* ((agent-frame%
|
||||||
|
(class frame%
|
||||||
|
(super-new)
|
||||||
|
(define/augment (on-close)
|
||||||
|
(if tray
|
||||||
|
(send this show #f)
|
||||||
|
(begin
|
||||||
|
(shutdown!)
|
||||||
|
(inner (void) on-close))))))
|
||||||
|
(new-frame
|
||||||
|
(new agent-frame%
|
||||||
|
(label (tr 'app-title))
|
||||||
|
(width 560)
|
||||||
|
(height 310))))
|
||||||
|
(set! frame new-frame))
|
||||||
|
|
||||||
|
(let* ((panel
|
||||||
|
(new vertical-panel%
|
||||||
|
(parent frame)
|
||||||
|
(alignment '(left top))))
|
||||||
|
(server
|
||||||
|
(input-field (tr 'server)
|
||||||
|
(player-agent-config-server-url config)
|
||||||
|
panel))
|
||||||
|
(name
|
||||||
|
(input-field (tr 'name)
|
||||||
|
(player-agent-config-name config)
|
||||||
|
panel))
|
||||||
|
(id-field
|
||||||
|
(input-field (tr 'application-id)
|
||||||
|
(player-agent-config-app-id config)
|
||||||
|
panel))
|
||||||
|
(playback-panel
|
||||||
|
(new group-box-panel%
|
||||||
|
(parent panel)
|
||||||
|
(label (tr 'playback))
|
||||||
|
(alignment '(left top))
|
||||||
|
(stretchable-height #f)))
|
||||||
|
(controls
|
||||||
|
(new horizontal-panel%
|
||||||
|
(parent panel)
|
||||||
|
(alignment '(left center)))))
|
||||||
|
(set! server-field server)
|
||||||
|
(set! name-field name)
|
||||||
|
;; Lock the editor, not the native widget. Disabled Windows controls
|
||||||
|
;; render their label and text poorly on some display configurations.
|
||||||
|
(send (send id-field get-editor) lock #t)
|
||||||
|
(set! playback-message
|
||||||
|
(new message%
|
||||||
|
(parent playback-panel)
|
||||||
|
(label (tr 'no-track))
|
||||||
|
(auto-resize #t)))
|
||||||
|
(set! playback-details
|
||||||
|
(new message%
|
||||||
|
(parent playback-panel)
|
||||||
|
(label "00:00:00 / --:--:--")
|
||||||
|
(auto-resize #t)))
|
||||||
|
(set! playback-filename
|
||||||
|
(new message%
|
||||||
|
(parent playback-panel)
|
||||||
|
(label "—")
|
||||||
|
(auto-resize #t)))
|
||||||
|
(set! connect-button
|
||||||
|
(new button%
|
||||||
|
(parent controls)
|
||||||
|
(label (tr 'save-connect))
|
||||||
|
(callback (λ (_button _event) (reconnect!)))))
|
||||||
|
(set! status-message
|
||||||
|
(new message%
|
||||||
|
(parent controls)
|
||||||
|
(label (tr 'connecting))
|
||||||
|
(auto-resize #t))))
|
||||||
|
|
||||||
|
(set! playback-timer
|
||||||
|
(new timer%
|
||||||
|
(notify-callback refresh-playback-status!)
|
||||||
|
(interval 500)))
|
||||||
|
(refresh-playback-status!)
|
||||||
|
|
||||||
|
(set! tray
|
||||||
|
(mk-tray frame
|
||||||
|
tray-icon
|
||||||
|
(list tray-action! 'open)
|
||||||
|
#:hide-on-minimize? #t))
|
||||||
|
(tray-set-menu!
|
||||||
|
tray
|
||||||
|
(list
|
||||||
|
(list 'open (tr 'tray-open))
|
||||||
|
'separator
|
||||||
|
(list 'exit (tr 'quit))))
|
||||||
|
|
||||||
|
(send frame show #t)
|
||||||
|
((player-agent-runtime-start! runtime))
|
||||||
|
(send connect-button set-label (tr 'reconnect))
|
||||||
|
frame))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Tests for module library.rkt
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(require rackunit)
|
||||||
|
|
||||||
|
;; The runtime path must remain valid after package installation; relying on
|
||||||
|
;; the development working directory would make the tray fail elsewhere.
|
||||||
|
(check-true (file-exists? tray-icon)))
|
||||||
@@ -335,6 +335,10 @@
|
|||||||
(define (__ id)
|
(define (__ id)
|
||||||
(tr id))
|
(tr id))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Tests for module library.rkt
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(require rackunit)
|
(require rackunit)
|
||||||
|
|
||||||
+226
-118
@@ -43,81 +43,107 @@
|
|||||||
lock)
|
lock)
|
||||||
#:transparent)
|
#:transparent)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Supporting functions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(define playback-start-timeout-ms 8000)
|
(define playback-start-timeout-ms 8000)
|
||||||
|
|
||||||
|
;;; Returns the current time used to measure renderer start delays.
|
||||||
(define (now-ms)
|
(define (now-ms)
|
||||||
(current-inexact-milliseconds))
|
(current-inexact-milliseconds))
|
||||||
|
|
||||||
|
;;; Maps renderer-specific transport states to the web player's states.
|
||||||
(define (normalize-state state)
|
(define (normalize-state state)
|
||||||
(cond
|
(cond
|
||||||
((eq? state 'transitioning) 'starting)
|
((eq? state 'transitioning) 'starting)
|
||||||
((member state '(initialized no-media)) 'stopped)
|
((member state '(initialized no-media)) 'stopped)
|
||||||
(else state)))
|
(else state)))
|
||||||
|
|
||||||
|
;;; Determines whether state or position confirms that playback has started.
|
||||||
;; Position reporting is optional and notably unreliable on some Denon
|
;; Position reporting is optional and notably unreliable on some Denon
|
||||||
;; renderers. PLAYING, TRANSITIONING or PAUSED is itself confirmation that the
|
;; renderers. PLAYING, TRANSITIONING or PAUSED is itself confirmation that the
|
||||||
;; renderer accepted the transport. A positive position remains useful for
|
;; renderer accepted the transport. A positive position remains useful for
|
||||||
;; devices whose transport state lags behind their position response.
|
;; devices whose transport state lags behind their position response.
|
||||||
(define (renderer-confirms-playback? state position)
|
(define (renderer-confirms-playback? state position)
|
||||||
(or (and (member state '(playing starting paused)) #t)
|
(cond
|
||||||
(and (number? position) (> position 0))))
|
((member state '(playing starting paused)) #t)
|
||||||
|
((and (number? position) (> position 0)) #t)
|
||||||
|
(else #f)))
|
||||||
|
|
||||||
|
;;; Runs a playback operation while holding its synchronization lock.
|
||||||
(define (with-lock playback proc)
|
(define (with-lock playback proc)
|
||||||
(call-with-semaphore (dlna-playback-lock playback) proc))
|
(call-with-semaphore (dlna-playback-lock playback) proc))
|
||||||
|
|
||||||
|
;;; Reads the current playlist through the callback supplied by the owner.
|
||||||
(define (current-tracks playback)
|
(define (current-tracks playback)
|
||||||
((dlna-playback-tracks playback)))
|
((dlna-playback-tracks playback)))
|
||||||
|
|
||||||
|
;;; Checks whether index identifies a track in the current playlist.
|
||||||
(define (valid-index? playback index)
|
(define (valid-index? playback index)
|
||||||
(and (exact-nonnegative-integer? index)
|
(and (exact-nonnegative-integer? index)
|
||||||
(< index (length (current-tracks playback)))))
|
(< index (length (current-tracks playback)))))
|
||||||
|
|
||||||
|
;;; Returns the track at index, or #f when the index is invalid.
|
||||||
(define (track-at playback index)
|
(define (track-at playback index)
|
||||||
(and (valid-index? playback index)
|
(if (valid-index? playback index)
|
||||||
(list-ref (current-tracks playback) index)))
|
(list-ref (current-tracks playback) index)
|
||||||
|
#f))
|
||||||
|
|
||||||
|
;;; Produces a complete path string for stable renderer file comparison.
|
||||||
(define (normalized-file file)
|
(define (normalized-file file)
|
||||||
(with-handlers ((exn:fail? (lambda (_) (format "~a" file))))
|
(with-handlers ((exn:fail? (λ (_) (format "~a" file))))
|
||||||
(path->string (path->complete-path file))))
|
(path->string (path->complete-path file))))
|
||||||
|
|
||||||
|
;;; Compares two track files using the path rules of the current platform.
|
||||||
(define (same-file? first second)
|
(define (same-file? first second)
|
||||||
(and first
|
(cond
|
||||||
second
|
((eq? first #f) #f)
|
||||||
((if (eq? (system-type 'os) 'windows)
|
((eq? second #f) #f)
|
||||||
|
(else
|
||||||
|
(let ((same-path? (if (eq? (system-type 'os) 'windows)
|
||||||
string-ci=?
|
string-ci=?
|
||||||
string=?)
|
string=?)))
|
||||||
(normalized-file first)
|
(same-path? (normalized-file first)
|
||||||
(normalized-file second))))
|
(normalized-file second))))))
|
||||||
|
|
||||||
|
;;; Selects the following playlist index according to the repeat setting.
|
||||||
(define (next-index playback index)
|
(define (next-index playback index)
|
||||||
(define count (length (current-tracks playback)))
|
(let ((count (length (current-tracks playback))))
|
||||||
(cond
|
(cond
|
||||||
((zero? count) #f)
|
((zero? count) #f)
|
||||||
((eq? (dlna-playback-repeat playback) 'one) index)
|
((eq? (dlna-playback-repeat playback) 'one) index)
|
||||||
((< (+ index 1) count) (+ index 1))
|
((< (+ index 1) count) (+ index 1))
|
||||||
((eq? (dlna-playback-repeat playback) 'all) 0)
|
((eq? (dlna-playback-repeat playback) 'all) 0)
|
||||||
(else #f)))
|
(else #f))))
|
||||||
|
|
||||||
|
;;; Finds the playlist index represented by renderer metadata.
|
||||||
|
;;; A prepared index is checked first before searching the complete playlist.
|
||||||
(define (track-index-for-info playback info)
|
(define (track-index-for-info playback info)
|
||||||
(define info-track (dlna-info-track info))
|
(let* ((info-track (dlna-info-track info))
|
||||||
(define file (and info-track (dlna-track-info-file info-track)))
|
(file (if (eq? info-track #f)
|
||||||
(define prepared (dlna-playback-prepared-index playback))
|
#f
|
||||||
(cond
|
(dlna-track-info-file info-track)))
|
||||||
((and (valid-index? playback prepared)
|
(prepared (dlna-playback-prepared-index playback)))
|
||||||
|
(if (and (valid-index? playback prepared)
|
||||||
(same-file? file (track-file (track-at playback prepared))))
|
(same-file? file (track-file (track-at playback prepared))))
|
||||||
prepared)
|
prepared
|
||||||
|
(let loop ((remaining (current-tracks playback))
|
||||||
|
(index 0))
|
||||||
|
(cond
|
||||||
|
((null? remaining) #f)
|
||||||
|
((same-file? file (track-file (car remaining))) index)
|
||||||
(else
|
(else
|
||||||
(for/first ((item (in-list (current-tracks playback)))
|
(loop (cdr remaining) (add1 index))))))))
|
||||||
(index (in-naturals))
|
|
||||||
#:when (same-file? file (track-file item)))
|
|
||||||
index))))
|
|
||||||
|
|
||||||
|
;;; Sends the current playback state and renderer information to the owner.
|
||||||
(define (notify! playback state info)
|
(define (notify! playback state info)
|
||||||
((dlna-playback-update playback)
|
((dlna-playback-update playback)
|
||||||
state
|
state
|
||||||
(dlna-playback-current-index playback)
|
(dlna-playback-current-index playback)
|
||||||
info))
|
info))
|
||||||
|
|
||||||
|
;;; Records a playback failure and forwards its detail to the error callback.
|
||||||
(define (report-failure! playback detail)
|
(define (report-failure! playback detail)
|
||||||
(set-dlna-playback-playing-seen?! playback #f)
|
(set-dlna-playback-playing-seen?! playback #f)
|
||||||
(set-dlna-playback-progress-seen?! playback #f)
|
(set-dlna-playback-progress-seen?! playback #f)
|
||||||
@@ -126,17 +152,18 @@
|
|||||||
(set-dlna-playback-stopped-polls! playback 0)
|
(set-dlna-playback-stopped-polls! playback 0)
|
||||||
((dlna-playback-error playback) detail))
|
((dlna-playback-error playback) detail))
|
||||||
|
|
||||||
|
;;; Prepares the next track on renderers that support gapless continuation.
|
||||||
(define (prepare-next! playback)
|
(define (prepare-next! playback)
|
||||||
(define current (dlna-playback-current-index playback))
|
(let ((current (dlna-playback-current-index playback)))
|
||||||
(when (valid-index? playback current)
|
(when (valid-index? playback current)
|
||||||
(define following (next-index playback current))
|
(let ((following (next-index playback current)))
|
||||||
(cond
|
(cond
|
||||||
((not following)
|
((eq? following #f)
|
||||||
(set-dlna-playback-prepared-index! playback #f))
|
(set-dlna-playback-prepared-index! playback #f))
|
||||||
((not (equal? following (dlna-playback-prepared-index playback)))
|
((not (equal? following (dlna-playback-prepared-index playback)))
|
||||||
(with-handlers
|
(with-handlers
|
||||||
((exn:fail?
|
((exn:fail?
|
||||||
(lambda (exception)
|
(λ (exception)
|
||||||
(set-dlna-playback-prepared-index! playback #f)
|
(set-dlna-playback-prepared-index! playback #f)
|
||||||
(warn-web-player-dlna
|
(warn-web-player-dlna
|
||||||
"Could not prepare next DLNA track: ~a"
|
"Could not prepare next DLNA track: ~a"
|
||||||
@@ -144,10 +171,11 @@
|
|||||||
(dlna-player-set-next-file!
|
(dlna-player-set-next-file!
|
||||||
(dlna-playback-player playback)
|
(dlna-playback-player playback)
|
||||||
(track-file (track-at playback following)))
|
(track-file (track-at playback following)))
|
||||||
(set-dlna-playback-prepared-index! playback following))))))
|
(set-dlna-playback-prepared-index! playback following))))))))
|
||||||
|
|
||||||
|
;;; Starts one playlist item while the caller holds the playback lock.
|
||||||
(define (play-index/locked! playback index)
|
(define (play-index/locked! playback index)
|
||||||
(define item (track-at playback index))
|
(let ((item (track-at playback index)))
|
||||||
(unless item
|
(unless item
|
||||||
(raise-arguments-error
|
(raise-arguments-error
|
||||||
'dlna-playback-play-index!
|
'dlna-playback-play-index!
|
||||||
@@ -155,11 +183,11 @@
|
|||||||
"index" index))
|
"index" index))
|
||||||
(with-handlers
|
(with-handlers
|
||||||
((exn:fail?
|
((exn:fail?
|
||||||
(lambda (exception)
|
(λ (exception)
|
||||||
(report-failure! playback (exn-message exception))
|
(report-failure! playback (exn-message exception))
|
||||||
(raise exception))))
|
(raise exception))))
|
||||||
(dlna-player-play! (dlna-playback-player playback) (track-file item))
|
(dlna-player-play! (dlna-playback-player playback) (track-file item))
|
||||||
(define info (dlna-player-info (dlna-playback-player playback)))
|
(let ((info (dlna-player-info (dlna-playback-player playback))))
|
||||||
(set-dlna-playback-current-index! playback index)
|
(set-dlna-playback-current-index! playback index)
|
||||||
(set-dlna-playback-current-uri! playback (dlna-info-uri info))
|
(set-dlna-playback-current-uri! playback (dlna-info-uri info))
|
||||||
(set-dlna-playback-prepared-index! playback #f)
|
(set-dlna-playback-prepared-index! playback #f)
|
||||||
@@ -170,68 +198,89 @@
|
|||||||
(set-dlna-playback-stop-requested?! playback #f)
|
(set-dlna-playback-stop-requested?! playback #f)
|
||||||
(set-dlna-playback-stopped-polls! playback 0)
|
(set-dlna-playback-stopped-polls! playback 0)
|
||||||
(notify! playback 'starting info)
|
(notify! playback 'starting info)
|
||||||
(prepare-next! playback)))
|
(prepare-next! playback)))))
|
||||||
|
|
||||||
|
;;; Updates the current index when renderer metadata identifies another track.
|
||||||
(define (update-current-track! playback info)
|
(define (update-current-track! playback info)
|
||||||
(define index (track-index-for-info playback info))
|
(let ((index (track-index-for-info playback info)))
|
||||||
(when (valid-index? playback index)
|
(when (valid-index? playback index)
|
||||||
(unless (equal? index (dlna-playback-current-index playback))
|
(unless (equal? index (dlna-playback-current-index playback))
|
||||||
(set-dlna-playback-progress-seen?! playback #f)
|
(set-dlna-playback-progress-seen?! playback #f)
|
||||||
(set-dlna-playback-play-request-ms! playback (now-ms)))
|
(set-dlna-playback-play-request-ms! playback (now-ms)))
|
||||||
(set-dlna-playback-current-index! playback index)
|
(set-dlna-playback-current-index! playback index)
|
||||||
(set-dlna-playback-prepared-index! playback #f)
|
(set-dlna-playback-prepared-index! playback #f)
|
||||||
(prepare-next! playback)))
|
(prepare-next! playback))))
|
||||||
|
|
||||||
|
;;; Advances to the next track or stops when the playlist has ended.
|
||||||
(define (advance! playback)
|
(define (advance! playback)
|
||||||
(define current (dlna-playback-current-index playback))
|
(let* ((current (dlna-playback-current-index playback))
|
||||||
(define following (and (valid-index? playback current)
|
(following (if (valid-index? playback current)
|
||||||
(next-index playback current)))
|
(next-index playback current)
|
||||||
(if following
|
#f)))
|
||||||
(play-index/locked! playback following)
|
(if (eq? following #f)
|
||||||
(begin
|
(begin
|
||||||
(dlna-player-stop! (dlna-playback-player playback))
|
(dlna-player-stop! (dlna-playback-player playback))
|
||||||
(notify! playback
|
(notify! playback
|
||||||
'stopped
|
'stopped
|
||||||
(dlna-player-info (dlna-playback-player playback))))))
|
(dlna-player-info (dlna-playback-player playback))))
|
||||||
|
(play-index/locked! playback following))))
|
||||||
|
|
||||||
(define (poll/locked! playback)
|
;;; Processes one successful renderer poll while the playback lock is held.
|
||||||
(define info (dlna-player-info (dlna-playback-player playback)))
|
;;; It updates track identity, start confirmation and end-of-track handling.
|
||||||
(cond
|
(define (poll-reachable/locked! playback info)
|
||||||
((not (dlna-info-reachable? info))
|
(let ((state (normalize-state (dlna-info-state info)))
|
||||||
(when (dlna-playback-reachable? playback)
|
(uri (dlna-info-uri info))
|
||||||
(set-dlna-playback-reachable?! playback #f)
|
(position (dlna-info-position info)))
|
||||||
((dlna-playback-error playback) "De DLNA-renderer is niet bereikbaar")))
|
|
||||||
(else
|
|
||||||
(set-dlna-playback-reachable?! playback #t)
|
(set-dlna-playback-reachable?! playback #t)
|
||||||
(define state (normalize-state (dlna-info-state info)))
|
|
||||||
(define uri (dlna-info-uri info))
|
|
||||||
(define position (dlna-info-position info))
|
|
||||||
(define failed-now? #f)
|
|
||||||
|
|
||||||
(when (and (string? uri)
|
(when (and (string? uri)
|
||||||
(not (string=? uri ""))
|
(not (string=? uri ""))
|
||||||
(not (equal? uri (dlna-playback-current-uri playback))))
|
(not (equal? uri (dlna-playback-current-uri playback))))
|
||||||
(set-dlna-playback-current-uri! playback uri)
|
(set-dlna-playback-current-uri! playback uri)
|
||||||
(set-dlna-playback-stopped-polls! playback 0)
|
(set-dlna-playback-stopped-polls! playback 0)
|
||||||
(update-current-track! playback info))
|
(update-current-track! playback info))
|
||||||
|
|
||||||
(when (renderer-confirms-playback? state position)
|
(when (renderer-confirms-playback? state position)
|
||||||
(set-dlna-playback-progress-seen?! playback #t))
|
(set-dlna-playback-progress-seen?! playback #t))
|
||||||
|
(let* ((request-ms (dlna-playback-play-request-ms playback))
|
||||||
(when (and (dlna-playback-playing-seen? playback)
|
(elapsed-ms (if (eq? request-ms #f)
|
||||||
|
#f
|
||||||
|
(- (now-ms) request-ms)))
|
||||||
|
(failed-now?
|
||||||
|
(and (dlna-playback-playing-seen? playback)
|
||||||
(not (dlna-playback-progress-seen? playback))
|
(not (dlna-playback-progress-seen? playback))
|
||||||
(dlna-playback-play-request-ms playback)
|
elapsed-ms
|
||||||
(>= (- (now-ms)
|
(>= elapsed-ms playback-start-timeout-ms))))
|
||||||
(dlna-playback-play-request-ms playback))
|
;;; Handles a stopped renderer after start and progress checks complete.
|
||||||
playback-start-timeout-ms))
|
(define (handle-stopped!)
|
||||||
(set! failed-now? #t)
|
(cond
|
||||||
|
((and (not (dlna-playback-progress-seen? playback))
|
||||||
|
elapsed-ms
|
||||||
|
(< elapsed-ms 5000))
|
||||||
|
(void))
|
||||||
|
((not (dlna-playback-progress-seen? playback))
|
||||||
|
(warn-web-player-dlna
|
||||||
|
"DLNA renderer stopped without confirming playback: position=~a uri=~a"
|
||||||
|
position (or uri ""))
|
||||||
|
(report-failure!
|
||||||
|
playback
|
||||||
|
'dlna-renderer-no-start-of-track-confirmation))
|
||||||
|
(else
|
||||||
|
(set-dlna-playback-stopped-polls!
|
||||||
|
playback
|
||||||
|
(+ 1 (dlna-playback-stopped-polls playback)))
|
||||||
|
;; Give SetNextAVTransportURI one poll to take over. Some renderers
|
||||||
|
;; need the explicit fallback on the next poll.
|
||||||
|
(when (or (eq? (dlna-playback-prepared-index playback) #f)
|
||||||
|
(> (dlna-playback-stopped-polls playback) 1))
|
||||||
|
(set-dlna-playback-playing-seen?! playback #f)
|
||||||
|
(set-dlna-playback-stopped-polls! playback 0)
|
||||||
|
(advance! playback)))))
|
||||||
|
(when failed-now?
|
||||||
(warn-web-player-dlna
|
(warn-web-player-dlna
|
||||||
"DLNA start was not confirmed: state=~a position=~a uri=~a"
|
"DLNA start was not confirmed: state=~a position=~a uri=~a"
|
||||||
state position (or uri ""))
|
state position (or uri ""))
|
||||||
(report-failure!
|
(report-failure!
|
||||||
playback
|
playback
|
||||||
"De DLNA-renderer bevestigde de start van de track niet"))
|
'dlna-renderer-no-start-of-track-confirmation))
|
||||||
|
|
||||||
(unless (or failed-now? (dlna-playback-failure-active? playback))
|
(unless (or failed-now? (dlna-playback-failure-active? playback))
|
||||||
(cond
|
(cond
|
||||||
((eq? state 'playing)
|
((eq? state 'playing)
|
||||||
@@ -243,42 +292,29 @@
|
|||||||
(set-dlna-playback-stopped-polls! playback 0))
|
(set-dlna-playback-stopped-polls! playback 0))
|
||||||
((and (eq? state 'stopped)
|
((and (eq? state 'stopped)
|
||||||
(dlna-playback-playing-seen? playback))
|
(dlna-playback-playing-seen? playback))
|
||||||
(cond
|
(handle-stopped!))))
|
||||||
((and (not (dlna-playback-progress-seen? playback))
|
|
||||||
(dlna-playback-play-request-ms playback)
|
|
||||||
(< (- (now-ms)
|
|
||||||
(dlna-playback-play-request-ms playback))
|
|
||||||
5000))
|
|
||||||
(void))
|
|
||||||
((not (dlna-playback-progress-seen? playback))
|
|
||||||
(warn-web-player-dlna
|
|
||||||
"DLNA renderer stopped without confirming playback: position=~a uri=~a"
|
|
||||||
position (or uri ""))
|
|
||||||
(report-failure!
|
|
||||||
playback
|
|
||||||
"De DLNA-renderer bevestigde de start van de track niet"))
|
|
||||||
(else
|
|
||||||
(set-dlna-playback-stopped-polls!
|
|
||||||
playback
|
|
||||||
(+ 1 (dlna-playback-stopped-polls playback)))
|
|
||||||
;; Give SetNextAVTransportURI one poll to take over. Some
|
|
||||||
;; renderers need the explicit fallback on the following poll.
|
|
||||||
(when (or (not (dlna-playback-prepared-index playback))
|
|
||||||
(> (dlna-playback-stopped-polls playback) 1))
|
|
||||||
(set-dlna-playback-playing-seen?! playback #f)
|
|
||||||
(set-dlna-playback-stopped-polls! playback 0)
|
|
||||||
(advance! playback)))))))
|
|
||||||
|
|
||||||
(notify!
|
(notify!
|
||||||
playback
|
playback
|
||||||
(cond
|
(cond
|
||||||
((or failed-now? (dlna-playback-failure-active? playback)) 'stopped)
|
((or failed-now? (dlna-playback-failure-active? playback))
|
||||||
|
'stopped)
|
||||||
((and (dlna-playback-playing-seen? playback)
|
((and (dlna-playback-playing-seen? playback)
|
||||||
(not (dlna-playback-progress-seen? playback)))
|
(not (dlna-playback-progress-seen? playback)))
|
||||||
'starting)
|
'starting)
|
||||||
(else state))
|
(else state))
|
||||||
info))))
|
info))))
|
||||||
|
|
||||||
|
;;; Polls the renderer and reports a transition to an unreachable state once.
|
||||||
|
(define (poll/locked! playback)
|
||||||
|
(let ((info (dlna-player-info (dlna-playback-player playback))))
|
||||||
|
(if (dlna-info-reachable? info)
|
||||||
|
(poll-reachable/locked! playback info)
|
||||||
|
(when (dlna-playback-reachable? playback)
|
||||||
|
(set-dlna-playback-reachable?! playback #f)
|
||||||
|
((dlna-playback-error playback)
|
||||||
|
'dlna-renderer-unreachable)))))
|
||||||
|
|
||||||
|
;;; Polls the renderer until playback is closed, logging recoverable failures.
|
||||||
(define (monitor-loop playback poll-seconds)
|
(define (monitor-loop playback poll-seconds)
|
||||||
(let loop ()
|
(let loop ()
|
||||||
(when (dlna-playback-running? playback)
|
(when (dlna-playback-running? playback)
|
||||||
@@ -286,19 +322,28 @@
|
|||||||
(when (dlna-playback-running? playback)
|
(when (dlna-playback-running? playback)
|
||||||
(with-handlers
|
(with-handlers
|
||||||
((exn:fail?
|
((exn:fail?
|
||||||
(lambda (exception)
|
(λ (exception)
|
||||||
(warn-web-player-dlna
|
(warn-web-player-dlna
|
||||||
"Could not update DLNA playback state: ~a"
|
"Could not update DLNA playback state: ~a"
|
||||||
(exn-message exception)))))
|
(exn-message exception)))))
|
||||||
(with-lock playback (lambda () (poll/locked! playback))))
|
(with-lock playback (λ () (poll/locked! playback))))
|
||||||
(loop)))))
|
(loop)))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Provided functions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : Create playlist-aware playback for one network renderer.
|
; goal : Create playlist-aware playback for one network renderer.
|
||||||
; pre : Device is a media renderer, callbacks are procedures, and
|
; pre : Device is a media renderer, callbacks are procedures, and
|
||||||
; media-server is a running shared media-file-server.
|
; media-server is a running shared media-file-server.
|
||||||
; post : A DLNA player and its state-monitor thread are running.
|
; post : A DLNA player and its state-monitor thread are running.
|
||||||
; result : A playback adapter that publishes through the supplied server.
|
; result : A playback adapter that publishes through the supplied server.
|
||||||
|
; internals: make-dlna-player creates the renderer interface; monitor-loop polls
|
||||||
|
; it periodically. poll/locked! reconciles URI, transport state and
|
||||||
|
; position with the playlist and reports updates, failures or track
|
||||||
|
; advancement. with-lock orders polls and commands using the
|
||||||
|
; dlna-playback-lock accessor generated for the struct's lock field.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (make-dlna-playback device
|
(define (make-dlna-playback device
|
||||||
tracks
|
tracks
|
||||||
@@ -306,39 +351,66 @@
|
|||||||
error
|
error
|
||||||
#:media-file-server media-server
|
#:media-file-server media-server
|
||||||
#:poll-seconds [poll-seconds 1])
|
#:poll-seconds [poll-seconds 1])
|
||||||
(define raw
|
(let* ((raw (make-dlna-player device
|
||||||
(make-dlna-player device
|
|
||||||
#:media-file-server media-server))
|
#:media-file-server media-server))
|
||||||
(define playback
|
(playback
|
||||||
(dlna-playback raw tracks update error 'off #f #f #f
|
(dlna-playback raw tracks update error 'off #f #f #f
|
||||||
#f #f #f #f 0 #f #t #t #f
|
#f #f #f #f 0 #f #t #t #f
|
||||||
(make-semaphore 1)))
|
(make-semaphore 1))))
|
||||||
(set-dlna-playback-monitor!
|
(set-dlna-playback-monitor!
|
||||||
playback
|
playback
|
||||||
(thread (λ () (monitor-loop playback poll-seconds))))
|
(thread (λ () (monitor-loop playback poll-seconds))))
|
||||||
playback)
|
playback))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Start the track at index in the current playlist.
|
||||||
|
; pre : Playback is open and index identifies an existing track.
|
||||||
|
; post : The renderer starts the track and the next track is prepared.
|
||||||
|
; result : The result of the synchronized playback operation.
|
||||||
|
; internals: Playback state changes and callbacks run while holding the lock.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (dlna-playback-play-index! playback index)
|
(define (dlna-playback-play-index! playback index)
|
||||||
(with-lock playback (lambda () (play-index/locked! playback index))))
|
(with-lock playback (λ () (play-index/locked! playback index))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Pause the current renderer transport.
|
||||||
|
; pre : Playback is open and the renderer accepts pause requests.
|
||||||
|
; post : The renderer is paused and listeners receive the new state.
|
||||||
|
; result : The result of the synchronized playback operation.
|
||||||
|
; internals: The renderer is queried immediately after the pause request.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (dlna-playback-pause! playback)
|
(define (dlna-playback-pause! playback)
|
||||||
(with-lock
|
(with-lock
|
||||||
playback
|
playback
|
||||||
(lambda ()
|
(λ ()
|
||||||
(dlna-player-pause! (dlna-playback-player playback))
|
(dlna-player-pause! (dlna-playback-player playback))
|
||||||
(notify! playback 'paused (dlna-player-info (dlna-playback-player playback))))))
|
(notify! playback 'paused (dlna-player-info (dlna-playback-player playback))))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Resume the paused renderer transport.
|
||||||
|
; pre : Playback is open and the renderer accepts resume requests.
|
||||||
|
; post : The renderer is playing and listeners receive the new state.
|
||||||
|
; result : The result of the synchronized playback operation.
|
||||||
|
; internals: The renderer is queried immediately after the resume request.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (dlna-playback-resume! playback)
|
(define (dlna-playback-resume! playback)
|
||||||
(with-lock
|
(with-lock
|
||||||
playback
|
playback
|
||||||
(lambda ()
|
(λ ()
|
||||||
(dlna-player-resume! (dlna-playback-player playback))
|
(dlna-player-resume! (dlna-playback-player playback))
|
||||||
(notify! playback 'playing (dlna-player-info (dlna-playback-player playback))))))
|
(notify! playback 'playing (dlna-player-info (dlna-playback-player playback))))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Stop the current renderer transport.
|
||||||
|
; pre : Playback is open.
|
||||||
|
; post : Pending start and failure state is cleared and listeners see stopped.
|
||||||
|
; result : The result of the synchronized playback operation.
|
||||||
|
; internals: stop-requested? distinguishes this stop from a finished track.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (dlna-playback-stop! playback)
|
(define (dlna-playback-stop! playback)
|
||||||
(with-lock
|
(with-lock
|
||||||
playback
|
playback
|
||||||
(lambda ()
|
(λ ()
|
||||||
(set-dlna-playback-stop-requested?! playback #t)
|
(set-dlna-playback-stop-requested?! playback #t)
|
||||||
(set-dlna-playback-playing-seen?! playback #f)
|
(set-dlna-playback-playing-seen?! playback #f)
|
||||||
(set-dlna-playback-progress-seen?! playback #f)
|
(set-dlna-playback-progress-seen?! playback #f)
|
||||||
@@ -348,47 +420,79 @@
|
|||||||
(dlna-player-stop! (dlna-playback-player playback))
|
(dlna-player-stop! (dlna-playback-player playback))
|
||||||
(notify! playback 'stopped (dlna-player-info (dlna-playback-player playback))))))
|
(notify! playback 'stopped (dlna-player-info (dlna-playback-player playback))))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Seek to a percentage of the current track.
|
||||||
|
; pre : Playback is open and percentage is accepted by the DLNA player.
|
||||||
|
; post : The renderer position and listener state reflect the requested seek.
|
||||||
|
; result : The result of the synchronized playback operation.
|
||||||
|
; internals: The synchronously refreshed DLNA cache is published immediately.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (dlna-playback-seek-percentage! playback percentage)
|
(define (dlna-playback-seek-percentage! playback percentage)
|
||||||
(with-lock
|
(with-lock
|
||||||
playback
|
playback
|
||||||
(lambda ()
|
(λ ()
|
||||||
(dlna-player-seek-percentage! (dlna-playback-player playback) percentage)
|
(dlna-player-seek-percentage! (dlna-playback-player playback) percentage)
|
||||||
;; racket-audio-dlna updates its cache synchronously after Seek. Publish
|
;; racket-audio-dlna updates its cache synchronously after Seek. Publish
|
||||||
;; that value immediately so the web slider does not jump back.
|
;; that value immediately so the web slider does not jump back.
|
||||||
(define info (dlna-player-info (dlna-playback-player playback)))
|
(let ((info (dlna-player-info (dlna-playback-player playback))))
|
||||||
(notify! playback
|
(notify! playback
|
||||||
(normalize-state (dlna-info-state info))
|
(normalize-state (dlna-info-state info))
|
||||||
info))))
|
info)))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Set the renderer volume to a percentage.
|
||||||
|
; pre : Playback is open and percentage is accepted by the DLNA player.
|
||||||
|
; post : The renderer volume and listener state reflect the requested value.
|
||||||
|
; result : The result of the synchronized playback operation.
|
||||||
|
; internals: The renderer is queried immediately after changing the volume.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (dlna-playback-volume! playback percentage)
|
(define (dlna-playback-volume! playback percentage)
|
||||||
(with-lock
|
(with-lock
|
||||||
playback
|
playback
|
||||||
(lambda ()
|
(λ ()
|
||||||
(dlna-player-volume! (dlna-playback-player playback) percentage)
|
(dlna-player-volume! (dlna-playback-player playback) percentage)
|
||||||
(define info (dlna-player-info (dlna-playback-player playback)))
|
(let ((info (dlna-player-info (dlna-playback-player playback))))
|
||||||
(notify! playback
|
(notify! playback
|
||||||
(normalize-state (dlna-info-state info))
|
(normalize-state (dlna-info-state info))
|
||||||
info))))
|
info)))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Change playlist repeat behavior.
|
||||||
|
; pre : Playback is open and repeat is 'off, 'one or 'all.
|
||||||
|
; post : The next prepared track reflects the new repeat behavior.
|
||||||
|
; result : The result of the synchronized playback operation.
|
||||||
|
; internals: Any previously prepared index is discarded before recalculation.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (dlna-playback-repeat! playback repeat)
|
(define (dlna-playback-repeat! playback repeat)
|
||||||
(with-lock
|
(with-lock
|
||||||
playback
|
playback
|
||||||
(lambda ()
|
(λ ()
|
||||||
(set-dlna-playback-repeat! playback repeat)
|
(set-dlna-playback-repeat! playback repeat)
|
||||||
(set-dlna-playback-prepared-index! playback #f)
|
(set-dlna-playback-prepared-index! playback #f)
|
||||||
(prepare-next! playback))))
|
(prepare-next! playback))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Close playback and release its renderer resources.
|
||||||
|
; pre : Playback was created by make-dlna-playback.
|
||||||
|
; post : The monitor has stopped and the underlying DLNA player is closed.
|
||||||
|
; result : Void.
|
||||||
|
; internals: The running flag prevents repeated closure of the same player.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (dlna-playback-close! playback)
|
(define (dlna-playback-close! playback)
|
||||||
(when (dlna-playback-running? playback)
|
(when (dlna-playback-running? playback)
|
||||||
(set-dlna-playback-running?! playback #f)
|
(set-dlna-playback-running?! playback #f)
|
||||||
(define monitor (dlna-playback-monitor playback))
|
(let ((monitor (dlna-playback-monitor playback)))
|
||||||
(when (and monitor (not (thread-dead? monitor)))
|
(when (and monitor (not (thread-dead? monitor)))
|
||||||
(kill-thread monitor))
|
(kill-thread monitor))
|
||||||
(set-dlna-playback-monitor! playback #f)
|
(set-dlna-playback-monitor! playback #f)
|
||||||
(with-lock
|
(with-lock
|
||||||
playback
|
playback
|
||||||
(lambda ()
|
(λ ()
|
||||||
(dlna-player-close! (dlna-playback-player playback))))))
|
(dlna-player-close! (dlna-playback-player playback)))))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Tests for module dlna-playback.rkt
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(require rackunit)
|
(require rackunit)
|
||||||
@@ -400,7 +504,7 @@
|
|||||||
(track (build-path "music" "02.flac")
|
(track (build-path "music" "02.flac")
|
||||||
"Second" "Artist" "Album" 60 "audio/flac"))
|
"Second" "Artist" "Album" 60 "audio/flac"))
|
||||||
(define playback
|
(define playback
|
||||||
(dlna-playback #f (lambda () (list first second)) void void
|
(dlna-playback #f (λ () (list first second)) void void
|
||||||
'off 0 #f #f #f #f #f #f 0 #f #t #f #f
|
'off 0 #f #f #f #f #f #f 0 #f #t #f #f
|
||||||
(make-semaphore 1)))
|
(make-semaphore 1)))
|
||||||
|
|
||||||
@@ -411,17 +515,21 @@
|
|||||||
(set-dlna-playback-repeat! playback 'one)
|
(set-dlna-playback-repeat! playback 'one)
|
||||||
(check-equal? (next-index playback 1) 1)
|
(check-equal? (next-index playback 1) 1)
|
||||||
|
|
||||||
(set-dlna-playback-prepared-index! playback 1)
|
(let ((second-info
|
||||||
(check-equal?
|
|
||||||
(track-index-for-info
|
|
||||||
playback
|
|
||||||
(dlna-info
|
(dlna-info
|
||||||
'playing
|
'playing
|
||||||
(dlna-track-info (track-file second) "Second" "Artist" "Album"
|
(dlna-track-info (track-file second) "Second" "Artist" "Album"
|
||||||
#f #f #f 60 #f #f #f)
|
#f #f #f 60 #f #f #f)
|
||||||
"http://renderer.test/02.flac"
|
"http://renderer.test/02.flac"
|
||||||
#f #f 1 60 25 #f #t))
|
#f #f 1 60 25 #f #t)))
|
||||||
1)
|
(set-dlna-playback-prepared-index! playback 1)
|
||||||
|
(check-equal? (track-index-for-info playback second-info) 1)
|
||||||
|
(set-dlna-playback-prepared-index! playback #f)
|
||||||
|
(check-equal? (track-index-for-info playback second-info) 1)
|
||||||
|
(check-false
|
||||||
|
(track-index-for-info
|
||||||
|
playback
|
||||||
|
(struct-copy dlna-info second-info (track #f)))))
|
||||||
(check-eq? (normalize-state 'transitioning) 'starting)
|
(check-eq? (normalize-state 'transitioning) 'starting)
|
||||||
(check-eq? (normalize-state 'no-media) 'stopped)
|
(check-eq? (normalize-state 'no-media) 'stopped)
|
||||||
(check-true (renderer-confirms-playback? 'playing #f))
|
(check-true (renderer-confirms-playback? 'playing #f))
|
||||||
|
|||||||
+224
-95
@@ -45,19 +45,25 @@
|
|||||||
"folder.jpg" "folder.jpeg" "folder.png"
|
"folder.jpg" "folder.jpeg" "folder.png"
|
||||||
"front.jpg" "front.jpeg" "front.png"))
|
"front.jpg" "front.jpeg" "front.png"))
|
||||||
|
|
||||||
|
;;; Checks whether a path has an extension supported by racket-audio.
|
||||||
(define (audio-file? file)
|
(define (audio-file? file)
|
||||||
(let ((extension (path-get-extension file)))
|
(let ((extension (path-get-extension file)))
|
||||||
(and extension
|
(if (eq? extension #f)
|
||||||
(member (string-downcase
|
#f
|
||||||
|
(let ((extension-name
|
||||||
|
(string-downcase
|
||||||
(string-trim
|
(string-trim
|
||||||
(bytes->string/utf-8 extension)
|
(bytes->string/utf-8 extension)
|
||||||
"."))
|
"."))))
|
||||||
supported-extensions)
|
(if (member extension-name supported-extensions)
|
||||||
#t)))
|
#t
|
||||||
|
#f)))))
|
||||||
|
|
||||||
|
;;; Checks whether the final path element starts with a dot.
|
||||||
(define (hidden-name? path)
|
(define (hidden-name? path)
|
||||||
(string-prefix? (path->string path) "."))
|
(string-prefix? (path->string path) "."))
|
||||||
|
|
||||||
|
;;; Derives a fallback track title from the file name without its extension.
|
||||||
(define (file-title file)
|
(define (file-title file)
|
||||||
(let* ((name (file-name-from-path file))
|
(let* ((name (file-name-from-path file))
|
||||||
(without-extension
|
(without-extension
|
||||||
@@ -66,12 +72,15 @@
|
|||||||
file)))
|
file)))
|
||||||
(path->string without-extension)))
|
(path->string without-extension)))
|
||||||
|
|
||||||
|
;;; Returns a non-empty string value or the supplied fallback.
|
||||||
(define (nonempty value fallback)
|
(define (nonempty value fallback)
|
||||||
(if (and (string? value)
|
(if (and (string? value)
|
||||||
(not (string=? (string-trim value) "")))
|
(not (string=? (string-trim value) "")))
|
||||||
value
|
value
|
||||||
fallback))
|
fallback))
|
||||||
|
|
||||||
|
;;; Reads audio metadata and converts a file path to a track value.
|
||||||
|
;;; File-name and MIME-type fallbacks are used when metadata cannot be read.
|
||||||
(define (path->track file)
|
(define (path->track file)
|
||||||
(let ((fallback-title (file-title file)))
|
(let ((fallback-title (file-title file)))
|
||||||
(with-handlers
|
(with-handlers
|
||||||
@@ -95,6 +104,7 @@
|
|||||||
(track file fallback-title "" "" #f
|
(track file fallback-title "" "" #f
|
||||||
(mimetype-for-ext file))))))))
|
(mimetype-for-ext file))))))))
|
||||||
|
|
||||||
|
;;; Builds the filesystem path represented by a library-relative path.
|
||||||
(define (library-path library relative-path)
|
(define (library-path library relative-path)
|
||||||
(if (null? relative-path)
|
(if (null? relative-path)
|
||||||
(music-library-root library)
|
(music-library-root library)
|
||||||
@@ -102,6 +112,7 @@
|
|||||||
(music-library-root library)
|
(music-library-root library)
|
||||||
relative-path)))
|
relative-path)))
|
||||||
|
|
||||||
|
;;; Classifies a path as a container, supported track or unusable entry.
|
||||||
(define (path-kind path)
|
(define (path-kind path)
|
||||||
(cond
|
(cond
|
||||||
((directory-exists? path) 'container)
|
((directory-exists? path) 'container)
|
||||||
@@ -110,6 +121,7 @@
|
|||||||
'track)
|
'track)
|
||||||
(else #f)))
|
(else #f)))
|
||||||
|
|
||||||
|
;;; Orders browser entries with containers first and names alphabetically.
|
||||||
(define (entry<? first second)
|
(define (entry<? first second)
|
||||||
(cond
|
(cond
|
||||||
((and (eq? (browser-entry-kind first) 'container)
|
((and (eq? (browser-entry-kind first) 'container)
|
||||||
@@ -122,6 +134,7 @@
|
|||||||
(string-ci<? (browser-entry-name first)
|
(string-ci<? (browser-entry-name first)
|
||||||
(browser-entry-name second)))))
|
(browser-entry-name second)))))
|
||||||
|
|
||||||
|
;;; Recursively converts the browsable contents of a directory to tracks.
|
||||||
(define (directory-tracks library relative-path)
|
(define (directory-tracks library relative-path)
|
||||||
(append-map
|
(append-map
|
||||||
(λ (entry)
|
(λ (entry)
|
||||||
@@ -134,126 +147,196 @@
|
|||||||
(browser-entry-relative-path entry))))))
|
(browser-entry-relative-path entry))))))
|
||||||
(browse-library library relative-path)))
|
(browse-library library relative-path)))
|
||||||
|
|
||||||
(define (library-contains-audio-file? libraries file)
|
;;; Produces a resolved complete path, or #f when resolution fails.
|
||||||
(and (path-string? file)
|
(define (complete-path/safe path)
|
||||||
(file-exists? file)
|
(with-handlers ((exn:fail? (λ (_) #f)))
|
||||||
(audio-file? file)
|
(simplify-path (path->complete-path path) #t)))
|
||||||
(let ((full-file
|
|
||||||
(with-handlers ((exn:fail? (lambda (_) #f)))
|
;;; Checks whether file is located below root without traversing upward.
|
||||||
(simplify-path (path->complete-path file) #t))))
|
(define (path-below-root? root file)
|
||||||
(and full-file
|
(let* ((relative (find-relative-path root file))
|
||||||
(for/or ((library (in-list libraries)))
|
(elements (explode-path relative)))
|
||||||
(define root
|
|
||||||
(with-handlers ((exn:fail? (lambda (_) #f)))
|
|
||||||
(simplify-path
|
|
||||||
(path->complete-path (music-library-root library))
|
|
||||||
#t)))
|
|
||||||
(and root
|
|
||||||
(let ((relative (find-relative-path root full-file)))
|
|
||||||
(and (relative-path? relative)
|
(and (relative-path? relative)
|
||||||
(not (member 'up (explode-path relative)))))))))))
|
(not (member 'up elements)))))
|
||||||
|
|
||||||
|
;;; Recognizes a library specification containing a display name and path.
|
||||||
|
(define (named-library-specification? specification)
|
||||||
|
(and (list? specification)
|
||||||
|
(= (length specification) 2)
|
||||||
|
(string? (car specification))
|
||||||
|
(path-string? (cadr specification))))
|
||||||
|
|
||||||
|
;;; Extracts the optional display name and path from a library specification.
|
||||||
|
(define (specification-values specification)
|
||||||
|
(cond
|
||||||
|
((named-library-specification? specification)
|
||||||
|
(values (string-trim (car specification))
|
||||||
|
(cadr specification)))
|
||||||
|
((path-string? specification)
|
||||||
|
(values #f specification))
|
||||||
|
(else
|
||||||
|
(raise-argument-error
|
||||||
|
'make-music-libraries
|
||||||
|
"(or/c path-string? (list/c string? path-string?))"
|
||||||
|
specification))))
|
||||||
|
|
||||||
|
;;; Reads embedded ID3 artwork from a track, returning #f when unavailable.
|
||||||
|
(define (embedded-artwork item)
|
||||||
|
(with-handlers ((exn:fail? (λ (_) #f)))
|
||||||
|
(call-with-id3-tags
|
||||||
|
(track-file item)
|
||||||
|
(λ (tags)
|
||||||
|
(if (not (tags-valid? tags))
|
||||||
|
#f
|
||||||
|
(let ((picture (tags-picture tags)))
|
||||||
|
(if (eq? picture #f)
|
||||||
|
#f
|
||||||
|
(let ((mime (id3-picture-mimetype picture)))
|
||||||
|
(artwork
|
||||||
|
(if (and (string? mime)
|
||||||
|
(not (string=? mime "")))
|
||||||
|
mime
|
||||||
|
"application/octet-stream")
|
||||||
|
(id3-picture-bytes picture))))))))))
|
||||||
|
|
||||||
|
;;; Checks whether a path names an existing conventional cover image.
|
||||||
|
(define (cover-file? candidate)
|
||||||
|
(let ((name (file-name-from-path candidate)))
|
||||||
|
(cond
|
||||||
|
((eq? name #f) #f)
|
||||||
|
((not (file-exists? candidate)) #f)
|
||||||
|
((member (path->string name)
|
||||||
|
cover-file-names
|
||||||
|
string-ci=?) #t)
|
||||||
|
(else #f))))
|
||||||
|
|
||||||
|
;;; Searches the track directory for a conventional cover image.
|
||||||
|
(define (cover-artwork item)
|
||||||
|
(with-handlers ((exn:fail? (λ (_) #f)))
|
||||||
|
(let* ((track-directory (path-only (track-file item)))
|
||||||
|
(directory (if (eq? track-directory #f)
|
||||||
|
(current-directory)
|
||||||
|
track-directory))
|
||||||
|
(cover (findf cover-file?
|
||||||
|
(directory-list directory #:build? #t))))
|
||||||
|
(if (eq? cover #f)
|
||||||
|
#f
|
||||||
|
(let ((mime (mimetype-for-ext cover)))
|
||||||
|
(artwork (if (string? mime)
|
||||||
|
mime
|
||||||
|
"application/octet-stream")
|
||||||
|
(file->bytes cover)))))))
|
||||||
|
|
||||||
|
;;; Validates one normalized library root and constructs its public value.
|
||||||
|
(define (named-root->music-library named-root index)
|
||||||
|
(let ((configured-name (car named-root))
|
||||||
|
(root (cadr named-root)))
|
||||||
|
(unless (directory-exists? root)
|
||||||
|
(raise-arguments-error
|
||||||
|
'make-music-libraries
|
||||||
|
"music library is not an existing directory"
|
||||||
|
"path" root))
|
||||||
|
(let* ((name (file-name-from-path root))
|
||||||
|
(default-name (if (eq? name #f)
|
||||||
|
(path->string root)
|
||||||
|
(path->string name))))
|
||||||
|
(music-library
|
||||||
|
(format "library-~a" index)
|
||||||
|
(cond
|
||||||
|
((eq? configured-name #f) default-name)
|
||||||
|
((string=? configured-name "") default-name)
|
||||||
|
(else configured-name))
|
||||||
|
root))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Provided functions
|
;; Provided functions
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Check whether a supported audio file belongs to a music library.
|
||||||
|
; pre : Libraries contains music-library values; file may be any value.
|
||||||
|
; post : The file system remains unchanged.
|
||||||
|
; result : #t when file exists below a configured root, otherwise #f.
|
||||||
|
; internals: audio-file? first rejects unsupported files. complete-path/safe
|
||||||
|
; resolves the candidate and each library root. The named loop calls
|
||||||
|
; path-below-root? until one root contains the file; that helper uses
|
||||||
|
; find-relative-path and rejects paths containing an 'up element.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define (library-contains-audio-file? libraries file)
|
||||||
|
(cond
|
||||||
|
((not (path-string? file)) #f)
|
||||||
|
((not (file-exists? file)) #f)
|
||||||
|
((not (audio-file? file)) #f)
|
||||||
|
(else
|
||||||
|
(let ((full-file (complete-path/safe file)))
|
||||||
|
(if (eq? full-file #f)
|
||||||
|
#f
|
||||||
|
(let loop ((remaining libraries))
|
||||||
|
(if (null? remaining)
|
||||||
|
#f
|
||||||
|
(let ((root
|
||||||
|
(complete-path/safe
|
||||||
|
(music-library-root (car remaining)))))
|
||||||
|
(cond
|
||||||
|
((eq? root #f)
|
||||||
|
(loop (cdr remaining)))
|
||||||
|
((path-below-root? root full-file) #t)
|
||||||
|
(else
|
||||||
|
(loop (cdr remaining))))))))))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : Turn configured directory paths into music libraries.
|
; goal : Turn configured directory paths into music libraries.
|
||||||
; pre : Every value is a path or a (display-name path) list.
|
; pre : Every value is a path or a (display-name path) list.
|
||||||
; post : No directory contents or audio metadata have been read.
|
; post : No directory contents or audio metadata have been read.
|
||||||
; result : Libraries in configuration order, without duplicate roots.
|
; result : Libraries in configuration order, without duplicate roots.
|
||||||
|
; internals: specification-values separates each optional name from its path.
|
||||||
|
; map normalizes the paths and remove-duplicates compares their
|
||||||
|
; roots. The named loop calls named-root->music-library to validate
|
||||||
|
; each directory and assign its sequential library id.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (make-music-libraries specifications)
|
(define (make-music-libraries specifications)
|
||||||
(define (specification-values specification)
|
|
||||||
(if (and (list? specification)
|
|
||||||
(= (length specification) 2)
|
|
||||||
(string? (car specification))
|
|
||||||
(path-string? (cadr specification)))
|
|
||||||
(values (string-trim (car specification))
|
|
||||||
(cadr specification))
|
|
||||||
(if (path-string? specification)
|
|
||||||
(values #f specification)
|
|
||||||
(raise-argument-error
|
|
||||||
'make-music-libraries
|
|
||||||
"(or/c path-string? (list/c string? path-string?))"
|
|
||||||
specification))))
|
|
||||||
(let ((roots
|
(let ((roots
|
||||||
(remove-duplicates
|
(remove-duplicates
|
||||||
(for/list ((specification (in-list specifications)))
|
(map (λ (specification)
|
||||||
(let-values (((name path)
|
(let-values (((name path)
|
||||||
(specification-values specification)))
|
(specification-values specification)))
|
||||||
(list name
|
(list name
|
||||||
(normal-case-path
|
(normal-case-path
|
||||||
(path->complete-path path)))))
|
(path->complete-path path)))))
|
||||||
(lambda (first second)
|
specifications)
|
||||||
|
(λ (first second)
|
||||||
(equal? (cadr first) (cadr second))))))
|
(equal? (cadr first) (cadr second))))))
|
||||||
(for/list ((named-root (in-list roots))
|
(let loop ((remaining roots)
|
||||||
(index (in-naturals)))
|
(index 0))
|
||||||
(define configured-name (car named-root))
|
(if (null? remaining)
|
||||||
(define root (cadr named-root))
|
'()
|
||||||
(unless (directory-exists? root)
|
(cons (named-root->music-library (car remaining) index)
|
||||||
(raise-arguments-error
|
(loop (cdr remaining) (add1 index)))))))
|
||||||
'make-music-libraries
|
|
||||||
"music library is not an existing directory"
|
|
||||||
"path" root))
|
|
||||||
(let ((name (file-name-from-path root)))
|
|
||||||
(music-library
|
|
||||||
(format "library-~a" index)
|
|
||||||
(if (and configured-name
|
|
||||||
(not (string=? configured-name "")))
|
|
||||||
configured-name
|
|
||||||
(if name
|
|
||||||
(path->string name)
|
|
||||||
(path->string root)))
|
|
||||||
root)))))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : Read the artwork associated with a track.
|
; goal : Read the artwork associated with a track.
|
||||||
; pre : Item names a local audio file.
|
; pre : Item names a local audio file.
|
||||||
; post : The audio file and optional neighbouring image remain unchanged.
|
; post : The audio file and optional neighbouring image remain unchanged.
|
||||||
; result : Embedded artwork, a conventional folder cover, or #f.
|
; result : Embedded artwork, a conventional folder cover, or #f.
|
||||||
|
; internals: embedded-artwork first reads the picture stored in the audio tags.
|
||||||
|
; Only when that returns #f does cover-artwork search the track's
|
||||||
|
; directory for one of the names in cover-file-names.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (track-artwork item)
|
(define (track-artwork item)
|
||||||
(define embedded
|
(let ((embedded (embedded-artwork item)))
|
||||||
(with-handlers ((exn:fail? (λ (_) #f)))
|
(if (eq? embedded #f)
|
||||||
(call-with-id3-tags
|
(cover-artwork item)
|
||||||
(track-file item)
|
embedded)))
|
||||||
(λ (tags)
|
|
||||||
(let ((picture (and (tags-valid? tags)
|
|
||||||
(tags-picture tags))))
|
|
||||||
(and picture
|
|
||||||
(artwork (let ((mime (id3-picture-mimetype picture)))
|
|
||||||
(if (and (string? mime)
|
|
||||||
(not (string=? mime "")))
|
|
||||||
mime
|
|
||||||
"application/octet-stream"))
|
|
||||||
(id3-picture-bytes picture))))))))
|
|
||||||
(or embedded
|
|
||||||
(with-handlers ((exn:fail? (λ (_) #f)))
|
|
||||||
(let* ((directory (or (path-only (track-file item))
|
|
||||||
(current-directory)))
|
|
||||||
(cover
|
|
||||||
(findf
|
|
||||||
(λ (candidate)
|
|
||||||
(let ((name (file-name-from-path candidate)))
|
|
||||||
(and name
|
|
||||||
(file-exists? candidate)
|
|
||||||
(member (path->string name)
|
|
||||||
cover-file-names
|
|
||||||
string-ci=?))))
|
|
||||||
(directory-list directory #:build? #t))))
|
|
||||||
(and cover
|
|
||||||
(let ((mime (mimetype-for-ext cover)))
|
|
||||||
(artwork (if (string? mime)
|
|
||||||
mime
|
|
||||||
"application/octet-stream")
|
|
||||||
(file->bytes cover))))))))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : List the immediate folders and supported audio files in a library.
|
; goal : List the immediate folders and supported audio files in a library.
|
||||||
; pre : Relative-path was produced by a previous browse result.
|
; pre : Relative-path was produced by a previous browse result.
|
||||||
; post : Child directories are listed before tracks; metadata is not read.
|
; post : Child directories are listed before tracks; metadata is not read.
|
||||||
; result : Browser entries for one directory level.
|
; result : Browser entries for one directory level.
|
||||||
|
; internals: library-path resolves the requested directory. directory-list and
|
||||||
|
; path-kind supply filter-map with usable children; hidden-name?
|
||||||
|
; removes hidden containers. sort uses entry<? to put containers
|
||||||
|
; first and compare names without regard to case.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (browse-library library relative-path)
|
(define (browse-library library relative-path)
|
||||||
(let ((path (library-path library relative-path)))
|
(let ((path (library-path library relative-path)))
|
||||||
@@ -267,13 +350,20 @@
|
|||||||
(λ (name)
|
(λ (name)
|
||||||
(let* ((full-path (build-path path name))
|
(let* ((full-path (build-path path name))
|
||||||
(kind (path-kind full-path)))
|
(kind (path-kind full-path)))
|
||||||
(and kind
|
(cond
|
||||||
(not (and (eq? kind 'container)
|
((eq? kind #f) #f)
|
||||||
(hidden-name? name)))
|
((eq? kind 'container)
|
||||||
|
(if (hidden-name? name)
|
||||||
|
#f
|
||||||
(browser-entry
|
(browser-entry
|
||||||
(path->string name)
|
(path->string name)
|
||||||
kind
|
kind
|
||||||
(append relative-path (list name))))))
|
(append relative-path (list name)))))
|
||||||
|
(else
|
||||||
|
(browser-entry
|
||||||
|
(path->string name)
|
||||||
|
kind
|
||||||
|
(append relative-path (list name)))))))
|
||||||
(directory-list path))
|
(directory-list path))
|
||||||
entry<?)))
|
entry<?)))
|
||||||
|
|
||||||
@@ -282,6 +372,9 @@
|
|||||||
; pre : Entry belongs to library and was produced by browse-library.
|
; pre : Entry belongs to library and was produced by browse-library.
|
||||||
; post : Track metadata is read; containers are traversed recursively.
|
; post : Track metadata is read; containers are traversed recursively.
|
||||||
; result : One track, or all supported tracks below the selected container.
|
; result : One track, or all supported tracks below the selected container.
|
||||||
|
; internals: A track entry is resolved by library-path and read by path->track.
|
||||||
|
; A container is passed to directory-tracks, which recursively calls
|
||||||
|
; browse-library and path->track in browser sort order.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (browser-entry->tracks library entry)
|
(define (browser-entry->tracks library entry)
|
||||||
(if (eq? (browser-entry-kind entry) 'container)
|
(if (eq? (browser-entry-kind entry) 'container)
|
||||||
@@ -292,18 +385,30 @@
|
|||||||
(library-path library
|
(library-path library
|
||||||
(browser-entry-relative-path entry))))))
|
(browser-entry-relative-path entry))))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Tests for module library.rkt
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(require rackunit)
|
(require rackunit)
|
||||||
|
|
||||||
(define root
|
(define root
|
||||||
(make-temporary-file "rkt-web-library-~a" 'directory))
|
(make-temporary-file "rkt-web-library-~a" 'directory))
|
||||||
|
|
||||||
|
(define outside-file
|
||||||
|
(make-temporary-file "rkt-web-outside-~a.mp3"))
|
||||||
|
|
||||||
(dynamic-wind
|
(dynamic-wind
|
||||||
void
|
void
|
||||||
(λ ()
|
(λ ()
|
||||||
(make-directory (build-path root "Album"))
|
(make-directory (build-path root "Album"))
|
||||||
|
(make-directory (build-path root ".Hidden"))
|
||||||
|
(call-with-output-file
|
||||||
|
(build-path root "Album" "inside.mp3") void)
|
||||||
(call-with-output-file (build-path root "track.mp3") void)
|
(call-with-output-file (build-path root "track.mp3") void)
|
||||||
(call-with-output-file (build-path root "cover.jpg") void)
|
(call-with-output-file (build-path root "cover.jpg") void)
|
||||||
|
(call-with-output-file (build-path root "ignored.txt") void)
|
||||||
(let* ((libraries (make-music-libraries (list root)))
|
(let* ((libraries (make-music-libraries (list root)))
|
||||||
(entries (browse-library (car libraries) '())))
|
(entries (browse-library (car libraries) '())))
|
||||||
(check-equal? (length libraries) 1)
|
(check-equal? (length libraries) 1)
|
||||||
@@ -312,6 +417,29 @@
|
|||||||
(check-eq? (browser-entry-kind (car entries)) 'container)
|
(check-eq? (browser-entry-kind (car entries)) 'container)
|
||||||
(check-equal? (browser-entry-name (cadr entries)) "track.mp3")
|
(check-equal? (browser-entry-name (cadr entries)) "track.mp3")
|
||||||
(check-eq? (browser-entry-kind (cadr entries)) 'track)
|
(check-eq? (browser-entry-kind (cadr entries)) 'track)
|
||||||
|
(check-equal?
|
||||||
|
(length
|
||||||
|
(browser-entry->tracks (car libraries) (car entries)))
|
||||||
|
1)
|
||||||
|
(check-true
|
||||||
|
(library-contains-audio-file?
|
||||||
|
libraries
|
||||||
|
(build-path root "track.mp3")))
|
||||||
|
(check-true
|
||||||
|
(library-contains-audio-file?
|
||||||
|
libraries
|
||||||
|
(build-path root "Album" "inside.mp3")))
|
||||||
|
(check-false
|
||||||
|
(library-contains-audio-file?
|
||||||
|
libraries
|
||||||
|
(build-path root "cover.jpg")))
|
||||||
|
(check-false
|
||||||
|
(library-contains-audio-file?
|
||||||
|
libraries
|
||||||
|
outside-file))
|
||||||
|
(check-equal?
|
||||||
|
(length (make-music-libraries (list root root)))
|
||||||
|
1)
|
||||||
(check-equal?
|
(check-equal?
|
||||||
(music-library-name
|
(music-library-name
|
||||||
(car (make-music-libraries
|
(car (make-music-libraries
|
||||||
@@ -324,4 +452,5 @@
|
|||||||
"Track" "" "" #f "audio/mpeg")))
|
"Track" "" "" #f "audio/mpeg")))
|
||||||
"image/jpeg")))
|
"image/jpeg")))
|
||||||
(λ ()
|
(λ ()
|
||||||
(delete-directory/files root))))
|
(delete-directory/files root)
|
||||||
|
(delete-file outside-file))))
|
||||||
|
|||||||
@@ -1,69 +0,0 @@
|
|||||||
#lang racket/base
|
|
||||||
|
|
||||||
(require file/sha1
|
|
||||||
racket/os
|
|
||||||
racket/path
|
|
||||||
racket/random
|
|
||||||
racket/string
|
|
||||||
simple-ini)
|
|
||||||
|
|
||||||
(provide (struct-out player-agent-config)
|
|
||||||
load-player-agent-config
|
|
||||||
save-player-agent-config!
|
|
||||||
valid-app-id?)
|
|
||||||
|
|
||||||
(struct player-agent-config (file ini app-id server-url name) #:transparent)
|
|
||||||
|
|
||||||
(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 (load-player-agent-config [file (get-ini-file 'rkt-web-player-agent)])
|
|
||||||
(define ini (file->ini file))
|
|
||||||
(define configured-id (ini-get ini 'agent 'app-id #f))
|
|
||||||
(define value
|
|
||||||
(player-agent-config
|
|
||||||
file
|
|
||||||
ini
|
|
||||||
(if (valid-app-id? configured-id)
|
|
||||||
(string-downcase configured-id)
|
|
||||||
(fresh-app-id))
|
|
||||||
(ini-get ini 'server 'url "http://127.0.0.1:8080")
|
|
||||||
(ini-get ini 'agent 'name
|
|
||||||
(format "~a playback" (gethostname)))))
|
|
||||||
(save-player-agent-config! value)
|
|
||||||
value)
|
|
||||||
|
|
||||||
(define (save-player-agent-config! value)
|
|
||||||
(define ini (player-agent-config-ini value))
|
|
||||||
(ini-set! ini 'agent 'app-id (player-agent-config-app-id value))
|
|
||||||
(ini-set! ini 'agent 'name (player-agent-config-name value))
|
|
||||||
(ini-set! ini 'server 'url (player-agent-config-server-url value))
|
|
||||||
(ini->file ini (player-agent-config-file value) #:private? #t))
|
|
||||||
|
|
||||||
(module+ test
|
|
||||||
(require rackunit
|
|
||||||
racket/file)
|
|
||||||
|
|
||||||
(define test-directory (make-temporary-file "rkt-agent-config-~a" 'directory))
|
|
||||||
(define test-file (build-path test-directory "agent.ini"))
|
|
||||||
(dynamic-wind
|
|
||||||
void
|
|
||||||
(lambda ()
|
|
||||||
(define first (load-player-agent-config test-file))
|
|
||||||
(check-true (valid-app-id? (player-agent-config-app-id first)))
|
|
||||||
(define changed
|
|
||||||
(struct-copy player-agent-config first
|
|
||||||
(server-url "https://music.example.test")
|
|
||||||
(name "Test output")))
|
|
||||||
(save-player-agent-config! changed)
|
|
||||||
(define second (load-player-agent-config test-file))
|
|
||||||
(check-equal? (player-agent-config-app-id second)
|
|
||||||
(player-agent-config-app-id first))
|
|
||||||
(check-equal? (player-agent-config-server-url second)
|
|
||||||
"https://music.example.test")
|
|
||||||
(check-equal? (player-agent-config-name second) "Test output"))
|
|
||||||
(lambda () (delete-directory/files test-directory))))
|
|
||||||
@@ -1,425 +0,0 @@
|
|||||||
#lang racket/base
|
|
||||||
|
|
||||||
(require json
|
|
||||||
net/url
|
|
||||||
racket-audio
|
|
||||||
racket/file
|
|
||||||
racket/path
|
|
||||||
racket/port
|
|
||||||
racket/string
|
|
||||||
simple-log
|
|
||||||
"translate.rkt")
|
|
||||||
|
|
||||||
(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 (format (tr 'denied-message) app-id))
|
|
||||||
(warn-player-agent "Agent authorization refused: ~a"
|
|
||||||
(exn-message exception))
|
|
||||||
(set-agent-error! message)
|
|
||||||
(status-callback
|
|
||||||
(tr 'unauthorized-status))
|
|
||||||
(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 (tr 'disconnected) (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 (tr 'connected))
|
|
||||||
(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 (tr 'connecting))
|
|
||||||
(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))
|
|
||||||
@@ -1,275 +0,0 @@
|
|||||||
#lang racket/base
|
|
||||||
|
|
||||||
(require racket/class
|
|
||||||
racket/format
|
|
||||||
racket/gui/base
|
|
||||||
racket/os
|
|
||||||
racket/path
|
|
||||||
racket/string
|
|
||||||
simple-log
|
|
||||||
"player-agent-config.rkt"
|
|
||||||
"player-agent-core.rkt"
|
|
||||||
"player-agent-tray.rkt"
|
|
||||||
"translate.rkt")
|
|
||||||
|
|
||||||
(provide run-player-agent-gui)
|
|
||||||
|
|
||||||
(sl-def-log player-agent-gui)
|
|
||||||
|
|
||||||
(define log-file
|
|
||||||
(build-path (find-system-path 'pref-dir)
|
|
||||||
"rkt-web-player-agent.log"))
|
|
||||||
|
|
||||||
(define (input-field label init-value panel)
|
|
||||||
(define field
|
|
||||||
(new text-field%
|
|
||||||
(parent panel)
|
|
||||||
(label label)
|
|
||||||
(init-value init-value)))
|
|
||||||
(send (send field get-editor) set-padding 0 2 0 2)
|
|
||||||
field)
|
|
||||||
|
|
||||||
(define (format-time value)
|
|
||||||
(define seconds
|
|
||||||
(if (and (number? value) (>= value 0))
|
|
||||||
(inexact->exact (floor value))
|
|
||||||
0))
|
|
||||||
(define hours (quotient seconds 3600))
|
|
||||||
(define minutes (quotient (remainder seconds 3600) 60))
|
|
||||||
(define 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 (run-player-agent-gui)
|
|
||||||
(sl-log-to-file log-file)
|
|
||||||
|
|
||||||
(define config (load-player-agent-config))
|
|
||||||
(define frame #f)
|
|
||||||
(define runtime #f)
|
|
||||||
(define status-message #f)
|
|
||||||
(define playback-message #f)
|
|
||||||
(define playback-details #f)
|
|
||||||
(define playback-filename #f)
|
|
||||||
(define name-field #f)
|
|
||||||
(define server-field #f)
|
|
||||||
(define connect-button #f)
|
|
||||||
(define playback-timer #f)
|
|
||||||
(define tray-timer #f)
|
|
||||||
(define tray #f)
|
|
||||||
(define shutting-down? #f)
|
|
||||||
|
|
||||||
(define (show-status! message)
|
|
||||||
(queue-callback
|
|
||||||
(lambda ()
|
|
||||||
(when status-message
|
|
||||||
(send status-message set-label message)))
|
|
||||||
#f))
|
|
||||||
|
|
||||||
(define (show-denial! message)
|
|
||||||
(queue-callback
|
|
||||||
(lambda ()
|
|
||||||
(message-box (tr 'denied-title)
|
|
||||||
message
|
|
||||||
frame
|
|
||||||
'(ok stop)))
|
|
||||||
#f))
|
|
||||||
|
|
||||||
(set! runtime
|
|
||||||
(make-player-agent-runtime
|
|
||||||
(player-agent-config-server-url config)
|
|
||||||
(player-agent-config-name config)
|
|
||||||
(player-agent-config-app-id config)
|
|
||||||
#:status-callback show-status!
|
|
||||||
#:denied-callback show-denial!))
|
|
||||||
|
|
||||||
(define (refresh-playback-status!)
|
|
||||||
(when (and playback-message playback-details playback-filename)
|
|
||||||
(define snapshot ((player-agent-runtime-snapshot runtime)))
|
|
||||||
(define track ((player-agent-runtime-current-track runtime)))
|
|
||||||
(define state (hash-ref snapshot 'state "stopped"))
|
|
||||||
(define title (and track (hash-ref track 'title #f)))
|
|
||||||
(define artist (and track (hash-ref track 'artist #f)))
|
|
||||||
(define filename (and track (hash-ref track 'filename #f)))
|
|
||||||
(define track-number (and track (hash-ref track 'trackNumber #f)))
|
|
||||||
(define track-label
|
|
||||||
(cond
|
|
||||||
((and artist (not (string=? artist "")) title)
|
|
||||||
(format "~a — ~a" artist title))
|
|
||||||
(title title)
|
|
||||||
(else (tr 'no-track-selected))))
|
|
||||||
(define prefix
|
|
||||||
(cond
|
|
||||||
((string=? state "playing") (tr 'playing))
|
|
||||||
((string=? state "paused") (tr 'paused))
|
|
||||||
((string=? state "starting") (tr 'loading))
|
|
||||||
((string=? state "stopped") (tr 'stopped))
|
|
||||||
(else state)))
|
|
||||||
(define position (hash-ref snapshot 'position 0))
|
|
||||||
(define duration (hash-ref snapshot 'duration 'null))
|
|
||||||
(define format-name (hash-ref snapshot 'format ""))
|
|
||||||
(define rate (hash-ref snapshot 'rate 'null))
|
|
||||||
(define bits (hash-ref snapshot 'bits 'null))
|
|
||||||
(define channels (hash-ref snapshot 'channels 'null))
|
|
||||||
(define details
|
|
||||||
(filter
|
|
||||||
(lambda (value) (not (string=? value "")))
|
|
||||||
(list
|
|
||||||
(format "~a / ~a"
|
|
||||||
(format-time position)
|
|
||||||
(if (number? duration) (format-time duration) "--:--:--"))
|
|
||||||
(if (number? bits) (format "~a bit" bits) "")
|
|
||||||
(if (number? rate)
|
|
||||||
(format "~a kHz" (~r (/ rate 1000.0) #:precision '(= 1)))
|
|
||||||
"")
|
|
||||||
(if (number? channels)
|
|
||||||
(format "~a ~a" channels
|
|
||||||
(tr (if (= channels 1) 'channel 'channels)))
|
|
||||||
"")
|
|
||||||
(if (and (string? format-name) (not (string=? format-name "")))
|
|
||||||
format-name
|
|
||||||
""))))
|
|
||||||
(send playback-message
|
|
||||||
set-label
|
|
||||||
(if track
|
|
||||||
(format "~a~a: ~a"
|
|
||||||
prefix
|
|
||||||
(if (number? track-number)
|
|
||||||
(format " #~a" track-number)
|
|
||||||
"")
|
|
||||||
track-label)
|
|
||||||
(tr 'no-track)))
|
|
||||||
(send playback-details set-label (string-join details " · "))
|
|
||||||
(send playback-filename
|
|
||||||
set-label
|
|
||||||
(if (and (string? filename) (not (string=? filename "")))
|
|
||||||
filename
|
|
||||||
"—"))))
|
|
||||||
|
|
||||||
(define (reconnect!)
|
|
||||||
(define next-server (string-trim (send server-field get-value)))
|
|
||||||
(define entered-name (string-trim (send name-field get-value)))
|
|
||||||
(define next-name
|
|
||||||
(if (string=? entered-name "")
|
|
||||||
(format "~a playback" (gethostname))
|
|
||||||
entered-name))
|
|
||||||
(set! config
|
|
||||||
(struct-copy player-agent-config config
|
|
||||||
(server-url next-server)
|
|
||||||
(name next-name)))
|
|
||||||
(save-player-agent-config! config)
|
|
||||||
(send name-field set-value next-name)
|
|
||||||
((player-agent-runtime-reconnect! runtime) next-server next-name)
|
|
||||||
(send connect-button set-label (tr 'reconnect)))
|
|
||||||
|
|
||||||
(define (shutdown!)
|
|
||||||
(unless shutting-down?
|
|
||||||
(set! shutting-down? #t)
|
|
||||||
(when playback-timer (send playback-timer stop))
|
|
||||||
(when tray-timer (send tray-timer stop))
|
|
||||||
((player-agent-runtime-shutdown! runtime))
|
|
||||||
(when tray
|
|
||||||
((tray-controller-destroy! tray))
|
|
||||||
(set! tray #f))))
|
|
||||||
|
|
||||||
(define (quit!)
|
|
||||||
(queue-callback
|
|
||||||
(lambda ()
|
|
||||||
(shutdown!)
|
|
||||||
(when frame (send frame show #f)))
|
|
||||||
#f))
|
|
||||||
|
|
||||||
(define agent-frame%
|
|
||||||
(class frame%
|
|
||||||
(super-new)
|
|
||||||
(define/augment (on-close)
|
|
||||||
(if tray
|
|
||||||
(send this show #f)
|
|
||||||
(begin
|
|
||||||
(shutdown!)
|
|
||||||
(inner (void) on-close))))))
|
|
||||||
|
|
||||||
(set! frame
|
|
||||||
(new agent-frame%
|
|
||||||
(label (tr 'app-title))
|
|
||||||
(width 560)
|
|
||||||
(height 310)))
|
|
||||||
(define panel
|
|
||||||
(new vertical-panel%
|
|
||||||
(parent frame)
|
|
||||||
(alignment '(left top))))
|
|
||||||
(set! server-field
|
|
||||||
(input-field (tr 'server)
|
|
||||||
(player-agent-config-server-url config)
|
|
||||||
panel))
|
|
||||||
(set! name-field
|
|
||||||
(input-field (tr 'name) (player-agent-config-name config) panel))
|
|
||||||
(define id-field
|
|
||||||
(input-field (tr 'application-id)
|
|
||||||
(player-agent-config-app-id config)
|
|
||||||
panel))
|
|
||||||
;; Lock the editor, not the native widget. Disabled Windows controls render
|
|
||||||
;; their label and text poorly on some display configurations.
|
|
||||||
(send (send id-field get-editor) lock #t)
|
|
||||||
|
|
||||||
(define playback-panel
|
|
||||||
(new group-box-panel%
|
|
||||||
(parent panel)
|
|
||||||
(label (tr 'playback))
|
|
||||||
(alignment '(left top))
|
|
||||||
(stretchable-height #f)))
|
|
||||||
(set! playback-message
|
|
||||||
(new message%
|
|
||||||
(parent playback-panel)
|
|
||||||
(label (tr 'no-track))
|
|
||||||
(auto-resize #t)))
|
|
||||||
(set! playback-details
|
|
||||||
(new message%
|
|
||||||
(parent playback-panel)
|
|
||||||
(label "00:00:00 / --:--:--")
|
|
||||||
(auto-resize #t)))
|
|
||||||
(set! playback-filename
|
|
||||||
(new message%
|
|
||||||
(parent playback-panel)
|
|
||||||
(label "—")
|
|
||||||
(auto-resize #t)))
|
|
||||||
|
|
||||||
(define controls
|
|
||||||
(new horizontal-panel%
|
|
||||||
(parent panel)
|
|
||||||
(alignment '(left center))))
|
|
||||||
(set! connect-button
|
|
||||||
(new button%
|
|
||||||
(parent controls)
|
|
||||||
(label (tr 'save-connect))
|
|
||||||
(callback (lambda (_button _event) (reconnect!)))))
|
|
||||||
(set! status-message
|
|
||||||
(new message%
|
|
||||||
(parent controls)
|
|
||||||
(label (tr 'connecting))
|
|
||||||
(auto-resize #t)))
|
|
||||||
|
|
||||||
(set! playback-timer
|
|
||||||
(new timer%
|
|
||||||
(notify-callback refresh-playback-status!)
|
|
||||||
(interval 500)))
|
|
||||||
(refresh-playback-status!)
|
|
||||||
|
|
||||||
;; If SDL3 and its native runtime are present, closing the frame hides it in
|
|
||||||
;; the tray. Otherwise the original close-and-exit behaviour remains.
|
|
||||||
(set! tray
|
|
||||||
(try-make-tray-controller
|
|
||||||
(lambda ()
|
|
||||||
(queue-callback (lambda () (send frame show #t)) #f))
|
|
||||||
quit!))
|
|
||||||
(when tray
|
|
||||||
(set! tray-timer
|
|
||||||
(new timer%
|
|
||||||
(notify-callback (tray-controller-update! tray))
|
|
||||||
(interval 100))))
|
|
||||||
|
|
||||||
(send frame show #t)
|
|
||||||
((player-agent-runtime-start! runtime))
|
|
||||||
(send connect-button set-label (tr 'reconnect))
|
|
||||||
frame)
|
|
||||||
@@ -1,36 +0,0 @@
|
|||||||
#lang racket/base
|
|
||||||
|
|
||||||
(require "translate.rkt")
|
|
||||||
|
|
||||||
;; SDL3 is deliberately loaded dynamically. The GUI agent keeps working
|
|
||||||
;; without the optional Racket package and native SDL3 runtime.
|
|
||||||
|
|
||||||
(provide (struct-out tray-controller)
|
|
||||||
try-make-tray-controller)
|
|
||||||
|
|
||||||
(struct tray-controller (update! destroy!) #:transparent)
|
|
||||||
|
|
||||||
(define (try-make-tray-controller show-window! quit!)
|
|
||||||
(with-handlers ((exn:fail? (lambda (_) #f)))
|
|
||||||
(define sdl-init! (dynamic-require 'sdl3 'sdl-init!))
|
|
||||||
(define sdl-quit! (dynamic-require 'sdl3 'sdl-quit!))
|
|
||||||
(define make-tray (dynamic-require 'sdl3 'make-tray))
|
|
||||||
(define make-tray-menu (dynamic-require 'sdl3 'make-tray-menu))
|
|
||||||
(define insert-tray-entry! (dynamic-require 'sdl3 'insert-tray-entry!))
|
|
||||||
(define set-tray-entry-callback!
|
|
||||||
(dynamic-require 'sdl3 'set-tray-entry-callback!))
|
|
||||||
(define update-trays! (dynamic-require 'sdl3 'update-trays!))
|
|
||||||
(define tray-destroy! (dynamic-require 'sdl3 'tray-destroy!))
|
|
||||||
(sdl-init! '(video events))
|
|
||||||
(define tray (make-tray #f (tr 'app-title)))
|
|
||||||
(define menu (make-tray-menu tray))
|
|
||||||
(define show-entry (insert-tray-entry! menu (tr 'tray-open)))
|
|
||||||
(insert-tray-entry! menu #f)
|
|
||||||
(define quit-entry (insert-tray-entry! menu (tr 'quit)))
|
|
||||||
(set-tray-entry-callback! show-entry (lambda (_) (show-window!)))
|
|
||||||
(set-tray-entry-callback! quit-entry (lambda (_) (quit!)))
|
|
||||||
(tray-controller
|
|
||||||
update-trays!
|
|
||||||
(lambda ()
|
|
||||||
(tray-destroy! tray)
|
|
||||||
(sdl-quit!)))))
|
|
||||||
+328
-59
@@ -15,7 +15,8 @@
|
|||||||
"library.rkt"
|
"library.rkt"
|
||||||
"playlists.rkt")
|
"playlists.rkt")
|
||||||
|
|
||||||
(provide make-player
|
(provide player?
|
||||||
|
make-player
|
||||||
player-state->jsexpr
|
player-state->jsexpr
|
||||||
player-command!
|
player-command!
|
||||||
player-discover!
|
player-discover!
|
||||||
@@ -49,11 +50,13 @@
|
|||||||
#:transparent)
|
#:transparent)
|
||||||
|
|
||||||
(struct playlist-tab
|
(struct playlist-tab
|
||||||
(id [name #:mutable] [tracks #:mutable])
|
(id [name #:mutable] [tracks #:mutable] [snapshot #:auto #:mutable])
|
||||||
|
#:auto-value #f
|
||||||
#:transparent)
|
#:transparent)
|
||||||
|
|
||||||
(struct playlist-context
|
(struct playlist-context
|
||||||
([tabs #:mutable] [current-index #:mutable])
|
([tabs #:mutable] [current-index #:mutable] [saved #:auto #:mutable])
|
||||||
|
#:auto-value '()
|
||||||
#:transparent)
|
#:transparent)
|
||||||
|
|
||||||
(struct playback-session
|
(struct playback-session
|
||||||
@@ -76,6 +79,16 @@
|
|||||||
local-music-indexes)
|
local-music-indexes)
|
||||||
#:transparent)
|
#:transparent)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Hold the shared libraries, playback sessions, outputs and UI state.
|
||||||
|
; pre : make-player supplies all fields and owns construction of the value.
|
||||||
|
; post : Creating or recognizing a player does not start an HTTP server.
|
||||||
|
; result : player? recognizes values accepted by the internal server API.
|
||||||
|
; internals: make-player initializes the state and command locks, playlist
|
||||||
|
; contexts and playback sessions. player-command! mutates that
|
||||||
|
; state, player-state->jsexpr reads it, and player-close! releases
|
||||||
|
; the owned playback and persistence resources.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(struct player
|
(struct player
|
||||||
(libraries
|
(libraries
|
||||||
allowed-agent-ids
|
allowed-agent-ids
|
||||||
@@ -249,36 +262,45 @@
|
|||||||
(list-ref (player-tabs value)
|
(list-ref (player-tabs value)
|
||||||
(player-current-tab-index value)))
|
(player-current-tab-index value)))
|
||||||
|
|
||||||
|
;;; Invalidate the browser snapshot only when the immutable track list changes.
|
||||||
(define (save-current-tab! value)
|
(define (save-current-tab! value)
|
||||||
(set-playlist-tab-tracks!
|
(let ((tab (current-tab value))
|
||||||
(current-tab value)
|
(tracks (player-tracks value)))
|
||||||
(player-tracks value)))
|
(unless (eq? tracks (playlist-tab-tracks tab))
|
||||||
|
(set-playlist-tab-tracks! tab tracks)
|
||||||
|
(set-playlist-tab-snapshot! tab #f))))
|
||||||
|
|
||||||
(define (normal-playlist-username username)
|
(define (normal-playlist-username username)
|
||||||
(let ((value (and (string? username)
|
(let ((value (and (string? username)
|
||||||
(string-downcase (string-trim username)))))
|
(string-downcase (string-trim username)))))
|
||||||
(if (and value (not (string=? value ""))) value "anonymous")))
|
(if (and value (not (string=? value ""))) value "anonymous")))
|
||||||
|
|
||||||
(define (new-playlist-context value username)
|
;;; Restore open tabs and the library using the same object for a shared UUID.
|
||||||
(define stored
|
;;; Old stores have no saved index, so their tabs remain open and unsaved.
|
||||||
(load-user-playlists (player-playlist-store value)
|
(define (restore-playlist-context store username libraries)
|
||||||
username
|
(let* ((restore (λ (tab) (playlist-tab (persisted-tab-id tab)
|
||||||
(player-libraries value)))
|
|
||||||
(playlist-context
|
|
||||||
(if (pair? stored)
|
|
||||||
(for/list ((tab (in-list stored)))
|
|
||||||
(playlist-tab (persisted-tab-id tab)
|
|
||||||
(persisted-tab-name tab)
|
(persisted-tab-name tab)
|
||||||
(persisted-tab-tracks tab)))
|
(persisted-tab-tracks tab))))
|
||||||
(list (playlist-tab (uuid-string) "Default" '())))
|
(opened (map restore (load-user-playlists store username libraries)))
|
||||||
0))
|
(tabs (if (pair? opened) opened
|
||||||
|
(list (playlist-tab (uuid-string) "Default" '()))))
|
||||||
|
(context (playlist-context tabs 0)))
|
||||||
|
(set-playlist-context-saved!
|
||||||
|
context
|
||||||
|
(map (λ (stored)
|
||||||
|
(or (findf (λ (tab) (string=? (playlist-tab-id tab) (persisted-tab-id stored)))
|
||||||
|
tabs)
|
||||||
|
(restore stored)))
|
||||||
|
(load-user-playlists store username libraries #:saved? #t)))
|
||||||
|
context))
|
||||||
|
|
||||||
(define (playlist-context-for! value username)
|
(define (playlist-context-for! value username)
|
||||||
(define normalized (normal-playlist-username username))
|
(define normalized (normal-playlist-username username))
|
||||||
(hash-ref!
|
(hash-ref!
|
||||||
(player-playlist-contexts value)
|
(player-playlist-contexts value)
|
||||||
normalized
|
normalized
|
||||||
(lambda () (new-playlist-context value normalized))))
|
(λ () (restore-playlist-context (player-playlist-store value)
|
||||||
|
normalized (player-libraries value)))))
|
||||||
|
|
||||||
(define (context-tracks context)
|
(define (context-tracks context)
|
||||||
(playlist-tab-tracks
|
(playlist-tab-tracks
|
||||||
@@ -324,7 +346,7 @@
|
|||||||
(define context (playlist-context-for! value normalized))
|
(define context (playlist-context-for! value normalized))
|
||||||
(with-state-lock
|
(with-state-lock
|
||||||
value
|
value
|
||||||
(lambda ()
|
(λ ()
|
||||||
(set-player-tabs! value (playlist-context-tabs context))
|
(set-player-tabs! value (playlist-context-tabs context))
|
||||||
(set-player-current-tab-index!
|
(set-player-current-tab-index!
|
||||||
value
|
value
|
||||||
@@ -350,7 +372,12 @@
|
|||||||
(for/list ((tab (in-list (player-tabs value))))
|
(for/list ((tab (in-list (player-tabs value))))
|
||||||
(persisted-tab (playlist-tab-id tab)
|
(persisted-tab (playlist-tab-id tab)
|
||||||
(playlist-tab-name tab)
|
(playlist-tab-name tab)
|
||||||
(playlist-tab-tracks tab)))))
|
(playlist-tab-tracks tab)))
|
||||||
|
#:saved
|
||||||
|
(map (λ (tab) (persisted-tab (playlist-tab-id tab)
|
||||||
|
(playlist-tab-name tab)
|
||||||
|
(playlist-tab-tracks tab)))
|
||||||
|
(playlist-context-saved context))))
|
||||||
|
|
||||||
(define (normalize-state state)
|
(define (normalize-state state)
|
||||||
(cond
|
(cond
|
||||||
@@ -373,6 +400,13 @@
|
|||||||
(λ ()
|
(λ ()
|
||||||
(set-playback-session-error! session message))))
|
(set-playback-session-error! session message))))
|
||||||
|
|
||||||
|
;;; Converts an internal error value to a JSON-compatible message or key.
|
||||||
|
(define (error->jsexpr error)
|
||||||
|
(cond
|
||||||
|
((eq? error #f) 'null)
|
||||||
|
((symbol? error) (symbol->string error))
|
||||||
|
(else error)))
|
||||||
|
|
||||||
(define (clear-session-error! value session)
|
(define (clear-session-error! value session)
|
||||||
(set-session-error! value session #f))
|
(set-session-error! value session #f))
|
||||||
|
|
||||||
@@ -909,25 +943,28 @@
|
|||||||
trimmed)
|
trimmed)
|
||||||
(persist-playlists! value)))))
|
(persist-playlists! value)))))
|
||||||
|
|
||||||
|
;;; Close a tab, retaining saved playlists in the user's library.
|
||||||
(define (delete-tab! value session index)
|
(define (delete-tab! value session index)
|
||||||
(when (= (length (player-tabs value)) 1)
|
|
||||||
(raise-arguments-error
|
|
||||||
'player-command!
|
|
||||||
"the last playlist tab cannot be removed"))
|
|
||||||
(unless (and (exact-nonnegative-integer? index)
|
(unless (and (exact-nonnegative-integer? index)
|
||||||
(< index (length (player-tabs value))))
|
(< index (length (player-tabs value))))
|
||||||
(raise-arguments-error
|
(raise-arguments-error
|
||||||
'player-command!
|
'player-command!
|
||||||
"playlist tab does not exist"
|
"playlist tab does not exist"
|
||||||
"index" index))
|
"index" index))
|
||||||
|
(let ((context (playlist-context-for! value (player-active-playlist-user value))))
|
||||||
|
(when (and (= (length (player-tabs value)) 1)
|
||||||
|
(not (memq (current-tab value) (playlist-context-saved context))))
|
||||||
|
(raise-arguments-error 'player-command! "the last playlist tab cannot be removed")))
|
||||||
(stop-playback! value session)
|
(stop-playback! value session)
|
||||||
(with-state-lock
|
(with-state-lock
|
||||||
value
|
value
|
||||||
(λ ()
|
(λ ()
|
||||||
(save-current-tab! value)
|
(save-current-tab! value)
|
||||||
(let* ((tabs
|
(let* ((remaining
|
||||||
(append (take (player-tabs value) index)
|
(append (take (player-tabs value) index)
|
||||||
(drop (player-tabs value) (+ index 1))))
|
(drop (player-tabs value) (+ index 1))))
|
||||||
|
(tabs (if (pair? remaining) remaining
|
||||||
|
(list (playlist-tab (uuid-string) "Default" '()))))
|
||||||
(new-index
|
(new-index
|
||||||
(min (player-current-tab-index value)
|
(min (player-current-tab-index value)
|
||||||
(- (length tabs) 1))))
|
(- (length tabs) 1))))
|
||||||
@@ -940,6 +977,44 @@
|
|||||||
(set-playback-session-current-index! session #f)
|
(set-playback-session-current-index! session #f)
|
||||||
(persist-playlists! value)))))
|
(persist-playlists! value)))))
|
||||||
|
|
||||||
|
;;; Save an open tab in the library once; subsequent tab edits share its identity.
|
||||||
|
(define (save-playlist! value id name)
|
||||||
|
(let* ((context (playlist-context-for! value (player-active-playlist-user value)))
|
||||||
|
(tab (findf (λ (tab) (equal? (playlist-tab-id tab) id)) (player-tabs value)))
|
||||||
|
(trimmed (string-trim name)))
|
||||||
|
(unless tab
|
||||||
|
(raise-arguments-error 'player-command! "playlist tab does not exist" "id" id))
|
||||||
|
(when (string=? trimmed "")
|
||||||
|
(raise-arguments-error 'player-command! "playlist name cannot be empty"))
|
||||||
|
(with-state-lock
|
||||||
|
value
|
||||||
|
(λ ()
|
||||||
|
(save-current-tab! value)
|
||||||
|
(set-playlist-tab-name! tab trimmed)
|
||||||
|
(unless (memq tab (playlist-context-saved context))
|
||||||
|
(set-playlist-context-saved! context
|
||||||
|
(append (playlist-context-saved context) (list tab))))
|
||||||
|
(persist-playlists! value)))))
|
||||||
|
|
||||||
|
;;; Reveal a saved playlist as its own tab, reusing an existing tab by identity.
|
||||||
|
;;; Opening never copies tracks into another tab; play? starts this playlist.
|
||||||
|
(define (open-playlist! value session id play?)
|
||||||
|
(let* ((context (playlist-context-for! value (player-active-playlist-user value)))
|
||||||
|
(tab (findf (λ (tab) (equal? (playlist-tab-id tab) id))
|
||||||
|
(playlist-context-saved context))))
|
||||||
|
(unless tab
|
||||||
|
(raise-arguments-error 'player-command! "saved playlist does not exist" "id" id))
|
||||||
|
(let ((index (index-of (player-tabs value) tab eq?)))
|
||||||
|
(unless index
|
||||||
|
(with-state-lock
|
||||||
|
value
|
||||||
|
(λ ()
|
||||||
|
(save-current-tab! value)
|
||||||
|
(set-player-tabs! value (append (player-tabs value) (list tab))))))
|
||||||
|
(select-tab! value session (or index (- (length (player-tabs value)) 1)))))
|
||||||
|
(when (and play? (pair? (player-tracks value)))
|
||||||
|
(play-index! value session 0)))
|
||||||
|
|
||||||
(define (track->jsexpr item index)
|
(define (track->jsexpr item index)
|
||||||
(hasheq 'index index
|
(hasheq 'index index
|
||||||
'title (track-title item)
|
'title (track-title item)
|
||||||
@@ -966,11 +1041,29 @@
|
|||||||
'name (browser-entry-name entry)
|
'name (browser-entry-name entry)
|
||||||
'kind (symbol->string (browser-entry-kind entry))))
|
'kind (symbol->string (browser-entry-kind entry))))
|
||||||
|
|
||||||
(define (tab->jsexpr tab index)
|
;;; Cache serialized tracks and their summary until save-current-tab! invalidates
|
||||||
|
;;; them. A fresh opaque version also prevents cache reuse across server restarts.
|
||||||
|
(define (tab-snapshot tab)
|
||||||
|
(or (playlist-tab-snapshot tab)
|
||||||
|
(let* ((tracks (playlist-tab-tracks tab))
|
||||||
|
(snapshot
|
||||||
|
(hasheq 'version (uuid-string)
|
||||||
|
'count (length tracks)
|
||||||
|
'duration (apply + (map (λ (item) (or (track-duration item) 0))
|
||||||
|
tracks))
|
||||||
|
'tracks (map track->jsexpr tracks (range (length tracks))))))
|
||||||
|
(set-playlist-tab-snapshot! tab snapshot)
|
||||||
|
snapshot)))
|
||||||
|
|
||||||
|
;;; Return a small tab summary without rebuilding or transferring its tracks.
|
||||||
|
(define (tab->jsexpr tab index [saved? #f])
|
||||||
|
(let ((snapshot (tab-snapshot tab)))
|
||||||
(hasheq 'index index
|
(hasheq 'index index
|
||||||
'id (playlist-tab-id tab)
|
'id (playlist-tab-id tab)
|
||||||
'name (playlist-tab-name tab)
|
'name (playlist-tab-name tab)
|
||||||
'count (length (playlist-tab-tracks tab))))
|
'saved saved?
|
||||||
|
'count (hash-ref snapshot 'count)
|
||||||
|
'duration (hash-ref snapshot 'duration))))
|
||||||
|
|
||||||
(define (normal-device-id device)
|
(define (normal-device-id device)
|
||||||
(let ((id (upnp-device-udn device)))
|
(let ((id (upnp-device-udn device)))
|
||||||
@@ -1100,7 +1193,12 @@
|
|||||||
(rename-tab! value index
|
(rename-tab! value index
|
||||||
(or (json-string data 'name #f) "")))
|
(or (json-string data 'name #f) "")))
|
||||||
((string=? command "tab-delete")
|
((string=? command "tab-delete")
|
||||||
(delete-tab! value session index)))))
|
(delete-tab! value session index))
|
||||||
|
((string=? command "playlist-save")
|
||||||
|
(save-playlist! value (json-string data 'id #f) (or (json-string data 'name #f) "")))
|
||||||
|
((member command '("playlist-open" "playlist-play"))
|
||||||
|
(open-playlist! value session (json-string data 'id #f)
|
||||||
|
(string=? command "playlist-play"))))))
|
||||||
|
|
||||||
(define (perform-command! value session command data)
|
(define (perform-command! value session command data)
|
||||||
(cond
|
(cond
|
||||||
@@ -1110,7 +1208,7 @@
|
|||||||
((member command '("track-remove" "track-move"
|
((member command '("track-remove" "track-move"
|
||||||
"playlist-clear" "tab-add"
|
"playlist-clear" "tab-add"
|
||||||
"tab-select" "tab-rename"
|
"tab-select" "tab-rename"
|
||||||
"tab-delete"))
|
"tab-delete" "playlist-save" "playlist-open" "playlist-play"))
|
||||||
(perform-playlist-command! value session command data))
|
(perform-playlist-command! value session command data))
|
||||||
((string=? command "play")
|
((string=? command "play")
|
||||||
(play-index!
|
(play-index!
|
||||||
@@ -1257,23 +1355,15 @@
|
|||||||
app-id))
|
app-id))
|
||||||
(string-downcase app-id)))
|
(string-downcase app-id)))
|
||||||
(define store (open-playlist-store playlist-keystore))
|
(define store (open-playlist-store playlist-keystore))
|
||||||
(define stored-tabs
|
|
||||||
(load-user-playlists store "anonymous" libraries))
|
|
||||||
(let* ((library (and (pair? libraries) (car libraries)))
|
(let* ((library (and (pair? libraries) (car libraries)))
|
||||||
(browser-entries
|
(browser-entries
|
||||||
(if library
|
(if library
|
||||||
(browse-library library '())
|
(browse-library library '())
|
||||||
'()))
|
'()))
|
||||||
(tabs
|
(initial-context (restore-playlist-context store "anonymous" libraries))
|
||||||
(if (pair? stored-tabs)
|
(tabs (playlist-context-tabs initial-context))
|
||||||
(for/list ((tab (in-list stored-tabs)))
|
|
||||||
(playlist-tab (persisted-tab-id tab)
|
|
||||||
(persisted-tab-name tab)
|
|
||||||
(persisted-tab-tracks tab)))
|
|
||||||
(list (playlist-tab (uuid-string) "Default" '()))))
|
|
||||||
(selected-index 0)
|
(selected-index 0)
|
||||||
(contexts (make-hash))
|
(contexts (make-hash)))
|
||||||
(initial-context (playlist-context tabs selected-index)))
|
|
||||||
(hash-set! contexts "anonymous" initial-context)
|
(hash-set! contexts "anonymous" initial-context)
|
||||||
(define value
|
(define value
|
||||||
(player libraries
|
(player libraries
|
||||||
@@ -1303,12 +1393,17 @@
|
|||||||
value))
|
value))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : Return the complete browser-visible player state.
|
; goal : Return browser-visible state, optionally reusing known playlist tracks.
|
||||||
; pre : Value was created with make-player.
|
; pre : Value was created with make-player.
|
||||||
; post : Cached DLNA playback information has been incorporated.
|
; post : Cached DLNA playback information has been incorporated.
|
||||||
; result : A JSON-compatible hash.
|
; result : A JSON-compatible hash with playlistVersion. tracks is null when
|
||||||
|
; playlist-version matches; otherwise it contains the complete list.
|
||||||
|
; internals: tab-snapshot caches track JSON, duration and a unique version until
|
||||||
|
; a playlist mutation invalidates it. Comparison and state assembly
|
||||||
|
; share the player locks, so the version always matches the tracks.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (player-state->jsexpr value #:username [username "anonymous"])
|
(define (player-state->jsexpr value #:username [username "anonymous"]
|
||||||
|
#:playlist-version [playlist-version #f])
|
||||||
(define normalized (normal-playlist-username username))
|
(define normalized (normal-playlist-username username))
|
||||||
(call-with-semaphore
|
(call-with-semaphore
|
||||||
(player-command-lock value)
|
(player-command-lock value)
|
||||||
@@ -1319,7 +1414,7 @@
|
|||||||
(define context (playlist-context-for! value normalized))
|
(define context (playlist-context-for! value normalized))
|
||||||
(define tabs (playlist-context-tabs context))
|
(define tabs (playlist-context-tabs context))
|
||||||
(define tab-index (playlist-context-current-index context))
|
(define tab-index (playlist-context-current-index context))
|
||||||
(define tracks (playlist-tab-tracks (list-ref tabs tab-index)))
|
(define snapshot (tab-snapshot (list-ref tabs tab-index)))
|
||||||
(with-state-lock
|
(with-state-lock
|
||||||
value
|
value
|
||||||
(λ ()
|
(λ ()
|
||||||
@@ -1345,12 +1440,17 @@
|
|||||||
'tabs
|
'tabs
|
||||||
(for/list ((tab (in-list tabs))
|
(for/list ((tab (in-list tabs))
|
||||||
(index (in-naturals)))
|
(index (in-naturals)))
|
||||||
(tab->jsexpr tab index))
|
(tab->jsexpr tab index (and (memq tab (playlist-context-saved context)) #t)))
|
||||||
|
'savedPlaylists
|
||||||
|
(map (λ (tab index) (tab->jsexpr tab index #t))
|
||||||
|
(playlist-context-saved context)
|
||||||
|
(range (length (playlist-context-saved context))))
|
||||||
'currentTab tab-index
|
'currentTab tab-index
|
||||||
|
'playlistVersion (hash-ref snapshot 'version)
|
||||||
'tracks
|
'tracks
|
||||||
(for/list ((item (in-list tracks))
|
(if (equal? playlist-version (hash-ref snapshot 'version))
|
||||||
(index (in-naturals)))
|
'null
|
||||||
(track->jsexpr item index))
|
(hash-ref snapshot 'tracks))
|
||||||
'renderers (map renderer->jsexpr
|
'renderers (map renderer->jsexpr
|
||||||
(player-renderers value))
|
(player-renderers value))
|
||||||
'rendererId (or (playback-session-selected-id session) 'null)
|
'rendererId (or (playback-session-selected-id session) 'null)
|
||||||
@@ -1372,22 +1472,24 @@
|
|||||||
'volume (playback-session-volume session)
|
'volume (playback-session-volume session)
|
||||||
'repeat (symbol->string (playback-session-repeat session))
|
'repeat (symbol->string (playback-session-repeat session))
|
||||||
'discovering (player-discovering? value)
|
'discovering (player-discovering? value)
|
||||||
'error (or (playback-session-error session)
|
'error (error->jsexpr
|
||||||
(player-error value)
|
(or (playback-session-error session)
|
||||||
'null))))))))
|
(player-error value))))))))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : Execute one browser player command.
|
; goal : Execute one browser player command.
|
||||||
; pre : Command is a string and data is a JSON object hash.
|
; pre : Command is a string and data is a JSON object hash.
|
||||||
; post : The command has completed or a concrete exception is raised.
|
; post : The command has completed or a concrete exception is raised.
|
||||||
; result : The updated JSON-compatible player state.
|
; result : The updated JSON-compatible player state. With a matching
|
||||||
|
; playlist-version, tracks is null as in player-state->jsexpr.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define playlist-context-commands
|
(define playlist-context-commands
|
||||||
'("item-play" "item-add" "track-remove" "track-move"
|
'("item-play" "item-add" "track-remove" "track-move"
|
||||||
"playlist-clear" "tab-add" "tab-select" "tab-rename"
|
"playlist-clear" "tab-add" "tab-select" "tab-rename"
|
||||||
"tab-delete" "play"))
|
"tab-delete" "playlist-save" "playlist-open" "playlist-play" "play"))
|
||||||
|
|
||||||
(define (player-command! value command data #:username [username "anonymous"])
|
(define (player-command! value command data #:username [username "anonymous"]
|
||||||
|
#:playlist-version [playlist-version #f])
|
||||||
(define normalized (normal-playlist-username username))
|
(define normalized (normal-playlist-username username))
|
||||||
(call-with-semaphore
|
(call-with-semaphore
|
||||||
(player-command-lock value)
|
(player-command-lock value)
|
||||||
@@ -1405,7 +1507,8 @@
|
|||||||
(when (member command playlist-context-commands)
|
(when (member command playlist-context-commands)
|
||||||
(activate-playlist-user! value normalized session))
|
(activate-playlist-user! value normalized session))
|
||||||
(perform-command! value session command data))))
|
(perform-command! value session command data))))
|
||||||
(player-state->jsexpr value #:username normalized))
|
(player-state->jsexpr value #:username normalized
|
||||||
|
#:playlist-version playlist-version))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : Discover UPnP renderers and logical Sonos groups asynchronously.
|
; goal : Discover UPnP renderers and logical Sonos groups asynchronously.
|
||||||
@@ -1649,7 +1752,7 @@
|
|||||||
(define item
|
(define item
|
||||||
(call-with-semaphore
|
(call-with-semaphore
|
||||||
(player-command-lock value)
|
(player-command-lock value)
|
||||||
(lambda ()
|
(λ ()
|
||||||
(define context
|
(define context
|
||||||
(playlist-context-for!
|
(playlist-context-for!
|
||||||
value
|
value
|
||||||
@@ -1659,7 +1762,7 @@
|
|||||||
(player-tracks value)
|
(player-tracks value)
|
||||||
(append-map playlist-tab-tracks
|
(append-map playlist-tab-tracks
|
||||||
(playlist-context-tabs context))))
|
(playlist-context-tabs context))))
|
||||||
(findf (lambda (candidate)
|
(findf (λ (candidate)
|
||||||
(string=? (track-cache-key candidate) artwork-id))
|
(string=? (track-cache-key candidate) artwork-id))
|
||||||
candidates))))
|
candidates))))
|
||||||
(and item (track-artwork item)))
|
(and item (track-artwork item)))
|
||||||
@@ -1718,10 +1821,176 @@
|
|||||||
(λ ()
|
(λ ()
|
||||||
(set-player-closed?! value #t)))))))
|
(set-player-closed?! value #t)))))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Tests for module player.rkt
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(require rackunit
|
(require json
|
||||||
|
rackunit
|
||||||
racket/file)
|
racket/file)
|
||||||
|
|
||||||
|
(test-case "playlist versions cache 1000 tracks and follow user mutations"
|
||||||
|
(let ((value (make-player '() #:playlist-keystore #f #:local-output? #f)))
|
||||||
|
(dynamic-wind
|
||||||
|
void
|
||||||
|
(λ ()
|
||||||
|
(let* ((session (playback-session-for! value "anonymous"))
|
||||||
|
(tracks
|
||||||
|
(build-list
|
||||||
|
1000
|
||||||
|
(λ (index)
|
||||||
|
(track (build-path (find-system-path 'temp-dir)
|
||||||
|
(format "playlist-test-~a.flac" index))
|
||||||
|
(format "Track ~a" index) "Artist" "Album" 60 "audio/flac")))))
|
||||||
|
(replace-tracks! value session tracks)
|
||||||
|
(let* ((full (player-state->jsexpr value))
|
||||||
|
(version (hash-ref full 'playlistVersion))
|
||||||
|
(compact (player-state->jsexpr value #:playlist-version version))
|
||||||
|
(repeated (player-state->jsexpr value)))
|
||||||
|
(check-equal? (length (hash-ref full 'tracks)) 1000)
|
||||||
|
(check-equal? (hash-ref (car (hash-ref full 'tabs)) 'duration) 60000)
|
||||||
|
(check-eq? (hash-ref compact 'tracks) 'null)
|
||||||
|
(check-eq? (hash-ref full 'tracks) (hash-ref repeated 'tracks))
|
||||||
|
(check-true (< (bytes-length (jsexpr->bytes compact))
|
||||||
|
(/ (bytes-length (jsexpr->bytes full)) 20)))
|
||||||
|
(check-eq?
|
||||||
|
(hash-ref (player-command! value "repeat" (hasheq 'mode "all")
|
||||||
|
#:playlist-version version) 'tracks)
|
||||||
|
'null)
|
||||||
|
(check-eq?
|
||||||
|
(hash-ref (player-command! value "tab-rename" (hasheq 'index 0 'name "Music")
|
||||||
|
#:playlist-version version) 'tracks)
|
||||||
|
'null)
|
||||||
|
(let* ((moved (player-command! value "track-move" (hasheq 'from 0 'to 1)
|
||||||
|
#:playlist-version version))
|
||||||
|
(moved-version (hash-ref moved 'playlistVersion))
|
||||||
|
(other-browser (player-state->jsexpr value #:playlist-version version)))
|
||||||
|
(check-not-equal? moved-version version)
|
||||||
|
(check-equal? (hash-ref (car (hash-ref moved 'tracks)) 'title) "Track 1")
|
||||||
|
(check-equal? (hash-ref other-browser 'playlistVersion) moved-version)
|
||||||
|
(check-equal? (hash-ref other-browser 'tracks) (hash-ref moved 'tracks))
|
||||||
|
(let* ((removed (player-command! value "track-remove" (hasheq 'index 0)
|
||||||
|
#:playlist-version moved-version))
|
||||||
|
(removed-version (hash-ref removed 'playlistVersion))
|
||||||
|
(new-tab (player-command! value "tab-add" (hasheq)
|
||||||
|
#:playlist-version removed-version))
|
||||||
|
(selected (player-command! value "tab-select" (hasheq 'index 0)
|
||||||
|
#:playlist-version (hash-ref new-tab 'playlistVersion))))
|
||||||
|
(check-equal? (length (hash-ref removed 'tracks)) 999)
|
||||||
|
(check-not-equal? removed-version moved-version)
|
||||||
|
(check-equal? (hash-ref new-tab 'tracks) '())
|
||||||
|
(check-equal? (hash-ref selected 'playlistVersion) removed-version)
|
||||||
|
(check-equal? (length (hash-ref selected 'tracks)) 999)
|
||||||
|
(let ((other-user (player-state->jsexpr value #:username "another-user"
|
||||||
|
#:playlist-version removed-version))
|
||||||
|
(cleared (player-command! value "playlist-clear" (hasheq)
|
||||||
|
#:playlist-version removed-version)))
|
||||||
|
(check-equal? (hash-ref other-user 'tracks) '())
|
||||||
|
(check-not-equal? (hash-ref other-user 'playlistVersion) removed-version)
|
||||||
|
(check-equal? (hash-ref cleared 'tracks) '())
|
||||||
|
(check-not-equal? (hash-ref cleared 'playlistVersion) removed-version)
|
||||||
|
(append-tracks! value session (list (car tracks)))
|
||||||
|
(let* ((added (player-state->jsexpr value
|
||||||
|
#:playlist-version (hash-ref cleared 'playlistVersion)))
|
||||||
|
(added-version (hash-ref added 'playlistVersion)))
|
||||||
|
(check-equal? (length (hash-ref added 'tracks)) 1)
|
||||||
|
(check-equal? (hash-ref (car (hash-ref added 'tabs)) 'duration) 60)
|
||||||
|
(append-tracks! value session (list (car tracks)))
|
||||||
|
(check-eq? (hash-ref (player-state->jsexpr value #:playlist-version added-version)
|
||||||
|
'tracks)
|
||||||
|
'null))))))))
|
||||||
|
(λ () (player-close! value)))))
|
||||||
|
|
||||||
|
(check-equal? (error->jsexpr #f) 'null)
|
||||||
|
(check-equal?
|
||||||
|
(error->jsexpr 'dlna-renderer-unreachable)
|
||||||
|
"dlna-renderer-unreachable")
|
||||||
|
(check-equal? (error->jsexpr "technical error") "technical error")
|
||||||
|
|
||||||
|
(test-case "saved playlists reopen as shared tabs and survive closing and restart"
|
||||||
|
(let ((root (make-temporary-file "saved-playlists-~a" 'directory)))
|
||||||
|
(dynamic-wind
|
||||||
|
(λ ()
|
||||||
|
(call-with-output-file (build-path root "one.flac") void)
|
||||||
|
(call-with-output-file (build-path root "two.flac") void))
|
||||||
|
(λ ()
|
||||||
|
(let* ((libraries (make-music-libraries (list root)))
|
||||||
|
(store-file (build-path root "playlists.keystore"))
|
||||||
|
(agent-id (make-string 64 #\b))
|
||||||
|
(value (make-player libraries #:playlist-keystore store-file
|
||||||
|
#:local-output? #f #:allowed-agent-ids (list agent-id)))
|
||||||
|
(session (playback-session-for! value "anonymous"))
|
||||||
|
(first (track (build-path root "one.flac") "One" "Artist" "Album" 60 "audio/flac"))
|
||||||
|
(second (track (build-path root "two.flac") "Two" "Artist" "Album" 120 "audio/flac")))
|
||||||
|
(dynamic-wind
|
||||||
|
void
|
||||||
|
(λ ()
|
||||||
|
(replace-tracks! value session (list first second))
|
||||||
|
(let* ((initial (player-state->jsexpr value))
|
||||||
|
(id (hash-ref (car (hash-ref initial 'tabs)) 'id))
|
||||||
|
(version (hash-ref initial 'playlistVersion))
|
||||||
|
(saved (player-command! value "playlist-save" (hasheq 'id id 'name "Favorites")
|
||||||
|
#:playlist-version version)))
|
||||||
|
(check-equal? (hash-ref initial 'savedPlaylists) '())
|
||||||
|
(check-eq? (hash-ref saved 'tracks) 'null)
|
||||||
|
(check-true (hash-ref (car (hash-ref saved 'tabs)) 'saved))
|
||||||
|
(check-equal? (hash-ref (car (hash-ref saved 'savedPlaylists)) 'id) id)
|
||||||
|
(check-equal? (hash-ref (car (hash-ref saved 'savedPlaylists)) 'duration) 180)
|
||||||
|
(check-equal?
|
||||||
|
(length (hash-ref (player-command! value "playlist-save" (hasheq 'id id 'name "Favorites"))
|
||||||
|
'savedPlaylists)) 1)
|
||||||
|
(player-command! value "tab-add" (hasheq))
|
||||||
|
(replace-tracks! value session (list first))
|
||||||
|
(let ((opened (player-command! value "playlist-open" (hasheq 'id id))))
|
||||||
|
(check-equal? (length (hash-ref opened 'tabs)) 2)
|
||||||
|
(check-equal? (hash-ref opened 'currentTab) 0)
|
||||||
|
(check-equal? (map track-title (playlist-tab-tracks (list-ref (player-tabs value) 1))) '("One"))
|
||||||
|
(check-equal? (length (hash-ref (player-command! value "playlist-open" (hasheq 'id id)) 'tabs)) 2))
|
||||||
|
(player-command! value "tab-rename" (hasheq 'index 0 'name "Renamed"))
|
||||||
|
(let ((edited (player-command! value "track-remove" (hasheq 'index 0))))
|
||||||
|
(check-equal? (hash-ref (car (hash-ref edited 'savedPlaylists)) 'name) "Renamed")
|
||||||
|
(check-equal? (hash-ref (car (hash-ref edited 'savedPlaylists)) 'count) 1)
|
||||||
|
(check-equal? (hash-ref (car (hash-ref edited 'savedPlaylists)) 'duration) 120))
|
||||||
|
(player-command! value "tab-delete" (hasheq 'index 0))
|
||||||
|
(let ((opened (player-command! value "playlist-open" (hasheq 'id id))))
|
||||||
|
(check-equal? (length (hash-ref opened 'tabs)) 2)
|
||||||
|
(check-equal? (hash-ref opened 'currentTab) 1)
|
||||||
|
(check-equal? (map (λ (track) (hash-ref track 'title)) (hash-ref opened 'tracks)) '("Two")))
|
||||||
|
(player-agent-register! value (hasheq 'appId agent-id 'name "Test agent"))
|
||||||
|
(player-command! value "renderer" (hasheq 'id (agent-renderer-id agent-id)))
|
||||||
|
(let ((playing (player-command! value "playlist-play" (hasheq 'id id))))
|
||||||
|
(check-equal? (hash-ref playing 'currentIndex) 0)
|
||||||
|
(check-equal? (length (hash-ref playing 'tabs)) 2)
|
||||||
|
(check-equal?
|
||||||
|
(hash-ref (hash-ref (player-agent-poll! value (hasheq 'appId agent-id)) 'command) 'action)
|
||||||
|
"play"))
|
||||||
|
(player-command! value "tab-delete" (hasheq 'index 1))
|
||||||
|
(check-equal? (hash-ref (player-state->jsexpr value #:username "other") 'savedPlaylists) '())
|
||||||
|
(check-exn exn:fail?
|
||||||
|
(λ () (player-command! value "playlist-open" (hasheq 'id id) #:username "other")))
|
||||||
|
(player-close! value)
|
||||||
|
(let ((restored (make-player libraries #:playlist-keystore store-file #:local-output? #f)))
|
||||||
|
(dynamic-wind
|
||||||
|
void
|
||||||
|
(λ ()
|
||||||
|
(let ((state (player-state->jsexpr restored)))
|
||||||
|
(check-equal? (length (hash-ref state 'tabs)) 1)
|
||||||
|
(check-equal? (hash-ref (car (hash-ref state 'savedPlaylists)) 'id) id))
|
||||||
|
(player-command! restored "playlist-open" (hasheq 'id id))
|
||||||
|
(let ((renamed (player-command! restored "tab-rename" (hasheq 'index 1 'name "Restored"))))
|
||||||
|
(check-equal? (hash-ref (car (hash-ref renamed 'savedPlaylists)) 'name) "Restored")
|
||||||
|
(check-equal? (map (λ (track) (hash-ref track 'title)) (hash-ref renamed 'tracks)) '("Two")))
|
||||||
|
(player-command! restored "tab-delete" (hasheq 'index 0))
|
||||||
|
(let ((closed (player-command! restored "tab-delete" (hasheq 'index 0))))
|
||||||
|
(check-equal? (length (hash-ref closed 'tabs)) 1)
|
||||||
|
(check-false (hash-ref (car (hash-ref closed 'tabs)) 'saved))
|
||||||
|
(check-equal? (hash-ref closed 'tracks) '())
|
||||||
|
(check-equal? (hash-ref (car (hash-ref closed 'savedPlaylists)) 'id) id)))
|
||||||
|
(λ () (player-close! restored))))))
|
||||||
|
(λ () (player-close! value)))))
|
||||||
|
(λ () (delete-directory/files root)))))
|
||||||
|
|
||||||
(define root
|
(define root
|
||||||
(make-temporary-file "rkt-web-player-~a" 'directory))
|
(make-temporary-file "rkt-web-player-~a" 'directory))
|
||||||
|
|
||||||
|
|||||||
+202
-94
@@ -1,6 +1,7 @@
|
|||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(require keystore
|
(require keystore
|
||||||
|
racket/contract
|
||||||
racket/file
|
racket/file
|
||||||
racket/list
|
racket/list
|
||||||
racket/path
|
racket/path
|
||||||
@@ -15,18 +16,32 @@
|
|||||||
load-user-language
|
load-user-language
|
||||||
save-user-language!)
|
save-user-language!)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Represent one named playlist tab in durable player state.
|
||||||
|
; pre : Id is a UUID string, name is non-empty, and tracks contains tracks.
|
||||||
|
; post : Constructing or inspecting a value changes no external state.
|
||||||
|
; result : persisted-tab? recognizes stored and restored playlist tabs.
|
||||||
|
; internals: track->datum serializes the tracks and datum->tab reconstructs
|
||||||
|
; this value after validating its id, name and track collection.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(struct persisted-tab (id name tracks) #:transparent)
|
(struct persisted-tab (id name tracks) #:transparent)
|
||||||
(struct playlist-store (keystore lock) #:transparent)
|
|
||||||
|
|
||||||
(define (user-playlists-key username)
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(format "playlists-for-~a" username))
|
;; Supporting functions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;;; Keep open tabs and saved library playlists in separate ordered UUID indexes.
|
||||||
|
(define (user-playlists-key username [saved? #f])
|
||||||
|
(format "~aplaylists-for-~a" (if saved? "saved-" "") username))
|
||||||
|
|
||||||
|
;;; Produces the keystore key containing one user's language preference.
|
||||||
(define (user-language-key username)
|
(define (user-language-key username)
|
||||||
(format "language-for-~a" username))
|
(format "language-for-~a" username))
|
||||||
|
|
||||||
(define supported-language-names
|
(define supported-language-names
|
||||||
'("en" "nl" "de" "fr" "es" "it" "sv" "no" "fi" "is"))
|
'("en" "nl" "de" "fr" "es" "it" "sv" "no" "fi" "is"))
|
||||||
|
|
||||||
|
;;; Serializes a track without exposing the track struct to the keystore.
|
||||||
(define (track->datum item)
|
(define (track->datum item)
|
||||||
(hasheq 'file (path->string (track-file item))
|
(hasheq 'file (path->string (track-file item))
|
||||||
'title (track-title item)
|
'title (track-title item)
|
||||||
@@ -35,111 +50,188 @@
|
|||||||
'duration (or (track-duration item) #f)
|
'duration (or (track-duration item) #f)
|
||||||
'mime-type (or (track-mime-type item) #f)))
|
'mime-type (or (track-mime-type item) #f)))
|
||||||
|
|
||||||
|
;;; Checks whether a stored optional value is #f or a string.
|
||||||
(define (optional-string? value)
|
(define (optional-string? value)
|
||||||
(or (not value) (string? value)))
|
(or (eq? value #f) (string? value)))
|
||||||
|
|
||||||
|
;;; Validates and restores one stored track.
|
||||||
|
;;; Files outside the configured libraries are deliberately rejected.
|
||||||
(define (datum->track value libraries)
|
(define (datum->track value libraries)
|
||||||
(and (hash? value)
|
(if (not (hash? value))
|
||||||
(let ((file (hash-ref value 'file #f))
|
#f
|
||||||
|
(let* ((file (hash-ref value 'file #f))
|
||||||
(title (hash-ref value 'title #f))
|
(title (hash-ref value 'title #f))
|
||||||
(artist (hash-ref value 'artist #f))
|
(artist (hash-ref value 'artist #f))
|
||||||
(album (hash-ref value 'album #f))
|
(album (hash-ref value 'album #f))
|
||||||
(duration (hash-ref value 'duration #f))
|
(duration (hash-ref value 'duration #f))
|
||||||
(mime-type (hash-ref value 'mime-type #f)))
|
(mime-type (hash-ref value 'mime-type #f))
|
||||||
|
(valid-duration?
|
||||||
|
(or (eq? duration #f)
|
||||||
|
(and (number? duration)
|
||||||
|
(not (negative? duration)))))
|
||||||
|
(valid-metadata?
|
||||||
(and (path-string? file)
|
(and (path-string? file)
|
||||||
(string? title)
|
(string? title)
|
||||||
(string? artist)
|
(string? artist)
|
||||||
(string? album)
|
(string? album)
|
||||||
(or (not duration)
|
valid-duration?
|
||||||
(and (number? duration) (not (negative? duration))))
|
(optional-string? mime-type))))
|
||||||
(optional-string? mime-type)
|
(if (and valid-metadata?
|
||||||
(library-contains-audio-file? libraries file)
|
(library-contains-audio-file? libraries file))
|
||||||
(track (path->complete-path file)
|
(track (path->complete-path file)
|
||||||
title artist album duration mime-type)))))
|
title artist album duration mime-type)
|
||||||
|
#f))))
|
||||||
|
|
||||||
|
;;; Validates and restores one tab while discarding invalid track entries.
|
||||||
(define (datum->tab id value libraries)
|
(define (datum->tab id value libraries)
|
||||||
(and (uuid-string? id)
|
(if (not (and (uuid-string? id) (hash? value)))
|
||||||
(hash? value)
|
#f
|
||||||
(let ((name (hash-ref value 'name #f))
|
(let ((name (hash-ref value 'name #f))
|
||||||
(tracks (hash-ref value 'tracks #f)))
|
(tracks (hash-ref value 'tracks #f)))
|
||||||
(and (string? name)
|
(if (and (string? name)
|
||||||
(not (string=? name ""))
|
(not (string=? name ""))
|
||||||
(list? tracks)
|
(list? tracks))
|
||||||
(persisted-tab
|
(persisted-tab
|
||||||
id
|
id
|
||||||
name
|
name
|
||||||
(filter-map
|
(filter-map
|
||||||
(lambda (item) (datum->track item libraries))
|
(λ (item) (datum->track item libraries))
|
||||||
tracks))))))
|
tracks))
|
||||||
|
#f))))
|
||||||
|
|
||||||
(define (open-playlist-store file)
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(and file
|
;; Provided functions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Open the durable store used for playlists and user preferences.
|
||||||
|
; pre : File is #f or a writable keystore path.
|
||||||
|
; post : The parent directory and keystore exist when file is provided.
|
||||||
|
; result : An open keystore handle, or #f when persistence is disabled.
|
||||||
|
; internals: path->complete-path fixes the storage location, ks-open creates or
|
||||||
|
; opens the keystore, and later operations use the lock belonging to
|
||||||
|
; the returned handle.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define/contract (open-playlist-store file)
|
||||||
|
(-> (or/c path-string? #f) (or/c keystore? #f))
|
||||||
|
(if (eq? file #f)
|
||||||
|
#f
|
||||||
(let ((target (path->complete-path file)))
|
(let ((target (path->complete-path file)))
|
||||||
(make-parent-directory* target)
|
(make-parent-directory* target)
|
||||||
(playlist-store (ks-open target) (make-semaphore 1)))))
|
(ks-open target))))
|
||||||
|
|
||||||
(define (close-playlist-store! store)
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Close an open playlist store.
|
||||||
|
; pre : Store is #f or was returned by open-playlist-store.
|
||||||
|
; post : Its keystore handle is closed; #f remains a harmless no-op.
|
||||||
|
; result : Void.
|
||||||
|
; internals: ks-with-lock uses the lock belonging to the keystore handle and
|
||||||
|
; prevents ks-close from overlapping a load or save operation.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define/contract (close-playlist-store! store)
|
||||||
|
(-> (or/c keystore? #f) void?)
|
||||||
(when store
|
(when store
|
||||||
(call-with-semaphore
|
(ks-with-lock store (λ () (ks-close store))))
|
||||||
(playlist-store-lock store)
|
|
||||||
(lambda () (ks-close (playlist-store-keystore store)))))
|
|
||||||
(void))
|
(void))
|
||||||
|
|
||||||
(define (load-user-playlists store username libraries)
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(if (not store)
|
; goal : Restore one user's open tabs, or saved library playlists with saved?.
|
||||||
|
; pre : Store is #f or open, username is normalized, and libraries are valid.
|
||||||
|
; post : Store contents remain unchanged and unsafe track paths are omitted.
|
||||||
|
; result : Valid persisted-tab values in their saved order.
|
||||||
|
; internals: ks-with-lock serializes the index and tab reads on the keystore
|
||||||
|
; handle. user-playlists-key locates the UUID index; datum->tab then
|
||||||
|
; validates each referenced tab and delegates track safety checks to
|
||||||
|
; datum->track.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define/contract (load-user-playlists store username libraries #:saved? [saved? #f])
|
||||||
|
(->* ((or/c keystore? #f) string? (listof music-library?))
|
||||||
|
(#:saved? boolean?)
|
||||||
|
(listof persisted-tab?))
|
||||||
|
(if (eq? store #f)
|
||||||
'()
|
'()
|
||||||
(call-with-semaphore
|
(ks-with-lock
|
||||||
(playlist-store-lock store)
|
store
|
||||||
(lambda ()
|
(λ ()
|
||||||
(define ks (playlist-store-keystore store))
|
(let ((ids (ks-get store (user-playlists-key username saved?) '())))
|
||||||
(define ids (ks-get ks (user-playlists-key username) '()))
|
|
||||||
(if (list? ids)
|
(if (list? ids)
|
||||||
(filter-map
|
(filter-map
|
||||||
(lambda (id)
|
(λ (id)
|
||||||
(datum->tab id (ks-get ks id #f) libraries))
|
(datum->tab id (ks-get store id #f) libraries))
|
||||||
(remove-duplicates (filter uuid-string? ids) string=?))
|
(remove-duplicates (filter uuid-string? ids) string=?))
|
||||||
'())))))
|
'()))))))
|
||||||
|
|
||||||
(define (save-user-playlists! store username tabs)
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Persist one user's open tabs and saved library playlists atomically.
|
||||||
|
; pre : Store is #f or open, username is normalized, and tabs are valid.
|
||||||
|
; post : Both UUID indexes match tabs/saved. Closing a saved tab retains its
|
||||||
|
; data; playlists absent from both indexes are removed.
|
||||||
|
; result : Void.
|
||||||
|
; internals: ks-with-lock prevents another operation from entering this update.
|
||||||
|
; ks-transaction removes stale ids from user-playlists-key, stores
|
||||||
|
; each distinct playlist using track->datum, and replaces both indexes.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define/contract (save-user-playlists! store username tabs #:saved [saved '()])
|
||||||
|
(->* ((or/c keystore? #f) string? (listof persisted-tab?))
|
||||||
|
(#:saved (listof persisted-tab?))
|
||||||
|
void?)
|
||||||
(when store
|
(when store
|
||||||
(call-with-semaphore
|
(ks-with-lock
|
||||||
(playlist-store-lock store)
|
store
|
||||||
(lambda ()
|
(λ ()
|
||||||
(define ks (playlist-store-keystore store))
|
(let* ((index-key (user-playlists-key username))
|
||||||
(define index-key (user-playlists-key username))
|
(saved-key (user-playlists-key username #t))
|
||||||
(define old-ids (ks-get ks index-key '()))
|
(old-open (ks-get store index-key '()))
|
||||||
(define ids (map persisted-tab-id tabs))
|
(old-saved (ks-get store saved-key '()))
|
||||||
|
(old-ids (append (if (list? old-open) old-open '())
|
||||||
|
(if (list? old-saved) old-saved '())))
|
||||||
|
(ids (map persisted-tab-id tabs))
|
||||||
|
(saved-ids (map persisted-tab-id saved))
|
||||||
|
(all-tabs (remove-duplicates (append tabs saved)
|
||||||
|
string=? #:key persisted-tab-id))
|
||||||
|
(stale-ids
|
||||||
|
(filter
|
||||||
|
(λ (id)
|
||||||
|
(and (string? id)
|
||||||
|
(not (member id ids string=?))
|
||||||
|
(not (member id saved-ids string=?))))
|
||||||
|
(remove-duplicates old-ids))))
|
||||||
(ks-transaction
|
(ks-transaction
|
||||||
ks
|
store
|
||||||
(for ((id (in-list (if (list? old-ids) old-ids '())))
|
(for-each (λ (id) (ks-drop! store id)) stale-ids)
|
||||||
#:when (and (string? id) (not (member id ids string=?))))
|
(for-each
|
||||||
(ks-drop! ks id))
|
(λ (tab)
|
||||||
(for ((tab (in-list tabs)))
|
|
||||||
(ks-set!
|
(ks-set!
|
||||||
ks
|
store
|
||||||
(persisted-tab-id tab)
|
(persisted-tab-id tab)
|
||||||
(hasheq 'name (persisted-tab-name tab)
|
(hasheq 'name (persisted-tab-name tab)
|
||||||
'tracks (map track->datum
|
'tracks (map track->datum
|
||||||
(persisted-tab-tracks tab)))))
|
(persisted-tab-tracks tab)))))
|
||||||
(ks-set! ks index-key ids))
|
all-tabs)
|
||||||
|
(ks-set! store index-key ids)
|
||||||
|
(ks-set! store saved-key saved-ids))
|
||||||
(void)))))
|
(void)))))
|
||||||
|
(void))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : Load one user's persisted interface language.
|
; goal : Load one user's persisted interface language.
|
||||||
; pre : Store is #f or an open playlist store; username is normalized.
|
; pre : Store is #f or an open playlist store; username is normalized.
|
||||||
; post : Store contents remain unchanged.
|
; post : Store contents remain unchanged.
|
||||||
; result : A supported ISO language name, or #f when none was saved.
|
; result : A supported ISO language name, or #f when none was saved.
|
||||||
|
; internals: user-language-key selects the keystore entry while ks-with-lock
|
||||||
|
; holds the handle's lock. Only supported language names return.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (load-user-language store username)
|
(define/contract (load-user-language store username)
|
||||||
(and store
|
(-> (or/c keystore? #f) string? (or/c string? #f))
|
||||||
(call-with-semaphore
|
(if (eq? store #f)
|
||||||
(playlist-store-lock store)
|
#f
|
||||||
|
(ks-with-lock
|
||||||
|
store
|
||||||
(λ ()
|
(λ ()
|
||||||
(define value
|
(let ((value (ks-get store (user-language-key username) #f)))
|
||||||
(ks-get (playlist-store-keystore store)
|
(if (member value supported-language-names)
|
||||||
(user-language-key username)
|
value
|
||||||
#f))
|
#f))))))
|
||||||
(and (member value supported-language-names) value)))))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : Persist one user's interface language.
|
; goal : Persist one user's interface language.
|
||||||
@@ -147,22 +239,27 @@
|
|||||||
; en, nl, de, fr, es, it, sv, no, fi, or is.
|
; en, nl, de, fr, es, it, sv, no, fi, or is.
|
||||||
; post : The user's language key contains language when a store exists.
|
; post : The user's language key contains language when a store exists.
|
||||||
; result : Void.
|
; result : Void.
|
||||||
|
; internals: Validation precedes persistence. user-language-key identifies the
|
||||||
|
; entry and ks-with-lock serializes the ks-set! call on the handle.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (save-user-language! store username language)
|
(define/contract (save-user-language! store username language)
|
||||||
|
(-> (or/c keystore? #f) string? string? void?)
|
||||||
(unless (member language supported-language-names)
|
(unless (member language supported-language-names)
|
||||||
(raise-argument-error
|
(raise-argument-error
|
||||||
'save-user-language!
|
'save-user-language!
|
||||||
"one of en, nl, de, fr, es, it, sv, no, fi, or is"
|
"one of en, nl, de, fr, es, it, sv, no, fi, or is"
|
||||||
language))
|
language))
|
||||||
(when store
|
(when store
|
||||||
(call-with-semaphore
|
(ks-with-lock
|
||||||
(playlist-store-lock store)
|
store
|
||||||
(λ ()
|
(λ ()
|
||||||
(ks-set! (playlist-store-keystore store)
|
(ks-set! store (user-language-key username) language))))
|
||||||
(user-language-key username)
|
|
||||||
language))))
|
|
||||||
(void))
|
(void))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Tests for module playlists.rkt
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(require rackunit
|
(require rackunit
|
||||||
uuid/random)
|
uuid/random)
|
||||||
@@ -173,24 +270,32 @@
|
|||||||
(define music-two (build-path root "music-two"))
|
(define music-two (build-path root "music-two"))
|
||||||
(define outside (build-path root "outside.flac"))
|
(define outside (build-path root "outside.flac"))
|
||||||
(define store-file (build-path root "data" "playlists.keystore"))
|
(define store-file (build-path root "data" "playlists.keystore"))
|
||||||
|
|
||||||
|
(check-false (open-playlist-store #f))
|
||||||
|
(check-equal? (load-user-playlists #f "hans" '()) '())
|
||||||
|
(check-false (load-user-language #f "hans"))
|
||||||
|
|
||||||
(dynamic-wind
|
(dynamic-wind
|
||||||
(lambda ()
|
(λ ()
|
||||||
(make-directory music)
|
(make-directory music)
|
||||||
(make-directory music-two)
|
(make-directory music-two)
|
||||||
(call-with-output-file (build-path music "one.flac") void)
|
(call-with-output-file (build-path music "one.flac") void)
|
||||||
(call-with-output-file (build-path music-two "two.flac") void)
|
(call-with-output-file (build-path music-two "two.flac") void)
|
||||||
(call-with-output-file outside void))
|
(call-with-output-file outside void))
|
||||||
(lambda ()
|
(λ ()
|
||||||
(define libraries (make-music-libraries (list music music-two)))
|
(let* ((libraries (make-music-libraries (list music music-two)))
|
||||||
(define store (open-playlist-store store-file))
|
(store (open-playlist-store store-file))
|
||||||
(define first-id (uuid-string))
|
(first-id (uuid-string))
|
||||||
(define second-id (uuid-string))
|
(second-id (uuid-string))
|
||||||
(define item
|
(item
|
||||||
(track (build-path music "one.flac")
|
(track (build-path music "one.flac")
|
||||||
"One" "Artist" "Album" 60 "audio/flac"))
|
"One" "Artist" "Album" 60 "audio/flac"))
|
||||||
(define item-two
|
(item-two
|
||||||
(track (build-path music-two "two.flac")
|
(track (build-path music-two "two.flac")
|
||||||
"Two" "Artist" "Album" 70 "audio/flac"))
|
"Two" "Artist" "Album" 70 "audio/flac")))
|
||||||
|
(dynamic-wind
|
||||||
|
void
|
||||||
|
(λ ()
|
||||||
(save-user-playlists!
|
(save-user-playlists!
|
||||||
store
|
store
|
||||||
"hans"
|
"hans"
|
||||||
@@ -200,18 +305,19 @@
|
|||||||
store
|
store
|
||||||
"local"
|
"local"
|
||||||
(list (persisted-tab (uuid-string) "Local" '())))
|
(list (persisted-tab (uuid-string) "Local" '())))
|
||||||
|
(let ((loaded (load-user-playlists store "hans" libraries)))
|
||||||
(define loaded (load-user-playlists store "hans" libraries))
|
(check-equal? (ks-get store "playlists-for-hans")
|
||||||
(define ks (playlist-store-keystore store))
|
(list first-id second-id))
|
||||||
(check-equal? (ks-get ks "playlists-for-hans")
|
(check-equal? (hash-ref (ks-get store first-id) 'name) "First")
|
||||||
|
(check-equal? (map persisted-tab-id loaded)
|
||||||
(list first-id second-id))
|
(list first-id second-id))
|
||||||
(check-equal? (hash-ref (ks-get ks first-id) 'name) "First")
|
|
||||||
(check-equal? (map persisted-tab-id loaded) (list first-id second-id))
|
|
||||||
(check-equal? (persisted-tab-name (car loaded)) "First")
|
(check-equal? (persisted-tab-name (car loaded)) "First")
|
||||||
(check-equal? (map track-title (persisted-tab-tracks (car loaded)))
|
(check-equal?
|
||||||
|
(map track-title (persisted-tab-tracks (car loaded)))
|
||||||
'("One" "Two"))
|
'("One" "Two"))
|
||||||
(check-equal?
|
(check-equal?
|
||||||
(map persisted-tab-name (load-user-playlists store "local" libraries))
|
(map persisted-tab-name
|
||||||
|
(load-user-playlists store "local" libraries))
|
||||||
'("Local"))
|
'("Local"))
|
||||||
(check-false (load-user-language store "hans"))
|
(check-false (load-user-language store "hans"))
|
||||||
(save-user-language! store "hans" "fr")
|
(save-user-language! store "hans" "fr")
|
||||||
@@ -221,23 +327,25 @@
|
|||||||
(check-exn exn:fail:contract?
|
(check-exn exn:fail:contract?
|
||||||
(λ () (save-user-language! store "hans" "da")))
|
(λ () (save-user-language! store "hans" "da")))
|
||||||
|
|
||||||
;; Rewriting the user's GUID index durably removes the omitted playlist.
|
;; Rewriting the user's GUID index durably removes the omitted
|
||||||
|
;; playlist instead of leaving it orphaned.
|
||||||
(save-user-playlists!
|
(save-user-playlists!
|
||||||
store "hans"
|
store "hans"
|
||||||
(list (persisted-tab first-id "First" (list item item-two))))
|
(list (persisted-tab first-id "First" (list item item-two))))
|
||||||
(check-equal?
|
(check-equal?
|
||||||
(map persisted-tab-id (load-user-playlists store "hans" libraries))
|
(map persisted-tab-id
|
||||||
|
(load-user-playlists store "hans" libraries))
|
||||||
(list first-id))
|
(list first-id))
|
||||||
(check-false (ks-exists? ks second-id))
|
(check-false (ks-exists? store second-id))
|
||||||
;; An omitted GUID is deleted rather than becoming orphaned.
|
|
||||||
(check-equal?
|
(check-equal?
|
||||||
(map persisted-tab-name (load-user-playlists store "local" libraries))
|
(map persisted-tab-name
|
||||||
|
(load-user-playlists store "local" libraries))
|
||||||
'("Local"))
|
'("Local"))
|
||||||
|
|
||||||
;; A playlist entry may not restore tracks outside configured libraries.
|
;; A playlist may not restore tracks outside configured libraries.
|
||||||
(define unsafe-id (uuid-string))
|
(let ((unsafe-id (uuid-string)))
|
||||||
(ks-set!
|
(ks-set!
|
||||||
(playlist-store-keystore store)
|
store
|
||||||
unsafe-id
|
unsafe-id
|
||||||
(hasheq
|
(hasheq
|
||||||
'name "Unsafe"
|
'name "Unsafe"
|
||||||
@@ -245,12 +353,12 @@
|
|||||||
(list (hasheq 'file (path->string outside)
|
(list (hasheq 'file (path->string outside)
|
||||||
'title "Outside" 'artist "" 'album ""
|
'title "Outside" 'artist "" 'album ""
|
||||||
'duration #f 'mime-type "audio/flac"))))
|
'duration #f 'mime-type "audio/flac"))))
|
||||||
(ks-set! (playlist-store-keystore store)
|
(ks-set! store
|
||||||
(user-playlists-key "unsafe")
|
(user-playlists-key "unsafe")
|
||||||
(list unsafe-id))
|
(list unsafe-id))
|
||||||
(check-equal?
|
(check-equal?
|
||||||
(persisted-tab-tracks
|
(persisted-tab-tracks
|
||||||
(car (load-user-playlists store "unsafe" libraries)))
|
(car (load-user-playlists store "unsafe" libraries)))
|
||||||
'())
|
'()))))
|
||||||
(close-playlist-store! store))
|
(λ () (close-playlist-store! store)))))
|
||||||
(lambda () (delete-directory/files root))))
|
(λ () (delete-directory/files root))))
|
||||||
|
|||||||
+250
-85
@@ -21,43 +21,46 @@
|
|||||||
(define-runtime-path public-directory "../public")
|
(define-runtime-path public-directory "../public")
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; HTTP handlers
|
;; Supporting functions
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(define current-player #f)
|
;;; Creates a JSON response that browsers and agents may not cache.
|
||||||
(define current-auth #f)
|
|
||||||
|
|
||||||
(define (json-response value #:code [code 200] #:headers [headers '()])
|
(define (json-response value #:code [code 200] #:headers [headers '()])
|
||||||
(response/jsexpr
|
(response/jsexpr
|
||||||
value
|
value
|
||||||
#:code code
|
#:code code
|
||||||
#:headers (cons (header #"Cache-Control" #"no-store") headers)))
|
#:headers (cons (header #"Cache-Control" #"no-store") headers)))
|
||||||
|
|
||||||
|
;;; Converts an ordinary request exception to a bad-request response.
|
||||||
(define (error-response exception)
|
(define (error-response exception)
|
||||||
(json-response
|
(json-response
|
||||||
(hasheq 'error (exn-message exception))
|
(hasheq 'error (exn-message exception))
|
||||||
#:code 400))
|
#:code 400))
|
||||||
|
|
||||||
|
;;; Converts a denied playback agent exception to a forbidden response.
|
||||||
(define (agent-error-response exception)
|
(define (agent-error-response exception)
|
||||||
(json-response
|
(json-response
|
||||||
(hasheq 'error (exn-message exception)
|
(hasheq 'error (exn-message exception)
|
||||||
'code "agent-not-authorized")
|
'code "agent-not-authorized")
|
||||||
#:code 403))
|
#:code 403))
|
||||||
|
|
||||||
|
;;; Reads a JSON request body or returns an empty object for an empty body.
|
||||||
(define (request-jsexpr request)
|
(define (request-jsexpr request)
|
||||||
(let ((body (request-post-data/raw request)))
|
(let ((body (request-post-data/raw request)))
|
||||||
(if (and body (positive? (bytes-length body)))
|
(if (and body (positive? (bytes-length body)))
|
||||||
(bytes->jsexpr body)
|
(bytes->jsexpr body)
|
||||||
(hasheq))))
|
(hasheq))))
|
||||||
|
|
||||||
(define (auth-status-handler request)
|
;;; Reports the authentication state belonging to the current request.
|
||||||
(let ((user (auth-request-user current-auth request)))
|
(define (auth-status-handler auth request)
|
||||||
|
(let ((user (auth-request-user auth request)))
|
||||||
(json-response
|
(json-response
|
||||||
(hasheq 'enabled (auth-enabled? current-auth)
|
(hasheq 'enabled (auth-enabled? auth)
|
||||||
'authenticated (and user #t)
|
'authenticated (and user #t)
|
||||||
'username (or user 'null)))))
|
'username (or user 'null)))))
|
||||||
|
|
||||||
(define (auth-login-handler request)
|
;;; Authenticates a browser and returns its new session cookie.
|
||||||
|
(define (auth-login-handler auth request)
|
||||||
(with-handlers ((exn:fail? error-response))
|
(with-handlers ((exn:fail? error-response))
|
||||||
(let* ((data (request-jsexpr request))
|
(let* ((data (request-jsexpr request))
|
||||||
(username (hash-ref data 'username #f))
|
(username (hash-ref data 'username #f))
|
||||||
@@ -66,16 +69,16 @@
|
|||||||
(raise-arguments-error
|
(raise-arguments-error
|
||||||
'login
|
'login
|
||||||
"username and password must be strings"))
|
"username and password must be strings"))
|
||||||
(let ((result (auth-login! current-auth request username password)))
|
(let ((result (auth-login! auth request username password)))
|
||||||
(cond
|
(cond
|
||||||
((eq? result 'rate-limited)
|
((eq? result 'rate-limited)
|
||||||
(json-response
|
(json-response
|
||||||
(hasheq 'error "Te veel mislukte aanmeldpogingen; probeer het over enkele minuten opnieuw"
|
(hasheq 'error "login-rate-limited"
|
||||||
'code "login-rate-limited")
|
'code "login-rate-limited")
|
||||||
#:code 429))
|
#:code 429))
|
||||||
((not result)
|
((not result)
|
||||||
(json-response
|
(json-response
|
||||||
(hasheq 'error "Ongeldige gebruikersnaam of wachtwoord"
|
(hasheq 'error "invalid-credentials"
|
||||||
'code "invalid-credentials")
|
'code "invalid-credentials")
|
||||||
#:code 401))
|
#:code 401))
|
||||||
(else
|
(else
|
||||||
@@ -84,79 +87,97 @@
|
|||||||
'username (string-downcase (string-trim username)))
|
'username (string-downcase (string-trim username)))
|
||||||
#:headers
|
#:headers
|
||||||
(list (header #"Set-Cookie"
|
(list (header #"Set-Cookie"
|
||||||
(auth-session-cookie current-auth result))))))))))
|
(auth-session-cookie auth result))))))))))
|
||||||
|
|
||||||
(define (auth-logout-handler request)
|
;;; Invalidates the browser session and expires its cookie.
|
||||||
(auth-logout! current-auth request)
|
(define (auth-logout-handler auth request)
|
||||||
|
(auth-logout! auth request)
|
||||||
(json-response
|
(json-response
|
||||||
(hasheq 'authenticated #f)
|
(hasheq 'authenticated #f)
|
||||||
#:headers
|
#:headers
|
||||||
(list (header #"Set-Cookie" (auth-expired-cookie)))))
|
(list (header #"Set-Cookie" (auth-expired-cookie)))))
|
||||||
|
|
||||||
(define (request-username request)
|
;;; Resolves the authenticated username or the anonymous playlist owner.
|
||||||
(or (auth-request-user current-auth request) "anonymous"))
|
(define (request-username auth request)
|
||||||
|
(or (auth-request-user auth request) "anonymous"))
|
||||||
|
|
||||||
(define (state-handler request)
|
;;; Read the opaque version of the playlist already held by this browser.
|
||||||
|
(define (request-playlist-version request)
|
||||||
|
(let ((entry (assq 'playlistVersion (url-query (request-uri request)))))
|
||||||
|
(and entry (cdr entry))))
|
||||||
|
|
||||||
|
;;; Returns user state, including tracks only when this browser needs them.
|
||||||
|
(define (state-handler player auth request)
|
||||||
(json-response
|
(json-response
|
||||||
(player-state->jsexpr
|
(player-state->jsexpr
|
||||||
current-player
|
player
|
||||||
#:username (request-username request))))
|
#:username (request-username auth request)
|
||||||
|
#:playlist-version (request-playlist-version request))))
|
||||||
|
|
||||||
(define (discover-handler request)
|
;;; Starts renderer discovery and returns the updated player state.
|
||||||
(player-discover! current-player)
|
(define (discover-handler player auth request)
|
||||||
|
(player-discover! player)
|
||||||
(json-response
|
(json-response
|
||||||
(player-state->jsexpr
|
(player-state->jsexpr
|
||||||
current-player
|
player
|
||||||
#:username (request-username request))))
|
#:username (request-username auth request)
|
||||||
|
#:playlist-version (request-playlist-version request))))
|
||||||
|
|
||||||
(define (command-handler request command)
|
;;; Applies one player command for the requesting user.
|
||||||
|
(define (command-handler player auth request command)
|
||||||
(with-handlers
|
(with-handlers
|
||||||
((exn:fail? error-response))
|
((exn:fail? error-response))
|
||||||
(json-response
|
(json-response
|
||||||
(player-command!
|
(player-command!
|
||||||
current-player
|
player
|
||||||
command
|
command
|
||||||
(request-jsexpr request)
|
(request-jsexpr request)
|
||||||
#:username (request-username request)))))
|
#:username (request-username auth request)
|
||||||
|
#:playlist-version (request-playlist-version request)))))
|
||||||
|
|
||||||
(define (preferences-handler request)
|
;;; Returns the persisted interface preferences for the requesting user.
|
||||||
|
(define (preferences-handler player auth request)
|
||||||
(json-response
|
(json-response
|
||||||
(hasheq
|
(hasheq
|
||||||
'language
|
'language
|
||||||
(or (player-user-language
|
(or (player-user-language
|
||||||
current-player
|
player
|
||||||
#:username (request-username request))
|
#:username (request-username auth request))
|
||||||
'null))))
|
'null))))
|
||||||
|
|
||||||
(define (preferences-update-handler request)
|
;;; Validates and persists the requesting user's interface language.
|
||||||
|
(define (preferences-update-handler player auth request)
|
||||||
(with-handlers ((exn:fail? error-response))
|
(with-handlers ((exn:fail? error-response))
|
||||||
(define language (hash-ref (request-jsexpr request) 'language #f))
|
(let ((language (hash-ref (request-jsexpr request) 'language #f)))
|
||||||
(player-user-language!
|
(player-user-language!
|
||||||
current-player
|
player
|
||||||
language
|
language
|
||||||
#:username (request-username request))
|
#:username (request-username auth request))
|
||||||
(json-response (hasheq 'language language))))
|
(json-response (hasheq 'language language)))))
|
||||||
|
|
||||||
(define (agent-register-handler request)
|
;;; Registers or refreshes one allowed polling playback agent.
|
||||||
|
(define (agent-register-handler player request)
|
||||||
(with-handlers
|
(with-handlers
|
||||||
((exn:fail:agent-denied? agent-error-response)
|
((exn:fail:agent-denied? agent-error-response)
|
||||||
(exn:fail? error-response))
|
(exn:fail? error-response))
|
||||||
(json-response
|
(json-response
|
||||||
(player-agent-register!
|
(player-agent-register!
|
||||||
current-player
|
player
|
||||||
(request-jsexpr request)))))
|
(request-jsexpr request)))))
|
||||||
|
|
||||||
(define (agent-poll-handler request)
|
;;; Processes one state report and command poll from a playback agent.
|
||||||
|
(define (agent-poll-handler player request)
|
||||||
(with-handlers
|
(with-handlers
|
||||||
((exn:fail:agent-denied? agent-error-response)
|
((exn:fail:agent-denied? agent-error-response)
|
||||||
(exn:fail? error-response))
|
(exn:fail? error-response))
|
||||||
(json-response
|
(json-response
|
||||||
(player-agent-poll!
|
(player-agent-poll!
|
||||||
current-player
|
player
|
||||||
(request-jsexpr request)))))
|
(request-jsexpr request)))))
|
||||||
|
|
||||||
(define (agent-media-handler _request app-id token)
|
;;; Streams the media file identified by an agent's opaque token.
|
||||||
(let ((file (player-agent-media current-player app-id token)))
|
(define (agent-media-handler player _request app-id token)
|
||||||
|
(let ((file (player-agent-media player app-id token)))
|
||||||
(if (and file (file-exists? file))
|
(if (and file (file-exists? file))
|
||||||
(response/output
|
(response/output
|
||||||
(λ (output)
|
(λ (output)
|
||||||
@@ -179,50 +200,34 @@
|
|||||||
(hasheq 'error "media token is invalid or expired")
|
(hasheq 'error "media token is invalid or expired")
|
||||||
#:code 404))))
|
#:code 404))))
|
||||||
|
|
||||||
(define (artwork-handler request artwork-id)
|
;;; Streams cached artwork belonging to a track visible to the user.
|
||||||
|
(define (artwork-handler player auth request artwork-id)
|
||||||
(let ((value (player-track-artwork
|
(let ((value (player-track-artwork
|
||||||
current-player
|
player
|
||||||
artwork-id
|
artwork-id
|
||||||
#:username (request-username request))))
|
#:username (request-username auth request))))
|
||||||
(if value
|
(if value
|
||||||
|
(let ((data (artwork-data value)))
|
||||||
(response/output
|
(response/output
|
||||||
(λ (output)
|
(λ (output)
|
||||||
(write-bytes (artwork-data value) output))
|
(write-bytes data output))
|
||||||
#:mime-type
|
#:mime-type
|
||||||
(string->bytes/utf-8 (artwork-mime-type value))
|
(string->bytes/utf-8 (artwork-mime-type value))
|
||||||
#:headers
|
#:headers
|
||||||
(list
|
(list
|
||||||
(header #"Content-Length"
|
(header #"Content-Length"
|
||||||
(string->bytes/utf-8
|
(string->bytes/utf-8
|
||||||
(number->string
|
(number->string (bytes-length data))))
|
||||||
(bytes-length (artwork-data value)))))
|
(header #"Cache-Control" #"private, max-age=3600"))))
|
||||||
(header #"Cache-Control" #"private, max-age=3600")))
|
|
||||||
(json-response
|
(json-response
|
||||||
(hasheq 'error "track artwork is unavailable")
|
(hasheq 'error "track artwork is unavailable")
|
||||||
#:code 404))))
|
#:code 404))))
|
||||||
|
|
||||||
(define-values (api-dispatch _url)
|
;;; Returns the path and query string used to classify an API request.
|
||||||
(dispatch-rules
|
|
||||||
[("api" "auth" "status") #:method "get" auth-status-handler]
|
|
||||||
[("api" "auth" "login") #:method "post" auth-login-handler]
|
|
||||||
[("api" "auth" "logout") #:method "post" auth-logout-handler]
|
|
||||||
[("api" "state") #:method "get" state-handler]
|
|
||||||
[("api" "discover") #:method "post" discover-handler]
|
|
||||||
[("api" "preferences") #:method "get" preferences-handler]
|
|
||||||
[("api" "preferences") #:method "post" preferences-update-handler]
|
|
||||||
[("api" "agent" "register") #:method "post" agent-register-handler]
|
|
||||||
[("api" "agent" "poll") #:method "post" agent-poll-handler]
|
|
||||||
[("api" "agent" "media" (string-arg) (string-arg))
|
|
||||||
#:method "get"
|
|
||||||
agent-media-handler]
|
|
||||||
[("api" "artwork" (string-arg)) #:method "get" artwork-handler]
|
|
||||||
[("api" "command" (string-arg))
|
|
||||||
#:method "post"
|
|
||||||
command-handler]))
|
|
||||||
|
|
||||||
(define (request-path request)
|
(define (request-path request)
|
||||||
(url->string (request-uri request)))
|
(url->string (request-uri request)))
|
||||||
|
|
||||||
|
;;; Checks whether the request declares a JSON entity body.
|
||||||
(define (json-request? request)
|
(define (json-request? request)
|
||||||
(let ((content-type
|
(let ((content-type
|
||||||
(headers-assq* #"Content-Type" (request-headers/raw request))))
|
(headers-assq* #"Content-Type" (request-headers/raw request))))
|
||||||
@@ -230,6 +235,7 @@
|
|||||||
(regexp-match? #px#"(?i:^application/json(?:;|$))"
|
(regexp-match? #px#"(?i:^application/json(?:;|$))"
|
||||||
(header-value content-type)))))
|
(header-value content-type)))))
|
||||||
|
|
||||||
|
;;; Recognizes endpoints that use authentication rules separate from browsers.
|
||||||
(define (public-api-request? request)
|
(define (public-api-request? request)
|
||||||
(regexp-match? #px"^/api/(?:auth|agent)(?:/|$)"
|
(regexp-match? #px"^/api/(?:auth|agent)(?:/|$)"
|
||||||
(request-path request)))
|
(request-path request)))
|
||||||
@@ -251,40 +257,95 @@
|
|||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : Dispatch an API request and renew an eligible browser cookie.
|
; goal : Dispatch an API request and renew an eligible browser cookie.
|
||||||
; pre : Current-player and current-auth are initialized and request targets
|
; pre : Auth is an auth-manager, api-dispatch handles the configured routes,
|
||||||
; an API route.
|
; and request targets an API route.
|
||||||
; post : The selected handler has run. A due browser-session renewal is
|
; post : The selected handler has run. A due browser-session renewal is
|
||||||
; recorded and returned as Set-Cookie; agent requests never renew it.
|
; recorded and returned as Set-Cookie; agent requests never renew it.
|
||||||
; result : The HTTP response produced by the API handler, optionally extended
|
; result : The HTTP response produced by the API handler, optionally extended
|
||||||
; with the renewed session cookie.
|
; with the renewed session cookie.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (dispatch-api request)
|
(define (dispatch-api auth api-dispatch request)
|
||||||
(define value (api-dispatch request))
|
(let* ((value (api-dispatch request))
|
||||||
(define renewed-cookie
|
(agent-request?
|
||||||
(and (not (regexp-match? #px"^/api/agent(?:/|$)"
|
(regexp-match? #px"^/api/agent(?:/|$)" (request-path request)))
|
||||||
(request-path request)))
|
(renewed-cookie
|
||||||
(auth-renewal-cookie current-auth request)))
|
(if agent-request?
|
||||||
|
#f
|
||||||
|
(auth-renewal-cookie auth request))))
|
||||||
(if renewed-cookie
|
(if renewed-cookie
|
||||||
(response-add-header value (header #"Set-Cookie" renewed-cookie))
|
(response-add-header value (header #"Set-Cookie" renewed-cookie))
|
||||||
value))
|
value)))
|
||||||
|
|
||||||
(define (dispatch request)
|
;;; Enforces JSON and authentication requirements before route dispatch.
|
||||||
|
(define (dispatch-request auth api-dispatch request)
|
||||||
(cond
|
(cond
|
||||||
((and (bytes=? (request-method request) #"POST")
|
((and (bytes=? (request-method request) #"POST")
|
||||||
(not (json-request? request)))
|
(not (json-request? request)))
|
||||||
(json-response
|
(json-response
|
||||||
(hasheq 'error "Content-Type application/json is vereist"
|
(hasheq 'error "json-required"
|
||||||
'code "json-required")
|
'code "json-required")
|
||||||
#:code 415))
|
#:code 415))
|
||||||
((or (public-api-request? request)
|
((or (public-api-request? request)
|
||||||
(auth-request-user current-auth request))
|
(auth-request-user auth request))
|
||||||
(dispatch-api request))
|
(dispatch-api auth api-dispatch request))
|
||||||
(else
|
(else
|
||||||
(json-response
|
(json-response
|
||||||
(hasheq 'error "Aanmelden is vereist"
|
(hasheq 'error "authentication-required"
|
||||||
'code "authentication-required")
|
'code "authentication-required")
|
||||||
#:code 401))))
|
#:code 401))))
|
||||||
|
|
||||||
|
;;; Binds the player and authentication manager to every declared API route.
|
||||||
|
(define (make-api-dispatch player auth)
|
||||||
|
(let-values
|
||||||
|
(((api-dispatch _url)
|
||||||
|
(dispatch-rules
|
||||||
|
[("api" "auth" "status")
|
||||||
|
#:method "get"
|
||||||
|
(λ (request) (auth-status-handler auth request))]
|
||||||
|
[("api" "auth" "login")
|
||||||
|
#:method "post"
|
||||||
|
(λ (request) (auth-login-handler auth request))]
|
||||||
|
[("api" "auth" "logout")
|
||||||
|
#:method "post"
|
||||||
|
(λ (request) (auth-logout-handler auth request))]
|
||||||
|
[("api" "state")
|
||||||
|
#:method "get"
|
||||||
|
(λ (request) (state-handler player auth request))]
|
||||||
|
[("api" "discover")
|
||||||
|
#:method "post"
|
||||||
|
(λ (request) (discover-handler player auth request))]
|
||||||
|
[("api" "preferences")
|
||||||
|
#:method "get"
|
||||||
|
(λ (request) (preferences-handler player auth request))]
|
||||||
|
[("api" "preferences")
|
||||||
|
#:method "post"
|
||||||
|
(λ (request) (preferences-update-handler player auth request))]
|
||||||
|
[("api" "agent" "register")
|
||||||
|
#:method "post"
|
||||||
|
(λ (request) (agent-register-handler player request))]
|
||||||
|
[("api" "agent" "poll")
|
||||||
|
#:method "post"
|
||||||
|
(λ (request) (agent-poll-handler player request))]
|
||||||
|
[("api" "agent" "media" (string-arg) (string-arg))
|
||||||
|
#:method "get"
|
||||||
|
(λ (request app-id token)
|
||||||
|
(agent-media-handler player request app-id token))]
|
||||||
|
[("api" "artwork" (string-arg))
|
||||||
|
#:method "get"
|
||||||
|
(λ (request artwork-id)
|
||||||
|
(artwork-handler player auth request artwork-id))]
|
||||||
|
[("api" "command" (string-arg))
|
||||||
|
#:method "post"
|
||||||
|
(λ (request command)
|
||||||
|
(command-handler player auth request command))])))
|
||||||
|
api-dispatch))
|
||||||
|
|
||||||
|
;;; Creates the servlet dispatcher whose closure owns one player/auth pair.
|
||||||
|
(define (make-dispatch player auth)
|
||||||
|
(let ((api-dispatch (make-api-dispatch player auth)))
|
||||||
|
(λ (request)
|
||||||
|
(dispatch-request auth api-dispatch request))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Provided functions
|
;; Provided functions
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
@@ -294,6 +355,9 @@
|
|||||||
; pre : Value is a player, listen-ip is a string, and port is valid.
|
; pre : Value is a player, listen-ip is a string, and port is valid.
|
||||||
; post : Static files and API routes are served until the server stops.
|
; post : Static files and API routes are served until the server stops.
|
||||||
; result : The result returned by serve/servlet.
|
; result : The result returned by serve/servlet.
|
||||||
|
; internals: make-dispatch binds value and auth-manager into one request
|
||||||
|
; closure. make-api-dispatch connects that context to every route;
|
||||||
|
; serve/servlet then serves the closure and public-directory.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define/contract (serve-player value
|
(define/contract (serve-player value
|
||||||
#:auth-manager
|
#:auth-manager
|
||||||
@@ -301,14 +365,13 @@
|
|||||||
#:listen-ip [listen-ip "127.0.0.1"]
|
#:listen-ip [listen-ip "127.0.0.1"]
|
||||||
#:port [port 8080]
|
#:port [port 8080]
|
||||||
#:launch-browser? [launch-browser? #t])
|
#:launch-browser? [launch-browser? #t])
|
||||||
(->* (any/c)
|
(->* (player?)
|
||||||
(#:auth-manager auth-manager?
|
(#:auth-manager auth-manager?
|
||||||
#:listen-ip string?
|
#:listen-ip string?
|
||||||
#:port exact-positive-integer?
|
#:port exact-positive-integer?
|
||||||
#:launch-browser? boolean?)
|
#:launch-browser? boolean?)
|
||||||
any)
|
any)
|
||||||
(set! current-player value)
|
(let ((dispatch (make-dispatch value auth-manager)))
|
||||||
(set! current-auth auth-manager)
|
|
||||||
(serve/servlet
|
(serve/servlet
|
||||||
dispatch
|
dispatch
|
||||||
#:listen-ip listen-ip
|
#:listen-ip listen-ip
|
||||||
@@ -318,4 +381,106 @@
|
|||||||
#:quit? #f
|
#:quit? #f
|
||||||
#:banner? #t
|
#:banner? #t
|
||||||
#:servlet-regexp #rx"^/api(?:/|$)"
|
#:servlet-regexp #rx"^/api(?:/|$)"
|
||||||
#:extra-files-paths (list public-directory)))
|
#:extra-files-paths (list public-directory))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Tests for module server.rkt
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(module+ test
|
||||||
|
(require racket/promise
|
||||||
|
rackunit)
|
||||||
|
|
||||||
|
;;; Creates an isolated request value for handler and dispatcher tests.
|
||||||
|
(define (test-request method path
|
||||||
|
#:headers [headers '()]
|
||||||
|
#:body [body #f])
|
||||||
|
(request method
|
||||||
|
(string->url path)
|
||||||
|
headers
|
||||||
|
(delay '())
|
||||||
|
body
|
||||||
|
"127.0.0.1"
|
||||||
|
8080
|
||||||
|
"127.0.0.1"))
|
||||||
|
|
||||||
|
;;; Reads the JSON entity produced by a response.
|
||||||
|
(define (response-jsexpr value)
|
||||||
|
(let ((output (open-output-bytes)))
|
||||||
|
((response-output value) output)
|
||||||
|
(bytes->jsexpr (get-output-bytes output))))
|
||||||
|
|
||||||
|
(check-equal?
|
||||||
|
(request-jsexpr (test-request #"POST" "/api/preferences"))
|
||||||
|
(hasheq))
|
||||||
|
(test-case "HTTP state and commands accept the browser's playlist version"
|
||||||
|
(let* ((value (make-player '() #:playlist-keystore #f #:local-output? #f))
|
||||||
|
(auth (make-auth-manager '()))
|
||||||
|
(dispatch (make-dispatch value auth)))
|
||||||
|
(dynamic-wind
|
||||||
|
void
|
||||||
|
(λ ()
|
||||||
|
(let* ((full (response-jsexpr (dispatch (test-request #"GET" "/api/state"))))
|
||||||
|
(version (hash-ref full 'playlistVersion))
|
||||||
|
(compact
|
||||||
|
(response-jsexpr
|
||||||
|
(dispatch (test-request #"GET" (string-append "/api/state?playlistVersion=" version))))))
|
||||||
|
(check-equal? (hash-ref full 'tracks) '())
|
||||||
|
(check-eq? (hash-ref compact 'tracks) 'null)
|
||||||
|
(check-equal? (hash-ref compact 'playlistVersion) version)
|
||||||
|
(let ((renamed
|
||||||
|
(response-jsexpr
|
||||||
|
(dispatch
|
||||||
|
(test-request #"POST"
|
||||||
|
(string-append "/api/command/tab-rename?playlistVersion=" version)
|
||||||
|
#:headers (list (header #"Content-Type" #"application/json"))
|
||||||
|
#:body #"{\"index\":0,\"name\":\"Music\"}")))))
|
||||||
|
(check-eq? (hash-ref renamed 'tracks) 'null)
|
||||||
|
(check-equal? (hash-ref (car (hash-ref renamed 'tabs)) 'name) "Music"))))
|
||||||
|
(λ () (player-close! value)))))
|
||||||
|
(check-equal?
|
||||||
|
(request-jsexpr
|
||||||
|
(test-request #"POST"
|
||||||
|
"/api/preferences"
|
||||||
|
#:body #"{\"language\":\"nl\"}"))
|
||||||
|
(hasheq 'language "nl"))
|
||||||
|
(check-true
|
||||||
|
(json-request?
|
||||||
|
(test-request
|
||||||
|
#"POST"
|
||||||
|
"/api/preferences"
|
||||||
|
#:headers (list (header #"Content-Type"
|
||||||
|
#"application/json; charset=utf-8")))))
|
||||||
|
(check-false (json-request? (test-request #"POST" "/api/preferences")))
|
||||||
|
(check-true (public-api-request? (test-request #"GET" "/api/auth/status")))
|
||||||
|
(check-true (public-api-request? (test-request #"POST" "/api/agent/poll")))
|
||||||
|
(check-false (public-api-request? (test-request #"GET" "/api/state")))
|
||||||
|
|
||||||
|
(let* ((auth (make-auth-manager (list (cons "hans" "$argon2id$unused"))))
|
||||||
|
(request (test-request #"GET" "/api/state"))
|
||||||
|
(response
|
||||||
|
(dispatch-request auth
|
||||||
|
(λ (_) (error 'test "unexpected dispatch"))
|
||||||
|
request)))
|
||||||
|
(check-equal? (response-code response) 401)
|
||||||
|
(check-equal? (hash-ref (response-jsexpr response) 'error)
|
||||||
|
"authentication-required"))
|
||||||
|
|
||||||
|
(let* ((auth (make-auth-manager '()))
|
||||||
|
(request (test-request #"POST" "/api/state"))
|
||||||
|
(response
|
||||||
|
(dispatch-request auth
|
||||||
|
(λ (_) (error 'test "unexpected dispatch"))
|
||||||
|
request)))
|
||||||
|
(check-equal? (response-code response) 415)
|
||||||
|
(check-equal? (hash-ref (response-jsexpr response) 'error)
|
||||||
|
"json-required"))
|
||||||
|
|
||||||
|
(let* ((auth (make-auth-manager '()))
|
||||||
|
(dispatch (make-dispatch 'unused-player auth))
|
||||||
|
(response (dispatch (test-request #"GET" "/api/auth/status")))
|
||||||
|
(data (response-jsexpr response)))
|
||||||
|
(check-equal? (response-code response) 200)
|
||||||
|
(check-false (hash-ref data 'enabled))
|
||||||
|
(check-true (hash-ref data 'authenticated))
|
||||||
|
(check-equal? (hash-ref data 'username) "anonymous")))
|
||||||
|
|||||||
+252
-132
@@ -2,7 +2,8 @@
|
|||||||
|
|
||||||
(require crypto
|
(require crypto
|
||||||
crypto/argon2
|
crypto/argon2
|
||||||
net/private/ip
|
net/ip
|
||||||
|
racket/contract
|
||||||
racket/list
|
racket/list
|
||||||
racket/random
|
racket/random
|
||||||
racket/string
|
racket/string
|
||||||
@@ -21,10 +22,16 @@
|
|||||||
auth-renewal-cookie
|
auth-renewal-cookie
|
||||||
auth-expired-cookie)
|
auth-expired-cookie)
|
||||||
|
|
||||||
(struct ip-network (address prefix) #:transparent)
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Internal data
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;;; Holds one authenticated browser session and its two activity timestamps.
|
||||||
(struct session
|
(struct session
|
||||||
(username [last-seen #:mutable] [last-cookie-renewal #:mutable])
|
(username [last-seen #:mutable] [last-cookie-renewal #:mutable])
|
||||||
#:transparent)
|
#:transparent)
|
||||||
|
|
||||||
|
;;; Holds the failed-login count and start time for one client address.
|
||||||
(struct failures ([attempts #:mutable] [started #:mutable]) #:transparent)
|
(struct failures ([attempts #:mutable] [started #:mutable]) #:transparent)
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
@@ -32,6 +39,8 @@
|
|||||||
; pre : Constructor fields contain normalized and parsed internal values.
|
; pre : Constructor fields contain normalized and parsed internal values.
|
||||||
; post : Creating or recognizing a value does not change external state.
|
; post : Creating or recognizing a value does not change external state.
|
||||||
; result : auth-manager? recognizes values used by the authentication API.
|
; result : auth-manager? recognizes values used by the authentication API.
|
||||||
|
; internals: users and trusted-proxies are immutable configuration references;
|
||||||
|
; sessions and failed hold mutable login state protected by lock.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(struct auth-manager
|
(struct auth-manager
|
||||||
(users trusted-proxies session-seconds sessions failed lock)
|
(users trusted-proxies session-seconds sessions failed lock)
|
||||||
@@ -52,13 +61,23 @@
|
|||||||
(define failure-window-seconds 300)
|
(define failure-window-seconds 300)
|
||||||
(define maximum-failures 5)
|
(define maximum-failures 5)
|
||||||
|
|
||||||
|
(define ipv4-mapped-prefix
|
||||||
|
#"\0\0\0\0\0\0\0\0\0\0\377\377")
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Provided password functions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : Create an Argon2id password hash for configuration storage.
|
; goal : Create an Argon2id password hash for configuration storage.
|
||||||
; pre : Password is a string containing at least twelve characters.
|
; pre : Password is a string containing at least twelve characters.
|
||||||
; post : No module state is changed.
|
; post : No module state is changed.
|
||||||
; result : A salted Argon2id hash encoded as a string.
|
; result : A salted Argon2id hash encoded as a string.
|
||||||
|
; internals: pwhash uses password-kdf with password-parameters to generate the
|
||||||
|
; encoded hash, including its random salt and Argon2 parameters.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (make-password-hash password)
|
(define/contract (make-password-hash password)
|
||||||
|
(-> string? string?)
|
||||||
(unless (and (string? password)
|
(unless (and (string? password)
|
||||||
(>= (string-length password) 12))
|
(>= (string-length password) 12))
|
||||||
(raise-argument-error
|
(raise-argument-error
|
||||||
@@ -74,151 +93,177 @@
|
|||||||
; pre : Password and encoded are arbitrary values.
|
; pre : Password and encoded are arbitrary values.
|
||||||
; post : No module state is changed.
|
; post : No module state is changed.
|
||||||
; result : #t only when both values are strings and the password matches.
|
; result : #t only when both values are strings and the password matches.
|
||||||
|
; internals: pwhash-verify checks the encoded Argon2id value. Malformed hashes
|
||||||
|
; are treated as a failed match rather than escaping as exceptions.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (password-hash-valid? password encoded)
|
(define/contract (password-hash-valid? password encoded)
|
||||||
(and (string? password)
|
(-> any/c any/c boolean?)
|
||||||
(string? encoded)
|
(if (and (string? password) (string? encoded))
|
||||||
(with-handlers ((exn:fail? (lambda (_) #f)))
|
(with-handlers ((exn:fail? (λ (_) #f)))
|
||||||
(pwhash-verify password-kdf
|
(pwhash-verify password-kdf
|
||||||
(string->bytes/utf-8 password)
|
(string->bytes/utf-8 password)
|
||||||
encoded))))
|
encoded))
|
||||||
|
#f))
|
||||||
|
|
||||||
(define (normal-ip-bytes value)
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define raw
|
;; Supporting functions
|
||||||
(ip-address->bytes (make-ip-address value)))
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Normalize IPv4-mapped IPv6 addresses to four bytes.
|
|
||||||
(if (and (= (bytes-length raw) 16)
|
|
||||||
(for/and ((index (in-range 10)))
|
|
||||||
(zero? (bytes-ref raw index)))
|
|
||||||
(= (bytes-ref raw 10) #xff)
|
|
||||||
(= (bytes-ref raw 11) #xff))
|
|
||||||
(subbytes raw 12)
|
|
||||||
raw))
|
|
||||||
|
|
||||||
|
;;; Parses an address and normalizes an IPv4-mapped IPv6 value to IPv4.
|
||||||
|
(define (normal-ip-address value)
|
||||||
|
(let* ((address (make-ip-address value))
|
||||||
|
(raw (ip-address->bytes address))
|
||||||
|
(ipv4-mapped?
|
||||||
|
(and (= (bytes-length raw) 16)
|
||||||
|
(bytes=? (subbytes raw 0 12) ipv4-mapped-prefix))))
|
||||||
|
(if ipv4-mapped?
|
||||||
|
(bytes->ipv4-address (subbytes raw 12))
|
||||||
|
address)))
|
||||||
|
|
||||||
|
;;; Parses one configured IP address or CIDR value as a public net/ip network.
|
||||||
(define (parse-network value)
|
(define (parse-network value)
|
||||||
(define parts (string-split (string-trim value) "/"))
|
(let ((parts (string-split (string-trim value) "/")))
|
||||||
(unless (member (length parts) '(1 2))
|
(unless (member (length parts) '(1 2))
|
||||||
(raise-argument-error 'make-auth-manager "IP address or CIDR network" value))
|
(raise-argument-error
|
||||||
(define address
|
'make-auth-manager
|
||||||
|
"IP address or CIDR network"
|
||||||
|
value))
|
||||||
|
(let* ((address
|
||||||
(with-handlers ((exn:fail?
|
(with-handlers ((exn:fail?
|
||||||
(lambda (_)
|
(λ (_)
|
||||||
(raise-argument-error
|
(raise-argument-error
|
||||||
'make-auth-manager
|
'make-auth-manager
|
||||||
"IP address or CIDR network"
|
"IP address or CIDR network"
|
||||||
value))))
|
value))))
|
||||||
(normal-ip-bytes (car parts))))
|
(normal-ip-address (car parts))))
|
||||||
(define maximum (* 8 (bytes-length address)))
|
(maximum (ip-address-size address))
|
||||||
(define prefix
|
(prefix
|
||||||
(if (= (length parts) 2)
|
(if (= (length parts) 2)
|
||||||
(string->number (cadr parts))
|
(string->number (cadr parts))
|
||||||
maximum))
|
maximum)))
|
||||||
(unless (and (exact-nonnegative-integer? prefix)
|
(unless (and (exact-nonnegative-integer? prefix)
|
||||||
(<= prefix maximum))
|
(<= prefix maximum))
|
||||||
(raise-argument-error 'make-auth-manager "IP address or CIDR network" value))
|
(raise-argument-error
|
||||||
(ip-network address prefix))
|
'make-auth-manager
|
||||||
|
"IP address or CIDR network"
|
||||||
|
value))
|
||||||
|
(make-network address prefix))))
|
||||||
|
|
||||||
|
;;; Checks whether an address belongs to one configured trusted network.
|
||||||
(define (network-contains? network address-string)
|
(define (network-contains? network address-string)
|
||||||
(with-handlers ((exn:fail? (lambda (_) #f)))
|
(with-handlers ((exn:fail? (λ (_) #f)))
|
||||||
(define candidate (normal-ip-bytes address-string))
|
(network-member network (normal-ip-address address-string))))
|
||||||
(define expected (ip-network-address network))
|
|
||||||
(and (= (bytes-length candidate) (bytes-length expected))
|
|
||||||
(let-values (((whole remainder)
|
|
||||||
(quotient/remainder (ip-network-prefix network) 8)))
|
|
||||||
(and (for/and ((index (in-range whole)))
|
|
||||||
(= (bytes-ref candidate index)
|
|
||||||
(bytes-ref expected index)))
|
|
||||||
(or (zero? remainder)
|
|
||||||
(let ((mask
|
|
||||||
(bitwise-and #xff
|
|
||||||
(arithmetic-shift #xff (- remainder 8)))))
|
|
||||||
(= (bitwise-and (bytes-ref candidate whole) mask)
|
|
||||||
(bitwise-and (bytes-ref expected whole) mask)))))))))
|
|
||||||
|
|
||||||
|
;;; Reads one request header as a UTF-8 string when present.
|
||||||
(define (header-string request name)
|
(define (header-string request name)
|
||||||
(let ((value (headers-assq* name (request-headers/raw request))))
|
(let ((value (headers-assq* name (request-headers/raw request))))
|
||||||
(and value
|
(and value
|
||||||
(bytes->string/utf-8 (header-value value)))))
|
(bytes->string/utf-8 (header-value value)))))
|
||||||
|
|
||||||
|
;;; Checks whether an address belongs to any configured trusted proxy network.
|
||||||
(define (trusted-proxy? manager address)
|
(define (trusted-proxy? manager address)
|
||||||
(ormap (lambda (network) (network-contains? network address))
|
(ormap (λ (network) (network-contains? network address))
|
||||||
(auth-manager-trusted-proxies manager)))
|
(auth-manager-trusted-proxies manager)))
|
||||||
|
|
||||||
|
;;; Resolves the effective client address, honoring only a trusted proxy header.
|
||||||
(define (request-address manager request)
|
(define (request-address manager request)
|
||||||
(define peer (request-client-ip request))
|
(let* ((peer (request-client-ip request))
|
||||||
(define forwarded
|
(forwarded
|
||||||
(and (trusted-proxy? manager peer)
|
(and (trusted-proxy? manager peer)
|
||||||
(header-string request #"X-Forwarded-For")))
|
(header-string request #"X-Forwarded-For"))))
|
||||||
(if forwarded
|
(if forwarded
|
||||||
;; A trusted reverse proxy appends the address it observed. Earlier
|
;; A trusted reverse proxy appends the address it observed. Earlier
|
||||||
;; values can have been supplied by the untrusted client.
|
;; values can have been supplied by the untrusted client.
|
||||||
(string-trim (last (string-split forwarded ",")))
|
(string-trim (last (string-split forwarded ",")))
|
||||||
peer))
|
peer)))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;; Extracts the session token from the request cookies when present.
|
||||||
|
(define (request-session-token request)
|
||||||
|
(let ((cookie
|
||||||
|
(findf
|
||||||
|
(λ (value)
|
||||||
|
(string=? (client-cookie-name value) session-cookie-name))
|
||||||
|
(request-cookies request))))
|
||||||
|
(if cookie
|
||||||
|
(client-cookie-value cookie)
|
||||||
|
#f)))
|
||||||
|
|
||||||
|
;;; Removes every browser session whose idle lifetime has elapsed.
|
||||||
|
(define (prune-sessions! manager now)
|
||||||
|
(for-each
|
||||||
|
(λ (token)
|
||||||
|
(let ((value (hash-ref (auth-manager-sessions manager) token)))
|
||||||
|
(when (> (- now (session-last-seen value))
|
||||||
|
(auth-manager-session-seconds manager))
|
||||||
|
(hash-remove! (auth-manager-sessions manager) token))))
|
||||||
|
(hash-keys (auth-manager-sessions manager))))
|
||||||
|
|
||||||
|
;;; Checks and, when necessary, resets the failure window for one address.
|
||||||
|
(define (failure-blocked? manager address now)
|
||||||
|
(let ((value (hash-ref (auth-manager-failed manager) address #f)))
|
||||||
|
(cond
|
||||||
|
((eq? value #f) #f)
|
||||||
|
((> (- now (failures-started value)) failure-window-seconds)
|
||||||
|
(hash-remove! (auth-manager-failed manager) address)
|
||||||
|
#f)
|
||||||
|
(else
|
||||||
|
(>= (failures-attempts value) maximum-failures)))))
|
||||||
|
|
||||||
|
;;; Adds one failed login to the current address window or starts a new window.
|
||||||
|
(define (record-failure! manager address now)
|
||||||
|
(let ((value (hash-ref (auth-manager-failed manager) address #f)))
|
||||||
|
(if (and value
|
||||||
|
(<= (- now (failures-started value)) failure-window-seconds))
|
||||||
|
(set-failures-attempts! value (add1 (failures-attempts value)))
|
||||||
|
(hash-set! (auth-manager-failed manager)
|
||||||
|
address
|
||||||
|
(failures 1 now)))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Provided authentication functions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : Report whether browser authentication is configured.
|
; goal : Report whether browser authentication is configured.
|
||||||
; pre : Manager is an auth-manager.
|
; pre : Manager is an auth-manager.
|
||||||
; post : Manager remains unchanged.
|
; post : Manager remains unchanged.
|
||||||
; result : #t when at least one configured user can log in, otherwise #f.
|
; result : #t when at least one configured user can log in, otherwise #f.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (auth-enabled? manager)
|
(define/contract (auth-enabled? manager)
|
||||||
|
(-> auth-manager? boolean?)
|
||||||
(positive? (hash-count (auth-manager-users manager))))
|
(positive? (hash-count (auth-manager-users manager))))
|
||||||
|
|
||||||
(define (request-session-token request)
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(for/or ((cookie (in-list (request-cookies request))))
|
|
||||||
(and (string=? (client-cookie-name cookie) session-cookie-name)
|
|
||||||
(client-cookie-value cookie))))
|
|
||||||
|
|
||||||
(define (prune-sessions! manager now)
|
|
||||||
(for ((token (in-list (hash-keys (auth-manager-sessions manager)))))
|
|
||||||
(let ((value (hash-ref (auth-manager-sessions manager) token)))
|
|
||||||
(when (> (- now (session-last-seen value))
|
|
||||||
(auth-manager-session-seconds manager))
|
|
||||||
(hash-remove! (auth-manager-sessions manager) token)))))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
; goal : Resolve the browser user represented by a request cookie.
|
; goal : Resolve the browser user represented by a request cookie.
|
||||||
; pre : Manager is an auth-manager and request is an HTTP request.
|
; pre : Manager is an auth-manager and request is an HTTP request.
|
||||||
; post : Expired sessions are removed and a valid session's last-seen time
|
; post : Expired sessions are removed and a valid session's last-seen time
|
||||||
; is updated.
|
; is updated.
|
||||||
; result : "anonymous" when authentication is disabled, the normalized
|
; result : "anonymous" when authentication is disabled, the normalized
|
||||||
; username for a valid session, or #f when login is required.
|
; username for a valid session, or #f when login is required.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
; internals: request-session-token finds the cookie. The manager lock protects
|
||||||
(define (auth-request-user manager request)
|
; prune-sessions! and the session lookup; a valid lookup updates its
|
||||||
(cond
|
; idle timestamp before returning the stored username.
|
||||||
((not (auth-enabled? manager)) "anonymous")
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(else
|
(define/contract (auth-request-user manager request)
|
||||||
|
(-> auth-manager? request? (or/c #f string?))
|
||||||
|
(if (not (auth-enabled? manager))
|
||||||
|
"anonymous"
|
||||||
(let ((token (request-session-token request))
|
(let ((token (request-session-token request))
|
||||||
(now (current-seconds)))
|
(now (current-seconds)))
|
||||||
(and token
|
(if (eq? token #f)
|
||||||
|
#f
|
||||||
(call-with-semaphore
|
(call-with-semaphore
|
||||||
(auth-manager-lock manager)
|
(auth-manager-lock manager)
|
||||||
(lambda ()
|
(λ ()
|
||||||
(prune-sessions! manager now)
|
(prune-sessions! manager now)
|
||||||
(let ((value (hash-ref (auth-manager-sessions manager)
|
(let ((value (hash-ref (auth-manager-sessions manager)
|
||||||
token
|
token
|
||||||
#f)))
|
#f)))
|
||||||
(and value
|
(if value
|
||||||
(begin
|
(begin
|
||||||
(set-session-last-seen! value now)
|
(set-session-last-seen! value now)
|
||||||
(session-username value)))))))))))
|
(session-username value))
|
||||||
|
#f))))))))
|
||||||
(define (failure-blocked? manager address now)
|
|
||||||
(define value (hash-ref (auth-manager-failed manager) address #f))
|
|
||||||
(and value
|
|
||||||
(if (> (- now (failures-started value)) failure-window-seconds)
|
|
||||||
(begin
|
|
||||||
(hash-remove! (auth-manager-failed manager) address)
|
|
||||||
#f)
|
|
||||||
(>= (failures-attempts value) maximum-failures))))
|
|
||||||
|
|
||||||
(define (record-failure! manager address now)
|
|
||||||
(define value (hash-ref (auth-manager-failed manager) address #f))
|
|
||||||
(if (and value
|
|
||||||
(<= (- now (failures-started value)) failure-window-seconds))
|
|
||||||
(set-failures-attempts! value (+ 1 (failures-attempts value)))
|
|
||||||
(hash-set! (auth-manager-failed manager)
|
|
||||||
address
|
|
||||||
(failures 1 now))))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : Authenticate credentials and start a browser session.
|
; goal : Authenticate credentials and start a browser session.
|
||||||
@@ -227,16 +272,24 @@
|
|||||||
; post : A valid login creates a new session; a failed login updates the
|
; post : A valid login creates a new session; a failed login updates the
|
||||||
; rate-limit state for the effective client address.
|
; rate-limit state for the effective client address.
|
||||||
; result : A new opaque token, #f for invalid credentials, or 'rate-limited.
|
; result : A new opaque token, #f for invalid credentials, or 'rate-limited.
|
||||||
; internals: Unknown users follow the same Argon2id verification path as known
|
; internals: request-address selects the rate-limit key and failure-blocked?
|
||||||
; users to reduce username-dependent timing differences.
|
; checks its window while the manager lock is held. Unknown users
|
||||||
|
; verify against dummy-password-hash to reduce username-dependent
|
||||||
|
; timing differences. Success creates a session; failure delegates
|
||||||
|
; to record-failure!.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (auth-login! manager request username password)
|
(define/contract (auth-login! manager request username password)
|
||||||
(define address (request-address manager request))
|
(-> auth-manager?
|
||||||
(define now (current-seconds))
|
request?
|
||||||
(define normalized (string-downcase (string-trim username)))
|
string?
|
||||||
|
string?
|
||||||
|
(or/c #f 'rate-limited string?))
|
||||||
|
(let ((address (request-address manager request))
|
||||||
|
(now (current-seconds))
|
||||||
|
(normalized (string-downcase (string-trim username))))
|
||||||
(call-with-semaphore
|
(call-with-semaphore
|
||||||
(auth-manager-lock manager)
|
(auth-manager-lock manager)
|
||||||
(lambda ()
|
(λ ()
|
||||||
(if (failure-blocked? manager address now)
|
(if (failure-blocked? manager address now)
|
||||||
'rate-limited
|
'rate-limited
|
||||||
(let* ((stored (hash-ref (auth-manager-users manager)
|
(let* ((stored (hash-ref (auth-manager-users manager)
|
||||||
@@ -257,20 +310,23 @@
|
|||||||
token)
|
token)
|
||||||
(begin
|
(begin
|
||||||
(record-failure! manager address now)
|
(record-failure! manager address now)
|
||||||
#f)))))))
|
#f))))))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : End the browser session named by the request cookie.
|
; goal : End the browser session named by the request cookie.
|
||||||
; pre : Manager is an auth-manager and request is an HTTP request.
|
; pre : Manager is an auth-manager and request is an HTTP request.
|
||||||
; post : The matching server-side session is removed when it exists.
|
; post : The matching server-side session is removed when it exists.
|
||||||
; result : Void.
|
; result : Void.
|
||||||
|
; internals: request-session-token finds the cookie and the manager lock
|
||||||
|
; protects removal from the shared session hash.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (auth-logout! manager request)
|
(define/contract (auth-logout! manager request)
|
||||||
|
(-> auth-manager? request? void?)
|
||||||
(let ((token (request-session-token request)))
|
(let ((token (request-session-token request)))
|
||||||
(when token
|
(when token
|
||||||
(call-with-semaphore
|
(call-with-semaphore
|
||||||
(auth-manager-lock manager)
|
(auth-manager-lock manager)
|
||||||
(lambda ()
|
(λ ()
|
||||||
(hash-remove! (auth-manager-sessions manager) token))))))
|
(hash-remove! (auth-manager-sessions manager) token))))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
@@ -279,8 +335,11 @@
|
|||||||
; post : Manager remains unchanged.
|
; post : Manager remains unchanged.
|
||||||
; result : A Secure, HttpOnly, SameSite=Strict Set-Cookie value whose Max-Age
|
; result : A Secure, HttpOnly, SameSite=Strict Set-Cookie value whose Max-Age
|
||||||
; equals the configured session lifetime.
|
; equals the configured session lifetime.
|
||||||
|
; internals: format combines session-cookie-name, token and the manager's
|
||||||
|
; configured lifetime into the complete Set-Cookie header value.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (auth-session-cookie manager token)
|
(define/contract (auth-session-cookie manager token)
|
||||||
|
(-> auth-manager? string? bytes?)
|
||||||
(string->bytes/utf-8
|
(string->bytes/utf-8
|
||||||
(format
|
(format
|
||||||
"~a=~a; Path=/; Max-Age=~a; Secure; HttpOnly; SameSite=Strict"
|
"~a=~a; Path=/; Max-Age=~a; Secure; HttpOnly; SameSite=Strict"
|
||||||
@@ -295,38 +354,51 @@
|
|||||||
; last-cookie-renewal time is advanced.
|
; last-cookie-renewal time is advanced.
|
||||||
; result : A fresh Set-Cookie value after half the configured lifetime has
|
; result : A fresh Set-Cookie value after half the configured lifetime has
|
||||||
; elapsed, otherwise #f.
|
; elapsed, otherwise #f.
|
||||||
; internals: The server idle timer moves on every authenticated request, while
|
; internals: request-session-token identifies the session. The manager lock
|
||||||
; this half-life threshold prevents the one-second player poll from
|
; protects prune-sessions! and the renewal timestamp. A half-life
|
||||||
; returning Set-Cookie every second.
|
; threshold prevents the one-second player poll from returning a
|
||||||
|
; new cookie every second.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (auth-renewal-cookie manager request)
|
(define/contract (auth-renewal-cookie manager request)
|
||||||
(and (auth-enabled? manager)
|
(-> auth-manager? request? (or/c #f bytes?))
|
||||||
|
(if (not (auth-enabled? manager))
|
||||||
|
#f
|
||||||
(let ((token (request-session-token request))
|
(let ((token (request-session-token request))
|
||||||
(now (current-seconds)))
|
(now (current-seconds)))
|
||||||
(and token
|
(if (eq? token #f)
|
||||||
|
#f
|
||||||
(call-with-semaphore
|
(call-with-semaphore
|
||||||
(auth-manager-lock manager)
|
(auth-manager-lock manager)
|
||||||
(λ ()
|
(λ ()
|
||||||
(prune-sessions! manager now)
|
(prune-sessions! manager now)
|
||||||
(define value
|
(let ((value
|
||||||
(hash-ref (auth-manager-sessions manager) token #f))
|
(hash-ref (auth-manager-sessions manager) token #f)))
|
||||||
(and value
|
(if value
|
||||||
(>= (- now (session-last-cookie-renewal value))
|
(let* ((elapsed
|
||||||
|
(- now
|
||||||
|
(session-last-cookie-renewal value)))
|
||||||
|
(renewal-interval
|
||||||
(max 1
|
(max 1
|
||||||
(quotient
|
(quotient
|
||||||
(auth-manager-session-seconds manager)
|
(auth-manager-session-seconds manager)
|
||||||
2)))
|
2))))
|
||||||
|
(if (< elapsed renewal-interval)
|
||||||
|
#f
|
||||||
(begin
|
(begin
|
||||||
(set-session-last-cookie-renewal! value now)
|
(set-session-last-cookie-renewal! value now)
|
||||||
(auth-session-cookie manager token)))))))))
|
(auth-session-cookie manager token))))
|
||||||
|
#f))))))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
; goal : Encode deletion of the browser session cookie.
|
; goal : Encode deletion of the browser session cookie.
|
||||||
; pre : None.
|
; pre : None.
|
||||||
; post : No module state is changed.
|
; post : No module state is changed.
|
||||||
; result : A Secure, HttpOnly, SameSite=Strict Set-Cookie value with Max-Age 0.
|
; result : A Secure, HttpOnly, SameSite=Strict Set-Cookie value with Max-Age 0.
|
||||||
|
; internals: format uses session-cookie-name and an empty value to instruct the
|
||||||
|
; browser to remove the cookie immediately.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (auth-expired-cookie)
|
(define/contract (auth-expired-cookie)
|
||||||
|
(-> bytes?)
|
||||||
(string->bytes/utf-8
|
(string->bytes/utf-8
|
||||||
(format
|
(format
|
||||||
"~a=; Path=/; Max-Age=0; Secure; HttpOnly; SameSite=Strict"
|
"~a=; Path=/; Max-Age=0; Secure; HttpOnly; SameSite=Strict"
|
||||||
@@ -340,41 +412,50 @@
|
|||||||
; post : No external state is changed; session and rate-limit tables start
|
; post : No external state is changed; session and rate-limit tables start
|
||||||
; empty.
|
; empty.
|
||||||
; result : A new auth-manager with normalized usernames and parsed networks.
|
; result : A new auth-manager with normalized usernames and parsed networks.
|
||||||
|
; internals: Each user entry is validated and copied into a case-insensitive
|
||||||
|
; hash. parse-network converts trusted-proxy-values through the
|
||||||
|
; public net/ip API; fresh hashes and a semaphore protect sessions
|
||||||
|
; and failed-login windows.
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(define (make-auth-manager user-pairs
|
(define/contract (make-auth-manager
|
||||||
|
user-pairs
|
||||||
#:trusted-proxies
|
#:trusted-proxies
|
||||||
[trusted-proxy-values '("127.0.0.0/8" "::1/128")]
|
[trusted-proxy-values '("127.0.0.0/8" "::1/128")]
|
||||||
#:session-seconds [session-seconds 604800])
|
#:session-seconds [session-seconds 604800])
|
||||||
|
(->* ((listof (cons/c string? string?)))
|
||||||
|
(#:trusted-proxies (listof string?)
|
||||||
|
#:session-seconds exact-positive-integer?)
|
||||||
|
auth-manager?)
|
||||||
(unless (exact-positive-integer? session-seconds)
|
(unless (exact-positive-integer? session-seconds)
|
||||||
(raise-argument-error 'make-auth-manager "exact-positive-integer?"
|
(raise-argument-error 'make-auth-manager "exact-positive-integer?"
|
||||||
session-seconds))
|
session-seconds))
|
||||||
(define users (make-hash))
|
(let ((users (make-hash)))
|
||||||
(for ((entry (in-list user-pairs)))
|
(for-each
|
||||||
(unless (and (pair? entry)
|
(λ (entry)
|
||||||
(string? (car entry))
|
(let ((username (string-trim (car entry)))
|
||||||
(string? (cdr entry)))
|
(password-hash (cdr entry)))
|
||||||
(raise-argument-error
|
(when (string=? username "")
|
||||||
'make-auth-manager
|
|
||||||
"(listof (cons/c string? string?))"
|
|
||||||
user-pairs))
|
|
||||||
(when (string=? (string-trim (car entry)) "")
|
|
||||||
(raise-arguments-error
|
(raise-arguments-error
|
||||||
'make-auth-manager
|
'make-auth-manager
|
||||||
"username must not be empty"
|
"username must not be empty"
|
||||||
"username" (car entry)))
|
"username" (car entry)))
|
||||||
(unless (regexp-match? #px"^[$]argon2id[$]" (cdr entry))
|
(unless (regexp-match? #px"^[$]argon2id[$]" password-hash)
|
||||||
(raise-arguments-error
|
(raise-arguments-error
|
||||||
'make-auth-manager
|
'make-auth-manager
|
||||||
"user password is not an Argon2id hash"
|
"user password is not an Argon2id hash"
|
||||||
"username" (car entry)))
|
"username" (car entry)))
|
||||||
(hash-set! users (string-downcase (string-trim (car entry)))
|
(hash-set! users (string-downcase username) password-hash)))
|
||||||
(cdr entry)))
|
user-pairs)
|
||||||
(auth-manager users
|
(auth-manager users
|
||||||
(map parse-network trusted-proxy-values)
|
(map parse-network trusted-proxy-values)
|
||||||
session-seconds
|
session-seconds
|
||||||
(make-hash)
|
(make-hash)
|
||||||
(make-hash)
|
(make-hash)
|
||||||
(make-semaphore 1)))
|
(make-semaphore 1))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Tests for module users.rkt
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(module+ test
|
(module+ test
|
||||||
(require net/url
|
(require net/url
|
||||||
@@ -391,6 +472,20 @@
|
|||||||
(list (cons "Hans" test-hash))
|
(list (cons "Hans" test-hash))
|
||||||
#:trusted-proxies '("127.0.0.1/32")))
|
#:trusted-proxies '("127.0.0.1/32")))
|
||||||
|
|
||||||
|
(check-true
|
||||||
|
(network-contains? (parse-network "192.0.2.0/24") "192.0.2.18"))
|
||||||
|
(check-false
|
||||||
|
(network-contains? (parse-network "192.0.2.0/24") "192.0.3.18"))
|
||||||
|
(check-true
|
||||||
|
(network-contains? (parse-network "2001:db8::/32") "2001:db8::12"))
|
||||||
|
(check-true
|
||||||
|
(network-contains? (parse-network "127.0.0.0/8")
|
||||||
|
"0:0:0:0:0:ffff:7f00:1"))
|
||||||
|
(check-exn exn:fail:contract?
|
||||||
|
(λ () (parse-network "192.0.2.1/33")))
|
||||||
|
(check-exn exn:fail:contract?
|
||||||
|
(λ () (parse-network "not-an-address")))
|
||||||
|
|
||||||
(define (test-request peer [headers '()])
|
(define (test-request peer [headers '()])
|
||||||
(request #"GET" (string->url "http://example.test/api/state")
|
(request #"GET" (string->url "http://example.test/api/state")
|
||||||
headers (delay '()) #f "127.0.0.1" 80 peer))
|
headers (delay '()) #f "127.0.0.1" 80 peer))
|
||||||
@@ -413,6 +508,13 @@
|
|||||||
"198.51.100.2"
|
"198.51.100.2"
|
||||||
(list (header #"X-Forwarded-For" #"203.0.113.9"))))
|
(list (header #"X-Forwarded-For" #"203.0.113.9"))))
|
||||||
"198.51.100.2")
|
"198.51.100.2")
|
||||||
|
(check-equal?
|
||||||
|
(request-address
|
||||||
|
manager
|
||||||
|
(test-request
|
||||||
|
"0:0:0:0:0:ffff:7f00:1"
|
||||||
|
(list (header #"X-Forwarded-For" #"203.0.113.9"))))
|
||||||
|
"203.0.113.9")
|
||||||
(define token
|
(define token
|
||||||
(auth-login! manager remote "hans" "correct horse battery staple"))
|
(auth-login! manager remote "hans" "correct horse battery staple"))
|
||||||
(check-true (string? token))
|
(check-true (string? token))
|
||||||
@@ -432,4 +534,22 @@
|
|||||||
(check-false (auth-renewal-cookie manager authenticated))
|
(check-false (auth-renewal-cookie manager authenticated))
|
||||||
(auth-logout! manager authenticated)
|
(auth-logout! manager authenticated)
|
||||||
(check-false (auth-request-user manager authenticated))
|
(check-false (auth-request-user manager authenticated))
|
||||||
(check-false (auth-login! manager remote "hans" "wrong password")))
|
(check-false (auth-login! manager remote "hans" "wrong password"))
|
||||||
|
|
||||||
|
(let ((limited-manager (make-auth-manager '())))
|
||||||
|
(for-each
|
||||||
|
(λ (_) (record-failure! limited-manager "192.0.2.1" 100))
|
||||||
|
(range maximum-failures))
|
||||||
|
(check-true (failure-blocked? limited-manager "192.0.2.1" 100))
|
||||||
|
(check-false
|
||||||
|
(failure-blocked? limited-manager
|
||||||
|
"192.0.2.1"
|
||||||
|
(+ 101 failure-window-seconds))))
|
||||||
|
|
||||||
|
(let ((session-manager (make-auth-manager '() #:session-seconds 10)))
|
||||||
|
(hash-set! (auth-manager-sessions session-manager)
|
||||||
|
"expired"
|
||||||
|
(session "hans" 0 0))
|
||||||
|
(prune-sessions! session-manager 11)
|
||||||
|
(check-false
|
||||||
|
(hash-has-key? (auth-manager-sessions session-manager) "expired"))))
|
||||||
|
|||||||
+485
-173
@@ -1,3 +1,24 @@
|
|||||||
|
/*
|
||||||
|
* Browser client for the web player.
|
||||||
|
*
|
||||||
|
* PlayerStateClient merges status updates with the cached playlist; tracks are
|
||||||
|
* transferred only when their version changes. State requests share a queue.
|
||||||
|
* render stores that snapshot and passes it to the selector, library, playlist,
|
||||||
|
* and playback renderers. Collection renderers retain a DOM signature so the
|
||||||
|
* one-second polling loop only rebuilds lists whose contents changed.
|
||||||
|
*
|
||||||
|
* Event handlers send commands or change local controls. command sets
|
||||||
|
* commandBusy while its request is active, so refresh skips polling until the
|
||||||
|
* returned state has been rendered.
|
||||||
|
*/
|
||||||
|
|
||||||
|
import { PlayerStateClient } from "./player-state.js";
|
||||||
|
import { PlaylistLibrary } from "./playlist-library.js";
|
||||||
|
|
||||||
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
|
// Browser elements and state
|
||||||
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
|
|
||||||
const elements = {
|
const elements = {
|
||||||
renderer: document.querySelector("#renderer"),
|
renderer: document.querySelector("#renderer"),
|
||||||
language: document.querySelector("#language"),
|
language: document.querySelector("#language"),
|
||||||
@@ -27,6 +48,7 @@ const elements = {
|
|||||||
tabAdd: document.querySelector("#tab-add"),
|
tabAdd: document.querySelector("#tab-add"),
|
||||||
count: document.querySelector("#track-count"),
|
count: document.querySelector("#track-count"),
|
||||||
playlistClear: document.querySelector("#playlist-clear"),
|
playlistClear: document.querySelector("#playlist-clear"),
|
||||||
|
playlistSave: document.querySelector("#playlist-save"),
|
||||||
playlistEmpty: document.querySelector("#playlist-empty"),
|
playlistEmpty: document.querySelector("#playlist-empty"),
|
||||||
playlist: document.querySelector("#playlist"),
|
playlist: document.querySelector("#playlist"),
|
||||||
bits: document.querySelector("#audio-bits"),
|
bits: document.querySelector("#audio-bits"),
|
||||||
@@ -50,7 +72,11 @@ let state = null;
|
|||||||
let seekBusy = false;
|
let seekBusy = false;
|
||||||
let draggedTrack = null;
|
let draggedTrack = null;
|
||||||
let commandBusy = false;
|
let commandBusy = false;
|
||||||
|
let refreshBusy = false;
|
||||||
|
const playerState = new PlayerStateClient(api);
|
||||||
|
const playlistLibrary = new PlaylistLibrary(document.querySelector("#library-pane"), command, formatPlayingTime);
|
||||||
|
|
||||||
|
// Represents an unsuccessful API response, including its HTTP status and code.
|
||||||
class ApiError extends Error {
|
class ApiError extends Error {
|
||||||
constructor(message, status, code) {
|
constructor(message, status, code) {
|
||||||
super(message);
|
super(message);
|
||||||
@@ -59,8 +85,16 @@ class ApiError extends Error {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
|
// API, authentication, and shared formatting
|
||||||
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
|
|
||||||
|
// Converts a duration in seconds to the fixed-width time shown by the player.
|
||||||
function formatTime(value) {
|
function formatTime(value) {
|
||||||
if (!Number.isFinite(value) || value < 0) return "00:00:00";
|
if (!Number.isFinite(value) || value < 0) {
|
||||||
|
return "00:00:00";
|
||||||
|
}
|
||||||
|
|
||||||
const whole = Math.floor(value);
|
const whole = Math.floor(value);
|
||||||
const hours = Math.floor(whole / 3600).toString().padStart(2, "0");
|
const hours = Math.floor(whole / 3600).toString().padStart(2, "0");
|
||||||
const minutes = Math.floor((whole % 3600) / 60).toString().padStart(2, "0");
|
const minutes = Math.floor((whole % 3600) / 60).toString().padStart(2, "0");
|
||||||
@@ -68,18 +102,50 @@ function formatTime(value) {
|
|||||||
return `${hours}:${minutes}:${seconds}`;
|
return `${hours}:${minutes}:${seconds}`;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// Formats total playing time in the interface language, rounded to minutes.
|
||||||
|
function formatPlayingTime(value) {
|
||||||
|
const totalMinutes = Number.isFinite(value) ? Math.max(0, Math.round(value / 60)) : 0;
|
||||||
|
const hours = Math.floor(totalMinutes / 60);
|
||||||
|
const minutes = totalMinutes % 60;
|
||||||
|
const language = window.RktTranslate.language();
|
||||||
|
const parts = [];
|
||||||
|
if (hours > 0) {
|
||||||
|
parts.push(new Intl.NumberFormat(language, {
|
||||||
|
style: "unit", unit: "hour", unitDisplay: "long",
|
||||||
|
}).format(hours));
|
||||||
|
}
|
||||||
|
if (minutes > 0 || hours === 0) {
|
||||||
|
parts.push(new Intl.NumberFormat(language, {
|
||||||
|
style: "unit", unit: "minute", unitDisplay: "long",
|
||||||
|
}).format(minutes));
|
||||||
|
}
|
||||||
|
const duration = new Intl.ListFormat(language, { style: "long", type: "conjunction" }).format(parts);
|
||||||
|
return t("playingTime", { duration });
|
||||||
|
}
|
||||||
|
|
||||||
|
// Replaces the current status message, using an empty string for no message.
|
||||||
function setStatus(message) {
|
function setStatus(message) {
|
||||||
elements.status.textContent = message || "";
|
elements.status.textContent = message || "";
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// Translates an API error code while retaining literal messages as a fallback.
|
||||||
|
function errorMessage(error) {
|
||||||
|
return t(error.message);
|
||||||
|
}
|
||||||
|
|
||||||
|
// Sends a GET or JSON POST request and returns its decoded JSON response.
|
||||||
async function api(path, body) {
|
async function api(path, body) {
|
||||||
const options = body === undefined
|
let options;
|
||||||
? { cache: "no-store" }
|
if (body === undefined) {
|
||||||
: {
|
options = { cache: "no-store" };
|
||||||
|
} else {
|
||||||
|
options = {
|
||||||
method: "POST",
|
method: "POST",
|
||||||
headers: { "Content-Type": "application/json" },
|
headers: { "Content-Type": "application/json" },
|
||||||
body: JSON.stringify(body),
|
body: JSON.stringify(body),
|
||||||
};
|
};
|
||||||
|
}
|
||||||
|
|
||||||
const response = await fetch(path, options);
|
const response = await fetch(path, options);
|
||||||
const data = await response.json();
|
const data = await response.json();
|
||||||
if (!response.ok) {
|
if (!response.ok) {
|
||||||
@@ -88,21 +154,27 @@ async function api(path, body) {
|
|||||||
return data;
|
return data;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// Displays the login overlay and optionally reports why authentication failed.
|
||||||
function showLogin(message = null) {
|
function showLogin(message = null) {
|
||||||
const wasHidden = elements.loginOverlay.hidden;
|
const wasHidden = elements.loginOverlay.hidden;
|
||||||
if (message !== null) elements.loginError.textContent = message;
|
if (message !== null) {
|
||||||
|
elements.loginError.textContent = message;
|
||||||
|
}
|
||||||
|
|
||||||
elements.loginOverlay.hidden = false;
|
elements.loginOverlay.hidden = false;
|
||||||
if (wasHidden) {
|
if (wasHidden) {
|
||||||
window.setTimeout(() => elements.loginUsername.focus(), 0);
|
window.setTimeout(() => elements.loginUsername.focus(), 0);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// Hides the login overlay and clears credentials that must not be retained.
|
||||||
function hideLogin() {
|
function hideLogin() {
|
||||||
elements.loginOverlay.hidden = true;
|
elements.loginOverlay.hidden = true;
|
||||||
elements.loginError.textContent = "";
|
elements.loginError.textContent = "";
|
||||||
elements.loginPassword.value = "";
|
elements.loginPassword.value = "";
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// Synchronizes the login controls and stored language with the current session.
|
||||||
async function refreshAuth() {
|
async function refreshAuth() {
|
||||||
try {
|
try {
|
||||||
const auth = await api("/api/auth/status");
|
const auth = await api("/api/auth/status");
|
||||||
@@ -116,39 +188,62 @@ async function refreshAuth() {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
} catch (error) {
|
} catch (error) {
|
||||||
setStatus(t("authUnknown", { message: error.message }));
|
setStatus(t("authUnknown", { message: errorMessage(error) }));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// Sends a player command and immediately renders the state returned by it.
|
||||||
|
// commandBusy makes refresh skip polling until this request has finished.
|
||||||
async function command(name, data = {}, pendingMessage = "") {
|
async function command(name, data = {}, pendingMessage = "") {
|
||||||
if (pendingMessage) setStatus(pendingMessage);
|
if (pendingMessage) {
|
||||||
|
setStatus(pendingMessage);
|
||||||
|
}
|
||||||
|
|
||||||
commandBusy = true;
|
commandBusy = true;
|
||||||
try {
|
try {
|
||||||
render(await api(`/api/command/${name}`, data));
|
render(await playerState.request(`/api/command/${name}`, data));
|
||||||
} catch (error) {
|
} catch (error) {
|
||||||
setStatus(error.message);
|
setStatus(errorMessage(error));
|
||||||
} finally {
|
} finally {
|
||||||
commandBusy = false;
|
commandBusy = false;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
function replaceSelect(select, items, selectedId, signature) {
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
if (select.dataset.signature !== signature) {
|
// Output and library selectors
|
||||||
select.replaceChildren(...items.map((item) => {
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
|
|
||||||
|
// Creates one option for a renderer or music-library selector.
|
||||||
|
function createOption(item) {
|
||||||
const option = document.createElement("option");
|
const option = document.createElement("option");
|
||||||
option.value = item.id;
|
option.value = item.id;
|
||||||
option.textContent = item.label;
|
option.textContent = item.label;
|
||||||
return option;
|
return option;
|
||||||
}));
|
}
|
||||||
|
|
||||||
|
// Rebuilds a select only when its available items changed, then selects its value.
|
||||||
|
function replaceSelect(select, items, selectedId, signature) {
|
||||||
|
if (select.dataset.signature !== signature) {
|
||||||
|
select.replaceChildren(...items.map(createOption));
|
||||||
select.dataset.signature = signature;
|
select.dataset.signature = signature;
|
||||||
}
|
}
|
||||||
select.value = selectedId || "";
|
select.value = selectedId || "";
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// Builds the renderer label, translating the special local-renderer kind.
|
||||||
|
function rendererLabel(renderer) {
|
||||||
|
let kind = renderer.kind.toUpperCase();
|
||||||
|
if (renderer.kind === "local") {
|
||||||
|
kind = t("rendererLocal");
|
||||||
|
}
|
||||||
|
return `${renderer.name} · ${kind}`;
|
||||||
|
}
|
||||||
|
|
||||||
|
// Renders output and library choices and their current availability.
|
||||||
function renderSelectors(nextState) {
|
function renderSelectors(nextState) {
|
||||||
const rendererItems = nextState.renderers.map((item) => ({
|
const rendererItems = nextState.renderers.map((item) => ({
|
||||||
id: item.id,
|
id: item.id,
|
||||||
label: `${item.name} · ${item.kind === "local" ? t("rendererLocal") : item.kind.toUpperCase()}`,
|
label: rendererLabel(item),
|
||||||
}));
|
}));
|
||||||
replaceSelect(
|
replaceSelect(
|
||||||
elements.renderer,
|
elements.renderer,
|
||||||
@@ -174,6 +269,11 @@ function renderSelectors(nextState) {
|
|||||||
elements.library.disabled = nextState.libraries.length === 0;
|
elements.library.disabled = nextState.libraries.length === 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
|
// Music-library browser
|
||||||
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
|
|
||||||
|
// Creates an action button that does not activate its surrounding library row.
|
||||||
function entryAction(label, title, handler) {
|
function entryAction(label, title, handler) {
|
||||||
const button = document.createElement("button");
|
const button = document.createElement("button");
|
||||||
button.className = "entry-action";
|
button.className = "entry-action";
|
||||||
@@ -188,20 +288,38 @@ function entryAction(label, title, handler) {
|
|||||||
return button;
|
return button;
|
||||||
}
|
}
|
||||||
|
|
||||||
function renderBrowser(nextState) {
|
// Starts a library track immediately and reports which item is being loaded.
|
||||||
const selectedLibrary = nextState.libraries.find((item) => item.id === nextState.libraryId);
|
function playLibraryEntry(entry) {
|
||||||
const path = [selectedLibrary?.name, ...nextState.browser.path].filter(Boolean);
|
const message = t("loadingNamed", { name: entry.name });
|
||||||
elements.breadcrumb.textContent = path.length ? path.join(" / ") : t("noLibrary");
|
command("item-play", { index: entry.index }, message);
|
||||||
elements.breadcrumb.title = elements.breadcrumb.textContent;
|
}
|
||||||
elements.libraryUp.disabled = !nextState.browser.canGoUp;
|
|
||||||
elements.libraryEmpty.hidden = nextState.libraries.length > 0;
|
|
||||||
|
|
||||||
const signature = nextState.browser.entries
|
// Adds a library item to the current playlist and reports the pending action.
|
||||||
.map((entry) => `${entry.index}:${entry.kind}:${entry.name}`)
|
function addLibraryEntry(entry) {
|
||||||
.join("|");
|
const message = t("addingNamed", { name: entry.name });
|
||||||
if (elements.libraryEntries.dataset.signature === signature) return;
|
command("item-add", { index: entry.index }, message);
|
||||||
|
}
|
||||||
|
|
||||||
const rows = nextState.browser.entries.map((entry) => {
|
// Opens a container or starts a track, according to the entry kind.
|
||||||
|
function activateLibraryEntry(entry) {
|
||||||
|
if (entry.kind === "container") {
|
||||||
|
command("browse", { index: entry.index });
|
||||||
|
} else {
|
||||||
|
playLibraryEntry(entry);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Maps the keyboard actions supported by a focused library entry.
|
||||||
|
function handleLibraryEntryKeydown(event, entry) {
|
||||||
|
if (event.key === "Enter") {
|
||||||
|
activateLibraryEntry(entry);
|
||||||
|
} else if (event.key === "+") {
|
||||||
|
addLibraryEntry(entry);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Builds an interactive row for one container or track in the library browser.
|
||||||
|
function createLibraryEntry(entry) {
|
||||||
const row = document.createElement("li");
|
const row = document.createElement("li");
|
||||||
row.className = "library-entry";
|
row.className = "library-entry";
|
||||||
row.tabIndex = 0;
|
row.tabIndex = 0;
|
||||||
@@ -218,46 +336,64 @@ function renderBrowser(nextState) {
|
|||||||
const actions = document.createElement("span");
|
const actions = document.createElement("span");
|
||||||
actions.className = "entry-actions";
|
actions.className = "entry-actions";
|
||||||
actions.append(
|
actions.append(
|
||||||
entryAction("▶", t("playNow", { name: entry.name }), () => {
|
entryAction("▶", t("playNow", { name: entry.name }), () => playLibraryEntry(entry)),
|
||||||
command("item-play", { index: entry.index }, t("loadingNamed", { name: entry.name }));
|
entryAction("+", t("addNamed", { name: entry.name }), () => addLibraryEntry(entry)),
|
||||||
}),
|
|
||||||
entryAction("+", t("addNamed", { name: entry.name }), () => {
|
|
||||||
command("item-add", { index: entry.index }, t("addingNamed", { name: entry.name }));
|
|
||||||
}),
|
|
||||||
);
|
);
|
||||||
|
|
||||||
row.append(icon, name, actions);
|
row.append(icon, name, actions);
|
||||||
if (entry.kind === "container") {
|
if (entry.kind === "container") {
|
||||||
row.addEventListener("click", () => command("browse", { index: entry.index }));
|
row.addEventListener("click", () => activateLibraryEntry(entry));
|
||||||
} else {
|
} else {
|
||||||
row.addEventListener("dblclick", () => {
|
row.addEventListener("dblclick", () => activateLibraryEntry(entry));
|
||||||
command("item-play", { index: entry.index }, t("loadingNamed", { name: entry.name }));
|
|
||||||
});
|
|
||||||
}
|
}
|
||||||
row.addEventListener("keydown", (event) => {
|
row.addEventListener("keydown", (event) => handleLibraryEntryKeydown(event, entry));
|
||||||
if (event.key === "Enter") {
|
|
||||||
command(
|
|
||||||
entry.kind === "container" ? "browse" : "item-play",
|
|
||||||
{ index: entry.index },
|
|
||||||
entry.kind === "track" ? t("loadingNamed", { name: entry.name }) : "",
|
|
||||||
);
|
|
||||||
} else if (event.key === "+") {
|
|
||||||
command("item-add", { index: entry.index }, t("addingNamed", { name: entry.name }));
|
|
||||||
}
|
|
||||||
});
|
|
||||||
return row;
|
return row;
|
||||||
});
|
}
|
||||||
|
|
||||||
|
// Renders the current library path and rebuilds changed directory contents.
|
||||||
|
function renderBrowser(nextState) {
|
||||||
|
const selectedLibrary = nextState.libraries.find((item) => item.id === nextState.libraryId);
|
||||||
|
const path = [selectedLibrary?.name, ...nextState.browser.path].filter(Boolean);
|
||||||
|
elements.breadcrumb.textContent = path.length ? path.join(" / ") : t("noLibrary");
|
||||||
|
elements.breadcrumb.title = elements.breadcrumb.textContent;
|
||||||
|
elements.libraryUp.disabled = !nextState.browser.canGoUp;
|
||||||
|
elements.libraryEmpty.hidden = nextState.libraries.length > 0;
|
||||||
|
|
||||||
|
const signature = nextState.browser.entries
|
||||||
|
.map((entry) => `${entry.index}:${entry.kind}:${entry.name}`)
|
||||||
|
.join("|");
|
||||||
|
if (elements.libraryEntries.dataset.signature === signature) {
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
const rows = nextState.browser.entries.map(createLibraryEntry);
|
||||||
|
|
||||||
elements.libraryEntries.replaceChildren(...rows);
|
elements.libraryEntries.replaceChildren(...rows);
|
||||||
elements.libraryEntries.dataset.signature = signature;
|
elements.libraryEntries.dataset.signature = signature;
|
||||||
}
|
}
|
||||||
|
|
||||||
function renderTabs(nextState) {
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
const signature = nextState.tabs
|
// Playlist tabs
|
||||||
.map((tab) => `${tab.index}:${tab.name}:${tab.count}`)
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
.join("|");
|
|
||||||
if (elements.tabs.dataset.signature !== signature) {
|
// Prompts for and submits a new name for an existing playlist tab.
|
||||||
const tabs = nextState.tabs.map((tab) => {
|
function renameTab(tab) {
|
||||||
|
const newName = window.prompt(t("playlistName"), tab.name);
|
||||||
|
if (newName !== null) {
|
||||||
|
command("tab-rename", { index: tab.index, name: newName });
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Give this tab a library name while retaining its identity and current tracks.
|
||||||
|
function savePlaylist() {
|
||||||
|
if (!state) return;
|
||||||
|
const tab = state.tabs[state.currentTab];
|
||||||
|
const name = window.prompt(t("playlistName"), tab.name === "Default" ? t("defaultPlaylist") : tab.name);
|
||||||
|
if (name !== null) command("playlist-save", { id: tab.id, name });
|
||||||
|
}
|
||||||
|
|
||||||
|
// Builds one playlist tab, including its count and optional delete control.
|
||||||
|
function createTab(tab, canDelete) {
|
||||||
const button = document.createElement("button");
|
const button = document.createElement("button");
|
||||||
button.className = "tab";
|
button.className = "tab";
|
||||||
button.type = "button";
|
button.type = "button";
|
||||||
@@ -267,30 +403,38 @@ function renderTabs(nextState) {
|
|||||||
const name = document.createElement("span");
|
const name = document.createElement("span");
|
||||||
name.className = "tab-name";
|
name.className = "tab-name";
|
||||||
name.textContent = tab.name === "Default" ? t("defaultPlaylist") : tab.name;
|
name.textContent = tab.name === "Default" ? t("defaultPlaylist") : tab.name;
|
||||||
|
|
||||||
const count = document.createElement("span");
|
const count = document.createElement("span");
|
||||||
count.className = "tab-count";
|
count.className = "tab-count";
|
||||||
count.textContent = tab.count;
|
count.textContent = tab.count;
|
||||||
button.append(name, count);
|
button.append(name, count);
|
||||||
|
|
||||||
button.addEventListener("click", () => command("tab-select", { index: tab.index }));
|
button.addEventListener("click", () => command("tab-select", { index: tab.index }));
|
||||||
button.addEventListener("dblclick", () => {
|
button.addEventListener("dblclick", () => renameTab(tab));
|
||||||
const newName = window.prompt(t("playlistName"), tab.name);
|
|
||||||
if (newName !== null) command("tab-rename", { index: tab.index, name: newName });
|
|
||||||
});
|
|
||||||
|
|
||||||
if (nextState.tabs.length > 1) {
|
if (canDelete || tab.saved) {
|
||||||
const remove = document.createElement("span");
|
const remove = document.createElement("span");
|
||||||
remove.className = "tab-delete";
|
remove.className = "tab-delete";
|
||||||
remove.textContent = "×";
|
remove.textContent = "×";
|
||||||
remove.title = t("removePlaylist");
|
remove.title = t(tab.saved ? "closePlaylist" : "removePlaylist");
|
||||||
remove.addEventListener("click", (event) => {
|
remove.addEventListener("click", (event) => {
|
||||||
event.stopPropagation();
|
event.stopPropagation();
|
||||||
command("tab-delete", { index: tab.index });
|
command("tab-delete", { index: tab.index });
|
||||||
});
|
});
|
||||||
button.append(remove);
|
button.append(remove);
|
||||||
}
|
}
|
||||||
|
|
||||||
return button;
|
return button;
|
||||||
});
|
}
|
||||||
|
|
||||||
|
// Rebuilds changed tabs and marks the server-selected tab as active.
|
||||||
|
function renderTabs(nextState) {
|
||||||
|
const signature = nextState.tabs
|
||||||
|
.map((tab) => `${tab.index}:${tab.name}:${tab.count}:${tab.saved}`)
|
||||||
|
.join("|");
|
||||||
|
if (elements.tabs.dataset.signature !== signature) {
|
||||||
|
const canDelete = nextState.tabs.length > 1;
|
||||||
|
const tabs = nextState.tabs.map((tab) => createTab(tab, canDelete));
|
||||||
elements.tabs.replaceChildren(...tabs);
|
elements.tabs.replaceChildren(...tabs);
|
||||||
elements.tabs.dataset.signature = signature;
|
elements.tabs.dataset.signature = signature;
|
||||||
}
|
}
|
||||||
@@ -302,12 +446,31 @@ function renderTabs(nextState) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
function renderPlaylist(nextState) {
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
const signature = nextState.tracks
|
// Playlist tracks
|
||||||
.map((track) => `${track.index}:${track.title}:${track.artist}:${track.album}:${track.duration}`)
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
.join("|");
|
|
||||||
if (elements.playlist.dataset.signature !== signature) {
|
// Maps playback and deletion keys for a focused playlist row.
|
||||||
const rows = nextState.tracks.map((track) => {
|
function handlePlaylistRowKeydown(event, track) {
|
||||||
|
if (event.key === "Enter" || event.key === " ") {
|
||||||
|
event.preventDefault();
|
||||||
|
command("play", { index: track.index });
|
||||||
|
} else if (event.key === "Delete") {
|
||||||
|
command("track-remove", { index: track.index });
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Moves the dragged track to this row and clears the transient drag state.
|
||||||
|
function dropTrack(event, track) {
|
||||||
|
event.preventDefault();
|
||||||
|
if (Number.isInteger(draggedTrack) && draggedTrack !== track.index) {
|
||||||
|
command("track-move", { from: draggedTrack, to: track.index });
|
||||||
|
}
|
||||||
|
draggedTrack = null;
|
||||||
|
}
|
||||||
|
|
||||||
|
// Builds a playlist table row with playback, removal, and drag actions.
|
||||||
|
function createPlaylistRow(track) {
|
||||||
const row = document.createElement("tr");
|
const row = document.createElement("tr");
|
||||||
row.className = "playlist-row";
|
row.className = "playlist-row";
|
||||||
row.tabIndex = 0;
|
row.tabIndex = 0;
|
||||||
@@ -338,11 +501,12 @@ function renderPlaylist(nextState) {
|
|||||||
const action = document.createElement("td");
|
const action = document.createElement("td");
|
||||||
action.className = "action-column";
|
action.className = "action-column";
|
||||||
const remove = document.createElement("button");
|
const remove = document.createElement("button");
|
||||||
|
const removeTitle = t("removeNamed", { name: track.title });
|
||||||
remove.className = "row-action";
|
remove.className = "row-action";
|
||||||
remove.type = "button";
|
remove.type = "button";
|
||||||
remove.textContent = "×";
|
remove.textContent = "×";
|
||||||
remove.title = t("removeNamed", { name: track.title });
|
remove.title = removeTitle;
|
||||||
remove.setAttribute("aria-label", t("removeNamed", { name: track.title }));
|
remove.setAttribute("aria-label", removeTitle);
|
||||||
remove.addEventListener("click", (event) => {
|
remove.addEventListener("click", (event) => {
|
||||||
event.stopPropagation();
|
event.stopPropagation();
|
||||||
command("track-remove", { index: track.index });
|
command("track-remove", { index: track.index });
|
||||||
@@ -351,48 +515,68 @@ function renderPlaylist(nextState) {
|
|||||||
|
|
||||||
row.append(number, titleCell, album, duration, action);
|
row.append(number, titleCell, album, duration, action);
|
||||||
row.addEventListener("click", () => command("play", { index: track.index }));
|
row.addEventListener("click", () => command("play", { index: track.index }));
|
||||||
row.addEventListener("keydown", (event) => {
|
row.addEventListener("keydown", (event) => handlePlaylistRowKeydown(event, track));
|
||||||
if (event.key === "Enter" || event.key === " ") {
|
row.addEventListener("dragstart", () => {
|
||||||
event.preventDefault();
|
draggedTrack = track.index;
|
||||||
command("play", { index: track.index });
|
|
||||||
} else if (event.key === "Delete") {
|
|
||||||
command("track-remove", { index: track.index });
|
|
||||||
}
|
|
||||||
});
|
});
|
||||||
row.addEventListener("dragstart", () => { draggedTrack = track.index; });
|
|
||||||
row.addEventListener("dragover", (event) => event.preventDefault());
|
row.addEventListener("dragover", (event) => event.preventDefault());
|
||||||
row.addEventListener("drop", (event) => {
|
row.addEventListener("drop", (event) => dropTrack(event, track));
|
||||||
event.preventDefault();
|
|
||||||
if (Number.isInteger(draggedTrack) && draggedTrack !== track.index) {
|
|
||||||
command("track-move", { from: draggedTrack, to: track.index });
|
|
||||||
}
|
|
||||||
draggedTrack = null;
|
|
||||||
});
|
|
||||||
return row;
|
return row;
|
||||||
});
|
}
|
||||||
|
|
||||||
|
// Rebuilds changed tracks and updates the active row and playlist summary.
|
||||||
|
function renderPlaylist(nextState) {
|
||||||
|
const signature = nextState.playlistVersion;
|
||||||
|
if (elements.playlist.dataset.signature !== signature) {
|
||||||
|
const rows = nextState.tracks.map(createPlaylistRow);
|
||||||
elements.playlist.replaceChildren(...rows);
|
elements.playlist.replaceChildren(...rows);
|
||||||
elements.playlist.dataset.signature = signature;
|
elements.playlist.dataset.signature = signature;
|
||||||
}
|
}
|
||||||
|
|
||||||
for (const row of elements.playlist.children) {
|
const previousRow = elements.playlist.querySelector(".current");
|
||||||
row.classList.toggle("current", Number(row.dataset.index) === nextState.currentIndex);
|
const currentRow = Number.isInteger(nextState.currentIndex)
|
||||||
|
? elements.playlist.children[nextState.currentIndex] : null;
|
||||||
|
if (previousRow !== currentRow) {
|
||||||
|
previousRow?.classList.remove("current");
|
||||||
|
currentRow?.classList.add("current");
|
||||||
}
|
}
|
||||||
|
|
||||||
elements.playlistEmpty.hidden = nextState.tracks.length > 0;
|
elements.playlistEmpty.hidden = nextState.tracks.length > 0;
|
||||||
elements.count.textContent = `${nextState.tracks.length} ${t(nextState.tracks.length === 1 ? "oneTrack" : "manyTracks")}`;
|
const trackLabel = nextState.tracks.length === 1 ? "oneTrack" : "manyTracks";
|
||||||
|
const tab = nextState.tabs[nextState.currentTab];
|
||||||
|
elements.count.textContent = `${nextState.tracks.length} ${t(trackLabel)}, ${formatPlayingTime(tab.duration)}`;
|
||||||
elements.playlistClear.disabled = nextState.tracks.length === 0;
|
elements.playlistClear.disabled = nextState.tracks.length === 0;
|
||||||
|
elements.playlistSave.disabled = tab.saved;
|
||||||
|
elements.playlistSave.textContent = t(tab.saved ? "playlistSaved" : "savePlaylist");
|
||||||
}
|
}
|
||||||
|
|
||||||
function renderPlayer(nextState) {
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
const current = Number.isInteger(nextState.currentIndex)
|
// Playback state
|
||||||
? nextState.tracks[nextState.currentIndex]
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
: null;
|
|
||||||
elements.title.textContent = current ? current.title : t("nothingSelected");
|
|
||||||
elements.meta.textContent = current
|
|
||||||
? [current.artist, current.album].filter(Boolean).join(" · ") || current.source
|
|
||||||
: t("addTrackHint");
|
|
||||||
|
|
||||||
const artworkId = current?.artworkId || "";
|
// Returns the selected track, or null when the server has no valid selection.
|
||||||
|
function currentTrack(nextState) {
|
||||||
|
if (!Number.isInteger(nextState.currentIndex)) {
|
||||||
|
return null;
|
||||||
|
}
|
||||||
|
return nextState.tracks[nextState.currentIndex] || null;
|
||||||
|
}
|
||||||
|
|
||||||
|
// Renders the selected track's title and description or the empty-state text.
|
||||||
|
function renderCurrentTrack(track) {
|
||||||
|
if (track) {
|
||||||
|
const description = [track.artist, track.album].filter(Boolean).join(" · ");
|
||||||
|
elements.title.textContent = track.title;
|
||||||
|
elements.meta.textContent = description || track.source;
|
||||||
|
} else {
|
||||||
|
elements.title.textContent = t("nothingSelected");
|
||||||
|
elements.meta.textContent = t("addTrackHint");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Updates the cover source only when the selected artwork actually changes.
|
||||||
|
function renderArtwork(track) {
|
||||||
|
const artworkId = track?.artworkId || "";
|
||||||
if (elements.coverImage.dataset.artworkId !== artworkId) {
|
if (elements.coverImage.dataset.artworkId !== artworkId) {
|
||||||
elements.coverImage.dataset.artworkId = artworkId;
|
elements.coverImage.dataset.artworkId = artworkId;
|
||||||
if (artworkId) {
|
if (artworkId) {
|
||||||
@@ -405,7 +589,10 @@ function renderPlayer(nextState) {
|
|||||||
elements.coverPlaceholder.hidden = false;
|
elements.coverPlaceholder.hidden = false;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Reflects playback state and command availability in the transport controls.
|
||||||
|
function renderPlaybackControls(nextState) {
|
||||||
const playing = nextState.state === "playing" || nextState.state === "starting";
|
const playing = nextState.state === "playing" || nextState.state === "starting";
|
||||||
elements.play.textContent = playing ? "Ⅱ" : "▶";
|
elements.play.textContent = playing ? "Ⅱ" : "▶";
|
||||||
elements.play.setAttribute("aria-label", t(playing ? "pause" : "play"));
|
elements.play.setAttribute("aria-label", t(playing ? "pause" : "play"));
|
||||||
@@ -413,141 +600,218 @@ function renderPlayer(nextState) {
|
|||||||
elements.previous.disabled = nextState.tracks.length === 0;
|
elements.previous.disabled = nextState.tracks.length === 0;
|
||||||
elements.next.disabled = nextState.tracks.length === 0;
|
elements.next.disabled = nextState.tracks.length === 0;
|
||||||
elements.stop.disabled = nextState.state === "stopped";
|
elements.stop.disabled = nextState.state === "stopped";
|
||||||
|
}
|
||||||
|
|
||||||
|
// Updates elapsed time and seek position without disturbing an active drag.
|
||||||
|
function renderPosition(nextState) {
|
||||||
elements.position.textContent = formatTime(nextState.position);
|
elements.position.textContent = formatTime(nextState.position);
|
||||||
elements.duration.textContent = formatTime(nextState.duration);
|
elements.duration.textContent = formatTime(nextState.duration);
|
||||||
if (!seekBusy) {
|
if (!seekBusy) {
|
||||||
elements.seek.value = nextState.duration
|
let percentage = 0;
|
||||||
? Math.min(100, (nextState.position / nextState.duration) * 100)
|
if (nextState.duration) {
|
||||||
: 0;
|
percentage = Math.min(100, (nextState.position / nextState.duration) * 100);
|
||||||
|
}
|
||||||
|
elements.seek.value = percentage;
|
||||||
}
|
}
|
||||||
elements.seek.disabled = !nextState.duration;
|
elements.seek.disabled = !nextState.duration;
|
||||||
|
}
|
||||||
|
|
||||||
|
// Synchronizes the volume slider, value display, and accessible label.
|
||||||
|
function renderVolume(nextState) {
|
||||||
elements.volume.value = nextState.volume;
|
elements.volume.value = nextState.volume;
|
||||||
elements.volumeValue.value = `${Math.round(nextState.volume)}%`;
|
elements.volumeValue.value = `${Math.round(nextState.volume)}%`;
|
||||||
elements.volumeToggle.setAttribute(
|
elements.volumeToggle.setAttribute(
|
||||||
"aria-label",
|
"aria-label",
|
||||||
t("volumePercent", { value: Math.round(nextState.volume) }),
|
t("volumePercent", { value: Math.round(nextState.volume) }),
|
||||||
);
|
);
|
||||||
|
}
|
||||||
|
|
||||||
|
// Shows the active repeat mode and its translated description.
|
||||||
|
function renderRepeatMode(nextState) {
|
||||||
elements.repeat.dataset.repeat = nextState.repeat;
|
elements.repeat.dataset.repeat = nextState.repeat;
|
||||||
elements.repeat.classList.toggle("active", nextState.repeat !== "off");
|
elements.repeat.classList.toggle("active", nextState.repeat !== "off");
|
||||||
const repeatNames = { off: t("repeatOff"), all: t("repeatAll"), one: t("repeatOne") };
|
const repeatNames = { off: t("repeatOff"), all: t("repeatAll"), one: t("repeatOne") };
|
||||||
elements.repeat.title = repeatNames[nextState.repeat] || repeatNames.off;
|
elements.repeat.title = repeatNames[nextState.repeat] || repeatNames.off;
|
||||||
|
}
|
||||||
|
|
||||||
|
// Renders the technical properties reported for the current audio source.
|
||||||
|
function renderAudioDetails(nextState) {
|
||||||
elements.bits.textContent = nextState.bits ? `${nextState.bits} bit` : "— bit";
|
elements.bits.textContent = nextState.bits ? `${nextState.bits} bit` : "— bit";
|
||||||
elements.rate.textContent = nextState.rate ? `${(nextState.rate / 1000).toFixed(1)} kHz` : "— kHz";
|
elements.rate.textContent = nextState.rate ? `${(nextState.rate / 1000).toFixed(1)} kHz` : "— kHz";
|
||||||
elements.channels.textContent = nextState.channels
|
if (nextState.channels) {
|
||||||
? `${nextState.channels} ${t(nextState.channels === 1 ? "oneChannel" : "channels")}`
|
const channelLabel = nextState.channels === 1 ? "oneChannel" : "channels";
|
||||||
: `— ${t("channels")}`;
|
elements.channels.textContent = `${nextState.channels} ${t(channelLabel)}`;
|
||||||
|
} else {
|
||||||
|
elements.channels.textContent = `— ${t("channels")}`;
|
||||||
|
}
|
||||||
elements.format.textContent = nextState.format || "—";
|
elements.format.textContent = nextState.format || "—";
|
||||||
elements.source.textContent = nextState.source || "—";
|
elements.source.textContent = nextState.source || "—";
|
||||||
}
|
}
|
||||||
|
|
||||||
elements.coverImage.addEventListener("error", () => {
|
// Delegates the player portion of a state snapshot to its visible subregions.
|
||||||
elements.coverImage.hidden = true;
|
function renderPlayer(nextState) {
|
||||||
elements.coverPlaceholder.hidden = false;
|
const track = currentTrack(nextState);
|
||||||
});
|
renderCurrentTrack(track);
|
||||||
|
renderArtwork(track);
|
||||||
elements.coverImage.addEventListener("load", () => {
|
renderPlaybackControls(nextState);
|
||||||
elements.coverImage.hidden = false;
|
renderPosition(nextState);
|
||||||
elements.coverPlaceholder.hidden = true;
|
renderVolume(nextState);
|
||||||
});
|
renderRepeatMode(nextState);
|
||||||
|
renderAudioDetails(nextState);
|
||||||
|
}
|
||||||
|
|
||||||
|
// Stores and renders one complete state snapshot returned by the server.
|
||||||
function render(nextState) {
|
function render(nextState) {
|
||||||
state = nextState;
|
state = nextState;
|
||||||
renderSelectors(nextState);
|
renderSelectors(nextState);
|
||||||
renderBrowser(nextState);
|
renderBrowser(nextState);
|
||||||
|
playlistLibrary.render(nextState.savedPlaylists);
|
||||||
renderTabs(nextState);
|
renderTabs(nextState);
|
||||||
renderPlaylist(nextState);
|
renderPlaylist(nextState);
|
||||||
renderPlayer(nextState);
|
renderPlayer(nextState);
|
||||||
setStatus(nextState.error || (nextState.discovering ? t("searchingPlayers") : ""));
|
if (nextState.error) {
|
||||||
|
setStatus(t(nextState.error));
|
||||||
|
} else {
|
||||||
|
setStatus(nextState.discovering ? t("searchingPlayers") : "");
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
elements.play.addEventListener("click", () => {
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
if (!state) return;
|
// User interaction and polling
|
||||||
const playing = state.state === "playing" || state.state === "starting";
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
command(playing ? "pause" : state.state === "paused" ? "resume" : "play");
|
|
||||||
});
|
// Chooses whether the play button must start, resume, or pause playback.
|
||||||
elements.previous.addEventListener("click", () => command("previous"));
|
function commandForPlayButton(playbackState) {
|
||||||
elements.stop.addEventListener("click", () => command("stop"));
|
const playing = playbackState.state === "playing" || playbackState.state === "starting";
|
||||||
elements.next.addEventListener("click", () => command("next"));
|
if (playing) {
|
||||||
elements.repeat.addEventListener("click", () => {
|
return "pause";
|
||||||
if (!state) return;
|
}
|
||||||
const next = state.repeat === "off" ? "all" : state.repeat === "all" ? "one" : "off";
|
if (playbackState.state === "paused") {
|
||||||
command("repeat", { mode: next });
|
return "resume";
|
||||||
});
|
}
|
||||||
elements.renderer.addEventListener("change", () => command("renderer", { id: elements.renderer.value }));
|
return "play";
|
||||||
elements.language.value = window.RktTranslate.language();
|
}
|
||||||
elements.language.addEventListener("change", async () => {
|
|
||||||
|
// Sends the command represented by the play button in the current state.
|
||||||
|
function handlePlay() {
|
||||||
|
if (state) {
|
||||||
|
command(commandForPlayButton(state));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Advances repeat mode through off, all tracks, and one track.
|
||||||
|
function nextRepeatMode(currentMode) {
|
||||||
|
if (currentMode === "off") {
|
||||||
|
return "all";
|
||||||
|
}
|
||||||
|
if (currentMode === "all") {
|
||||||
|
return "one";
|
||||||
|
}
|
||||||
|
return "off";
|
||||||
|
}
|
||||||
|
|
||||||
|
// Sends the next repeat mode when state has already been received.
|
||||||
|
function handleRepeat() {
|
||||||
|
if (state) {
|
||||||
|
command("repeat", { mode: nextRepeatMode(state.repeat) });
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Applies and persists the language selected in the browser.
|
||||||
|
async function handleLanguageChange() {
|
||||||
window.RktTranslate.setLanguage(elements.language.value);
|
window.RktTranslate.setLanguage(elements.language.value);
|
||||||
try {
|
try {
|
||||||
await api("/api/preferences", { language: elements.language.value });
|
await api("/api/preferences", { language: elements.language.value });
|
||||||
} catch (error) {
|
} catch (error) {
|
||||||
setStatus(error.message);
|
setStatus(errorMessage(error));
|
||||||
}
|
}
|
||||||
});
|
}
|
||||||
window.addEventListener("rkt-language-change", () => {
|
|
||||||
|
// Invalidates translated collections and rerenders them in the new language.
|
||||||
|
function handleTranslationChange() {
|
||||||
elements.language.value = window.RktTranslate.language();
|
elements.language.value = window.RktTranslate.language();
|
||||||
for (const element of [elements.renderer, elements.libraryEntries, elements.tabs, elements.playlist]) {
|
const translatedElements = [
|
||||||
|
elements.renderer,
|
||||||
|
elements.libraryEntries,
|
||||||
|
elements.tabs,
|
||||||
|
elements.playlist,
|
||||||
|
];
|
||||||
|
for (const element of translatedElements) {
|
||||||
delete element.dataset.signature;
|
delete element.dataset.signature;
|
||||||
}
|
}
|
||||||
if (state) render(state);
|
if (state) {
|
||||||
});
|
render(state);
|
||||||
elements.discover.addEventListener("click", async () => {
|
|
||||||
try {
|
|
||||||
render(await api("/api/discover", {}));
|
|
||||||
} catch (error) {
|
|
||||||
setStatus(error.message);
|
|
||||||
}
|
}
|
||||||
});
|
}
|
||||||
elements.volumeToggle.addEventListener("click", () => {
|
|
||||||
const open = !elements.volumeControl.classList.contains("open");
|
// Starts renderer discovery and renders the state returned by the server.
|
||||||
|
async function discoverRenderers() {
|
||||||
|
try {
|
||||||
|
render(await playerState.request("/api/discover", {}));
|
||||||
|
} catch (error) {
|
||||||
|
setStatus(errorMessage(error));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Opens or closes the volume popover and keeps its ARIA state synchronized.
|
||||||
|
function setVolumeControlOpen(open) {
|
||||||
elements.volumeControl.classList.toggle("open", open);
|
elements.volumeControl.classList.toggle("open", open);
|
||||||
elements.volumeToggle.setAttribute("aria-expanded", String(open));
|
elements.volumeToggle.setAttribute("aria-expanded", String(open));
|
||||||
if (open) elements.volume.focus();
|
}
|
||||||
});
|
|
||||||
elements.volume.addEventListener("input", () => {
|
// Toggles the volume popover and moves focus to its slider when opened.
|
||||||
elements.volumeValue.value = `${elements.volume.value}%`;
|
function toggleVolumeControl() {
|
||||||
});
|
const open = !elements.volumeControl.classList.contains("open");
|
||||||
elements.volume.addEventListener("change", () => command("volume", { value: Number(elements.volume.value) }));
|
setVolumeControlOpen(open);
|
||||||
document.addEventListener("pointerdown", (event) => {
|
if (open) {
|
||||||
if (!elements.volumeControl.contains(event.target)) {
|
elements.volume.focus();
|
||||||
elements.volumeControl.classList.remove("open");
|
|
||||||
elements.volumeToggle.setAttribute("aria-expanded", "false");
|
|
||||||
}
|
}
|
||||||
});
|
}
|
||||||
document.addEventListener("keydown", (event) => {
|
|
||||||
|
// Closes the volume popover when the pointer is pressed outside its controls.
|
||||||
|
function closeVolumeControlOnOutsideClick(event) {
|
||||||
|
if (!elements.volumeControl.contains(event.target)) {
|
||||||
|
setVolumeControlOpen(false);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Closes the volume popover with Escape and returns focus to its button.
|
||||||
|
function closeVolumeControlOnEscape(event) {
|
||||||
if (event.key === "Escape" && elements.volumeControl.classList.contains("open")) {
|
if (event.key === "Escape" && elements.volumeControl.classList.contains("open")) {
|
||||||
elements.volumeControl.classList.remove("open");
|
setVolumeControlOpen(false);
|
||||||
elements.volumeToggle.setAttribute("aria-expanded", "false");
|
|
||||||
elements.volumeToggle.focus();
|
elements.volumeToggle.focus();
|
||||||
}
|
}
|
||||||
});
|
}
|
||||||
elements.seek.addEventListener("pointerdown", () => { seekBusy = true; });
|
|
||||||
elements.seek.addEventListener("change", () => {
|
// Sends the chosen seek percentage and permits polling to update the slider again.
|
||||||
|
function seek() {
|
||||||
seekBusy = false;
|
seekBusy = false;
|
||||||
command("seek", { percentage: Number(elements.seek.value) });
|
command("seek", { percentage: Number(elements.seek.value) });
|
||||||
});
|
}
|
||||||
elements.library.addEventListener("change", () => command("library", { id: elements.library.value }));
|
|
||||||
elements.libraryUp.addEventListener("click", () => command("up"));
|
|
||||||
elements.tabAdd.addEventListener("click", () => command("tab-add"));
|
|
||||||
elements.playlistClear.addEventListener("click", () => command("playlist-clear"));
|
|
||||||
|
|
||||||
|
// Polls status and changed tracks, without overlapping polls or busy commands.
|
||||||
async function refresh() {
|
async function refresh() {
|
||||||
if (commandBusy) return;
|
if (commandBusy || refreshBusy) {
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
refreshBusy = true;
|
||||||
try {
|
try {
|
||||||
render(await api("/api/state"));
|
render(await playerState.request("/api/state"));
|
||||||
hideLogin();
|
hideLogin();
|
||||||
} catch (error) {
|
} catch (error) {
|
||||||
if (error.code === "authentication-required") {
|
if (error.code === "authentication-required") {
|
||||||
showLogin();
|
showLogin();
|
||||||
} else {
|
} else {
|
||||||
setStatus(t("noConnection", { message: error.message }));
|
setStatus(t("noConnection", { message: errorMessage(error) }));
|
||||||
}
|
}
|
||||||
|
} finally {
|
||||||
|
refreshBusy = false;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
elements.loginForm.addEventListener("submit", async (event) => {
|
// Authenticates the entered credentials, then refreshes session and player state.
|
||||||
|
async function login(event) {
|
||||||
event.preventDefault();
|
event.preventDefault();
|
||||||
elements.loginSubmit.disabled = true;
|
elements.loginSubmit.disabled = true;
|
||||||
elements.loginError.textContent = "";
|
elements.loginError.textContent = "";
|
||||||
@@ -560,22 +824,70 @@ elements.loginForm.addEventListener("submit", async (event) => {
|
|||||||
await refreshAuth();
|
await refreshAuth();
|
||||||
await refresh();
|
await refresh();
|
||||||
} catch (error) {
|
} catch (error) {
|
||||||
showLogin(error.message);
|
showLogin(errorMessage(error));
|
||||||
elements.loginPassword.select();
|
elements.loginPassword.select();
|
||||||
} finally {
|
} finally {
|
||||||
elements.loginSubmit.disabled = false;
|
elements.loginSubmit.disabled = false;
|
||||||
}
|
}
|
||||||
});
|
}
|
||||||
|
|
||||||
elements.logout.addEventListener("click", async () => {
|
// Ends the server session and returns the browser to the login overlay.
|
||||||
|
async function logout() {
|
||||||
try {
|
try {
|
||||||
await api("/api/auth/logout", {});
|
await api("/api/auth/logout", {});
|
||||||
} finally {
|
} finally {
|
||||||
elements.logout.hidden = true;
|
elements.logout.hidden = true;
|
||||||
showLogin(t("loggedOut"));
|
showLogin(t("loggedOut"));
|
||||||
}
|
}
|
||||||
});
|
}
|
||||||
|
|
||||||
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
|
// Event registration and initialization
|
||||||
|
///////////////////////////////////////////////////////////////////////////////
|
||||||
|
|
||||||
|
elements.coverImage.addEventListener("error", () => {
|
||||||
|
elements.coverImage.hidden = true;
|
||||||
|
elements.coverPlaceholder.hidden = false;
|
||||||
|
});
|
||||||
|
elements.coverImage.addEventListener("load", () => {
|
||||||
|
elements.coverImage.hidden = false;
|
||||||
|
elements.coverPlaceholder.hidden = true;
|
||||||
|
});
|
||||||
|
elements.play.addEventListener("click", handlePlay);
|
||||||
|
elements.previous.addEventListener("click", () => command("previous"));
|
||||||
|
elements.stop.addEventListener("click", () => command("stop"));
|
||||||
|
elements.next.addEventListener("click", () => command("next"));
|
||||||
|
elements.repeat.addEventListener("click", handleRepeat);
|
||||||
|
elements.renderer.addEventListener("change", () => {
|
||||||
|
command("renderer", { id: elements.renderer.value });
|
||||||
|
});
|
||||||
|
elements.language.addEventListener("change", handleLanguageChange);
|
||||||
|
window.addEventListener("rkt-language-change", handleTranslationChange);
|
||||||
|
elements.discover.addEventListener("click", discoverRenderers);
|
||||||
|
elements.volumeToggle.addEventListener("click", toggleVolumeControl);
|
||||||
|
elements.volume.addEventListener("input", () => {
|
||||||
|
elements.volumeValue.value = `${elements.volume.value}%`;
|
||||||
|
});
|
||||||
|
elements.volume.addEventListener("change", () => {
|
||||||
|
command("volume", { value: Number(elements.volume.value) });
|
||||||
|
});
|
||||||
|
document.addEventListener("pointerdown", closeVolumeControlOnOutsideClick);
|
||||||
|
document.addEventListener("keydown", closeVolumeControlOnEscape);
|
||||||
|
elements.seek.addEventListener("pointerdown", () => {
|
||||||
|
seekBusy = true;
|
||||||
|
});
|
||||||
|
elements.seek.addEventListener("change", seek);
|
||||||
|
elements.library.addEventListener("change", () => {
|
||||||
|
command("library", { id: elements.library.value });
|
||||||
|
});
|
||||||
|
elements.libraryUp.addEventListener("click", () => command("up"));
|
||||||
|
elements.tabAdd.addEventListener("click", () => command("tab-add"));
|
||||||
|
elements.playlistClear.addEventListener("click", () => command("playlist-clear"));
|
||||||
|
elements.playlistSave.addEventListener("click", savePlaylist);
|
||||||
|
elements.loginForm.addEventListener("submit", login);
|
||||||
|
elements.logout.addEventListener("click", logout);
|
||||||
|
|
||||||
|
elements.language.value = window.RktTranslate.language();
|
||||||
refreshAuth();
|
refreshAuth();
|
||||||
refresh();
|
refresh();
|
||||||
setInterval(refresh, 1000);
|
setInterval(refresh, 1000);
|
||||||
|
|||||||
+18
-2
@@ -56,7 +56,12 @@
|
|||||||
|
|
||||||
<section class="workspace">
|
<section class="workspace">
|
||||||
<aside class="left-pane">
|
<aside class="left-pane">
|
||||||
<section class="library-pane panel">
|
<section id="library-pane" class="library-pane panel">
|
||||||
|
<div class="library-tabs" role="tablist" data-i18n-aria="musicLibrary" aria-label="Music library">
|
||||||
|
<button id="folders-tab" class="library-tab active" type="button" role="tab" aria-selected="true" aria-controls="folders-panel" data-i18n="folders">Folders</button>
|
||||||
|
<button id="saved-playlists-tab" class="library-tab" type="button" role="tab" aria-selected="false" aria-controls="saved-playlists-panel" tabindex="-1" data-i18n="playlists">Playlists</button>
|
||||||
|
</div>
|
||||||
|
<div id="folders-panel" class="library-folders" role="tabpanel" aria-labelledby="folders-tab">
|
||||||
<div class="panel-header library-header">
|
<div class="panel-header library-header">
|
||||||
<div>
|
<div>
|
||||||
<span class="panel-kicker" data-i18n="musicLibrary">MUSIC LIBRARY</span>
|
<span class="panel-kicker" data-i18n="musicLibrary">MUSIC LIBRARY</span>
|
||||||
@@ -70,6 +75,14 @@
|
|||||||
<code>[libraries] muziek=D:\Muziek</code>
|
<code>[libraries] muziek=D:\Muziek</code>
|
||||||
</div>
|
</div>
|
||||||
<ul id="library-entries" class="library-list" data-i18n-aria="folderContents" aria-label="Folder contents"></ul>
|
<ul id="library-entries" class="library-list" data-i18n-aria="folderContents" aria-label="Folder contents"></ul>
|
||||||
|
</div>
|
||||||
|
<div id="saved-playlists-panel" class="library-saved" role="tabpanel" aria-labelledby="saved-playlists-tab" hidden>
|
||||||
|
<div id="saved-playlists-empty" class="empty-state">
|
||||||
|
<p data-i18n="noSavedPlaylists">No saved playlists yet.</p>
|
||||||
|
<span data-i18n="savePlaylistHint">Save a playlist tab to find it here.</span>
|
||||||
|
</div>
|
||||||
|
<ul id="saved-playlists" class="library-list" data-i18n-aria="playlists" aria-label="Playlists"></ul>
|
||||||
|
</div>
|
||||||
</section>
|
</section>
|
||||||
|
|
||||||
<section class="now-playing-pane panel">
|
<section class="now-playing-pane panel">
|
||||||
@@ -99,8 +112,11 @@
|
|||||||
<span class="panel-kicker" data-i18n="playlist">PLAYLIST</span>
|
<span class="panel-kicker" data-i18n="playlist">PLAYLIST</span>
|
||||||
<strong id="track-count">0 tracks</strong>
|
<strong id="track-count">0 tracks</strong>
|
||||||
</div>
|
</div>
|
||||||
|
<div class="playlist-actions">
|
||||||
|
<button id="playlist-save" class="text-button" type="button" data-i18n="savePlaylist">SAVE PLAYLIST</button>
|
||||||
<button id="playlist-clear" class="text-button" type="button" data-i18n="clearList">CLEAR LIST</button>
|
<button id="playlist-clear" class="text-button" type="button" data-i18n="clearList">CLEAR LIST</button>
|
||||||
</div>
|
</div>
|
||||||
|
</div>
|
||||||
|
|
||||||
<div id="playlist-empty" class="empty-state playlist-empty">
|
<div id="playlist-empty" class="empty-state playlist-empty">
|
||||||
<p data-i18n="emptyPlaylist">This playlist is empty.</p>
|
<p data-i18n="emptyPlaylist">This playlist is empty.</p>
|
||||||
@@ -151,6 +167,6 @@
|
|||||||
</section>
|
</section>
|
||||||
|
|
||||||
<script src="/translate.js" defer></script>
|
<script src="/translate.js" defer></script>
|
||||||
<script src="/app.js" defer></script>
|
<script src="/app.js" type="module"></script>
|
||||||
</body>
|
</body>
|
||||||
</html>
|
</html>
|
||||||
|
|||||||
@@ -0,0 +1,4 @@
|
|||||||
|
{
|
||||||
|
"private": true,
|
||||||
|
"type": "module"
|
||||||
|
}
|
||||||
@@ -0,0 +1,40 @@
|
|||||||
|
/*
|
||||||
|
* Keeps the active playlist in memory between player-state requests.
|
||||||
|
* State, command and discovery requests share a queue so responses cannot
|
||||||
|
* overwrite newer state or reuse tracks from a different playlist version.
|
||||||
|
*/
|
||||||
|
export class PlayerStateClient {
|
||||||
|
#sendRequest;
|
||||||
|
#snapshot = null;
|
||||||
|
#pending = Promise.resolve();
|
||||||
|
|
||||||
|
// sendRequest performs the application's JSON GET/POST transport.
|
||||||
|
constructor(sendRequest) {
|
||||||
|
this.#sendRequest = sendRequest;
|
||||||
|
}
|
||||||
|
|
||||||
|
// Queues a state-producing request and returns a complete browser snapshot.
|
||||||
|
// A failed request does not prevent subsequent requests from being sent.
|
||||||
|
request(path, body) {
|
||||||
|
const result = this.#pending.then(() => this.#read(path, body));
|
||||||
|
this.#pending = result.catch(() => {});
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
|
// Sends the cached version and restores omitted tracks from that exact version.
|
||||||
|
async #read(path, body) {
|
||||||
|
if (this.#snapshot) {
|
||||||
|
path += `?playlistVersion=${encodeURIComponent(this.#snapshot.playlistVersion)}`;
|
||||||
|
}
|
||||||
|
const nextState = await this.#sendRequest(path, body);
|
||||||
|
if (nextState.tracks === null) {
|
||||||
|
if (!this.#snapshot || nextState.playlistVersion !== this.#snapshot.playlistVersion) {
|
||||||
|
this.#snapshot = null;
|
||||||
|
throw new Error("Playlist cache does not match the server version.");
|
||||||
|
}
|
||||||
|
nextState.tracks = this.#snapshot.tracks;
|
||||||
|
}
|
||||||
|
this.#snapshot = nextState;
|
||||||
|
return nextState;
|
||||||
|
}
|
||||||
|
}
|
||||||
@@ -0,0 +1,124 @@
|
|||||||
|
/*
|
||||||
|
* Library view for the Folders and Playlists tabs. Saved playlists are server
|
||||||
|
* objects: actions address their UUID and reveal their existing playlist tab.
|
||||||
|
* Only the selected library view and highlighted row are local UI state.
|
||||||
|
*/
|
||||||
|
export class PlaylistLibrary {
|
||||||
|
#tabs;
|
||||||
|
#panels;
|
||||||
|
#list;
|
||||||
|
#empty;
|
||||||
|
#command;
|
||||||
|
#formatDuration;
|
||||||
|
#selectedId = null;
|
||||||
|
#signature = null;
|
||||||
|
|
||||||
|
// root owns both library panels; command sends server actions and renders state.
|
||||||
|
constructor(root, command, formatDuration) {
|
||||||
|
this.#tabs = [root.querySelector("#folders-tab"), root.querySelector("#saved-playlists-tab")];
|
||||||
|
this.#panels = [root.querySelector("#folders-panel"), root.querySelector("#saved-playlists-panel")];
|
||||||
|
this.#list = root.querySelector("#saved-playlists");
|
||||||
|
this.#empty = root.querySelector("#saved-playlists-empty");
|
||||||
|
this.#command = command;
|
||||||
|
this.#formatDuration = formatDuration;
|
||||||
|
this.#tabs.forEach((tab, index) => {
|
||||||
|
tab.addEventListener("click", () => this.show(index));
|
||||||
|
tab.addEventListener("keydown", (event) => {
|
||||||
|
if (["ArrowLeft", "ArrowRight", "Home", "End"].includes(event.key)) {
|
||||||
|
event.preventDefault();
|
||||||
|
const next = event.key === "Home" ? 0 : event.key === "End" ? 1 : 1 - index;
|
||||||
|
this.show(next);
|
||||||
|
this.#tabs[next].focus();
|
||||||
|
}
|
||||||
|
});
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
// Switch the library panel without changing the selected playlist or playback.
|
||||||
|
show(index) {
|
||||||
|
this.#tabs.forEach((tab, current) => {
|
||||||
|
const active = current === index;
|
||||||
|
tab.classList.toggle("active", active);
|
||||||
|
tab.setAttribute("aria-selected", String(active));
|
||||||
|
tab.tabIndex = active ? 0 : -1;
|
||||||
|
this.#panels[current].hidden = !active;
|
||||||
|
});
|
||||||
|
}
|
||||||
|
|
||||||
|
// Refresh saved playlist summaries only when metadata or language changes.
|
||||||
|
render(playlists) {
|
||||||
|
const signature = JSON.stringify([window.RktTranslate.language(), playlists]);
|
||||||
|
if (signature === this.#signature) return;
|
||||||
|
if (!playlists.some((playlist) => playlist.id === this.#selectedId)) this.#selectedId = null;
|
||||||
|
this.#list.replaceChildren(...playlists.map((playlist) => this.#createEntry(playlist)));
|
||||||
|
this.#empty.hidden = playlists.length > 0;
|
||||||
|
this.#signature = signature;
|
||||||
|
this.#select(this.#selectedId);
|
||||||
|
}
|
||||||
|
|
||||||
|
#select(id) {
|
||||||
|
this.#selectedId = id;
|
||||||
|
for (const row of this.#list.children) {
|
||||||
|
const selected = row.dataset.id === id;
|
||||||
|
row.classList.toggle("selected", selected);
|
||||||
|
row.setAttribute("aria-current", selected ? "true" : "false");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
// Each action reveals this playlist by UUID; repeated opening is idempotent.
|
||||||
|
#action(label, title, playlist, play) {
|
||||||
|
const button = document.createElement("button");
|
||||||
|
button.type = "button";
|
||||||
|
button.className = "entry-action";
|
||||||
|
button.textContent = label;
|
||||||
|
button.title = title;
|
||||||
|
button.setAttribute("aria-label", title);
|
||||||
|
button.disabled = play && playlist.count === 0;
|
||||||
|
button.addEventListener("click", (event) => {
|
||||||
|
event.stopPropagation();
|
||||||
|
this.#select(playlist.id);
|
||||||
|
this.#command(play ? "playlist-play" : "playlist-open", { id: playlist.id });
|
||||||
|
});
|
||||||
|
return button;
|
||||||
|
}
|
||||||
|
|
||||||
|
#createEntry(playlist) {
|
||||||
|
const { t } = window.RktTranslate;
|
||||||
|
const row = document.createElement("li");
|
||||||
|
row.className = "library-entry";
|
||||||
|
row.dataset.id = playlist.id;
|
||||||
|
row.tabIndex = 0;
|
||||||
|
const icon = document.createElement("span");
|
||||||
|
icon.className = "entry-icon";
|
||||||
|
icon.textContent = "♫";
|
||||||
|
const name = document.createElement("span");
|
||||||
|
name.className = "entry-name";
|
||||||
|
name.textContent = playlist.name;
|
||||||
|
name.title = playlist.name;
|
||||||
|
const details = document.createElement("small");
|
||||||
|
details.className = "entry-details";
|
||||||
|
details.textContent = `${playlist.count} ${t(playlist.count === 1 ? "oneTrack" : "manyTracks")}, ${this.#formatDuration(playlist.duration)}`;
|
||||||
|
name.append(details);
|
||||||
|
const actions = document.createElement("span");
|
||||||
|
actions.className = "entry-actions";
|
||||||
|
actions.append(
|
||||||
|
this.#action("▶", t("playNow", { name: playlist.name }), playlist, true),
|
||||||
|
this.#action("+", t("openPlaylistNamed", { name: playlist.name }), playlist, false),
|
||||||
|
);
|
||||||
|
row.append(icon, name, actions);
|
||||||
|
row.addEventListener("click", () => this.#select(playlist.id));
|
||||||
|
row.addEventListener("dblclick", (event) => {
|
||||||
|
if (event.target.closest("button")) return;
|
||||||
|
this.#command("playlist-open", { id: playlist.id });
|
||||||
|
});
|
||||||
|
row.addEventListener("keydown", (event) => {
|
||||||
|
if (event.target !== row) return;
|
||||||
|
if (["Enter", "+", " "].includes(event.key)) {
|
||||||
|
event.preventDefault();
|
||||||
|
this.#select(playlist.id);
|
||||||
|
if (event.key !== " ") this.#command("playlist-open", { id: playlist.id });
|
||||||
|
}
|
||||||
|
});
|
||||||
|
return row;
|
||||||
|
}
|
||||||
|
}
|
||||||
Binary file not shown.
|
After Width: | Height: | Size: 60 KiB |
+61
-2
@@ -332,10 +332,61 @@ input[type="range"] {
|
|||||||
|
|
||||||
.library-pane {
|
.library-pane {
|
||||||
display: grid;
|
display: grid;
|
||||||
grid-template-rows: auto auto minmax(0, 1fr);
|
grid-template-rows: auto minmax(0, 1fr);
|
||||||
border-bottom: 0;
|
border-bottom: 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
.library-tabs {
|
||||||
|
display: flex;
|
||||||
|
border-bottom: 1px solid var(--line-soft);
|
||||||
|
}
|
||||||
|
|
||||||
|
.library-tab {
|
||||||
|
flex: 1;
|
||||||
|
min-height: 36px;
|
||||||
|
border: 0;
|
||||||
|
background: transparent;
|
||||||
|
color: var(--muted);
|
||||||
|
font-size: 12px;
|
||||||
|
}
|
||||||
|
|
||||||
|
.library-tab.active {
|
||||||
|
color: var(--accent);
|
||||||
|
box-shadow: inset 0 -2px var(--accent);
|
||||||
|
}
|
||||||
|
|
||||||
|
.library-folders {
|
||||||
|
display: grid;
|
||||||
|
grid-template-rows: auto auto minmax(0, 1fr);
|
||||||
|
min-height: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
.library-saved {
|
||||||
|
display: grid;
|
||||||
|
min-height: 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
.library-folders[hidden],
|
||||||
|
.library-saved[hidden] {
|
||||||
|
display: none;
|
||||||
|
}
|
||||||
|
|
||||||
|
.library-saved > .library-list,
|
||||||
|
.library-saved > .empty-state {
|
||||||
|
grid-area: 1 / 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
.library-entry.selected {
|
||||||
|
background: var(--panel-raised);
|
||||||
|
}
|
||||||
|
|
||||||
|
.entry-details {
|
||||||
|
display: block;
|
||||||
|
margin-top: 3px;
|
||||||
|
color: var(--muted);
|
||||||
|
font-size: 10px;
|
||||||
|
}
|
||||||
|
|
||||||
.panel-header {
|
.panel-header {
|
||||||
min-height: 55px;
|
min-height: 55px;
|
||||||
padding: 8px 10px;
|
padding: 8px 10px;
|
||||||
@@ -601,6 +652,8 @@ input[type="range"] {
|
|||||||
|
|
||||||
.playlist-toolbar {
|
.playlist-toolbar {
|
||||||
justify-content: space-between;
|
justify-content: space-between;
|
||||||
|
flex-wrap: wrap;
|
||||||
|
gap: 8px;
|
||||||
min-height: 53px;
|
min-height: 53px;
|
||||||
padding: 8px 12px;
|
padding: 8px 12px;
|
||||||
border-bottom: 1px solid var(--line-soft);
|
border-bottom: 1px solid var(--line-soft);
|
||||||
@@ -611,6 +664,12 @@ input[type="range"] {
|
|||||||
gap: 4px;
|
gap: 4px;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
.playlist-toolbar > .playlist-actions {
|
||||||
|
display: flex;
|
||||||
|
flex-wrap: wrap;
|
||||||
|
gap: 6px;
|
||||||
|
}
|
||||||
|
|
||||||
.playlist-toolbar strong {
|
.playlist-toolbar strong {
|
||||||
font-size: 14px;
|
font-size: 14px;
|
||||||
}
|
}
|
||||||
@@ -739,7 +798,7 @@ input[type="range"] {
|
|||||||
align-self: center;
|
align-self: center;
|
||||||
}
|
}
|
||||||
|
|
||||||
.library-pane > .empty-state {
|
.library-folders > .empty-state {
|
||||||
grid-row: 3;
|
grid-row: 3;
|
||||||
z-index: 2;
|
z-index: 2;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -3,6 +3,14 @@
|
|||||||
|
|
||||||
const translations = {
|
const translations = {
|
||||||
en: {
|
en: {
|
||||||
|
folders: "Folders",
|
||||||
|
savePlaylist: "SAVE PLAYLIST",
|
||||||
|
playlistSaved: "SAVED",
|
||||||
|
noSavedPlaylists: "No saved playlists yet.",
|
||||||
|
savePlaylistHint: "Save a playlist tab to find it here.",
|
||||||
|
openPlaylistNamed: "Open {name} as a tab",
|
||||||
|
closePlaylist: "Close tab",
|
||||||
|
playingTime: "{duration} playing time",
|
||||||
output: "OUTPUT", searchPlayers: "Search for network players", logout: "LOG OUT",
|
output: "OUTPUT", searchPlayers: "Search for network players", logout: "LOG OUT",
|
||||||
rendererLocal: "LOCAL", defaultPlaylist: "Default",
|
rendererLocal: "LOCAL", defaultPlaylist: "Default",
|
||||||
playbackControls: "Playback controls", previousTrack: "Previous track",
|
playbackControls: "Playback controls", previousTrack: "Previous track",
|
||||||
@@ -25,8 +33,22 @@
|
|||||||
channels: "channels", oneChannel: "channel", searchingPlayers: "Searching for network players…",
|
channels: "channels", oneChannel: "channel", searchingPlayers: "Searching for network players…",
|
||||||
authUnknown: "Authentication status unknown: {message}", noConnection: "No connection: {message}",
|
authUnknown: "Authentication status unknown: {message}", noConnection: "No connection: {message}",
|
||||||
loggedOut: "You have been logged out.", volumePercent: "Set volume, {value} percent",
|
loggedOut: "You have been logged out.", volumePercent: "Set volume, {value} percent",
|
||||||
|
"login-rate-limited": "Too many failed sign-in attempts; try again in a few minutes.",
|
||||||
|
"invalid-credentials": "Invalid username or password.",
|
||||||
|
"json-required": "Content-Type application/json is required.",
|
||||||
|
"authentication-required": "Sign-in is required.",
|
||||||
|
"dlna-renderer-no-start-of-track-confirmation": "The DLNA renderer did not confirm the start of the track.",
|
||||||
|
"dlna-renderer-unreachable": "The DLNA renderer is unreachable.",
|
||||||
},
|
},
|
||||||
nl: {
|
nl: {
|
||||||
|
folders: "Mappen",
|
||||||
|
savePlaylist: "AFSPEELLIJST OPSLAAN",
|
||||||
|
playlistSaved: "OPGESLAGEN",
|
||||||
|
noSavedPlaylists: "Nog geen opgeslagen afspeellijsten.",
|
||||||
|
savePlaylistHint: "Sla een playlisttab op om hem hier terug te vinden.",
|
||||||
|
openPlaylistNamed: "{name} als tab openen",
|
||||||
|
closePlaylist: "Tab sluiten",
|
||||||
|
playingTime: "{duration} speeltijd",
|
||||||
output: "UITVOER", searchPlayers: "Netwerkspelers zoeken", logout: "UITLOGGEN",
|
output: "UITVOER", searchPlayers: "Netwerkspelers zoeken", logout: "UITLOGGEN",
|
||||||
rendererLocal: "LOKAAL", defaultPlaylist: "Standaard",
|
rendererLocal: "LOKAAL", defaultPlaylist: "Standaard",
|
||||||
playbackControls: "Afspeelbediening", previousTrack: "Vorige track",
|
playbackControls: "Afspeelbediening", previousTrack: "Vorige track",
|
||||||
@@ -49,8 +71,22 @@
|
|||||||
channels: "kanalen", oneChannel: "kanaal", searchingPlayers: "Netwerkspelers zoeken…",
|
channels: "kanalen", oneChannel: "kanaal", searchingPlayers: "Netwerkspelers zoeken…",
|
||||||
authUnknown: "Authenticatiestatus onbekend: {message}", noConnection: "Geen verbinding: {message}",
|
authUnknown: "Authenticatiestatus onbekend: {message}", noConnection: "Geen verbinding: {message}",
|
||||||
loggedOut: "Je bent uitgelogd.", volumePercent: "Volume instellen, {value} procent",
|
loggedOut: "Je bent uitgelogd.", volumePercent: "Volume instellen, {value} procent",
|
||||||
|
"login-rate-limited": "Te veel mislukte aanmeldpogingen; probeer het over enkele minuten opnieuw.",
|
||||||
|
"invalid-credentials": "Ongeldige gebruikersnaam of ongeldig wachtwoord.",
|
||||||
|
"json-required": "Content-Type application/json is vereist.",
|
||||||
|
"authentication-required": "Aanmelden is vereist.",
|
||||||
|
"dlna-renderer-no-start-of-track-confirmation": "De DLNA-renderer bevestigde de start van de track niet.",
|
||||||
|
"dlna-renderer-unreachable": "De DLNA-renderer is niet bereikbaar.",
|
||||||
},
|
},
|
||||||
de: {
|
de: {
|
||||||
|
folders: "Ordner",
|
||||||
|
savePlaylist: "WIEDERGABELISTE SPEICHERN",
|
||||||
|
playlistSaved: "GESPEICHERT",
|
||||||
|
noSavedPlaylists: "Noch keine gespeicherten Wiedergabelisten.",
|
||||||
|
savePlaylistHint: "Speichern Sie eine Wiedergabeliste, um sie hier zu finden.",
|
||||||
|
openPlaylistNamed: "{name} als Tab öffnen",
|
||||||
|
closePlaylist: "Tab schließen",
|
||||||
|
playingTime: "{duration} Spielzeit",
|
||||||
output: "AUSGABE", searchPlayers: "Netzwerkplayer suchen", logout: "ABMELDEN",
|
output: "AUSGABE", searchPlayers: "Netzwerkplayer suchen", logout: "ABMELDEN",
|
||||||
rendererLocal: "LOKAL", defaultPlaylist: "Standard",
|
rendererLocal: "LOKAL", defaultPlaylist: "Standard",
|
||||||
playbackControls: "Wiedergabesteuerung", previousTrack: "Vorheriger Titel",
|
playbackControls: "Wiedergabesteuerung", previousTrack: "Vorheriger Titel",
|
||||||
@@ -73,8 +109,22 @@
|
|||||||
channels: "Kanäle", oneChannel: "Kanal", searchingPlayers: "Netzwerkplayer werden gesucht…",
|
channels: "Kanäle", oneChannel: "Kanal", searchingPlayers: "Netzwerkplayer werden gesucht…",
|
||||||
authUnknown: "Authentifizierungsstatus unbekannt: {message}", noConnection: "Keine Verbindung: {message}",
|
authUnknown: "Authentifizierungsstatus unbekannt: {message}", noConnection: "Keine Verbindung: {message}",
|
||||||
loggedOut: "Sie wurden abgemeldet.", volumePercent: "Lautstärke einstellen, {value} Prozent",
|
loggedOut: "Sie wurden abgemeldet.", volumePercent: "Lautstärke einstellen, {value} Prozent",
|
||||||
|
"login-rate-limited": "Zu viele fehlgeschlagene Anmeldeversuche; versuchen Sie es in einigen Minuten erneut.",
|
||||||
|
"invalid-credentials": "Ungültiger Benutzername oder ungültiges Passwort.",
|
||||||
|
"json-required": "Content-Type application/json ist erforderlich.",
|
||||||
|
"authentication-required": "Eine Anmeldung ist erforderlich.",
|
||||||
|
"dlna-renderer-no-start-of-track-confirmation": "Der DLNA-Renderer hat den Start des Titels nicht bestätigt.",
|
||||||
|
"dlna-renderer-unreachable": "Der DLNA-Renderer ist nicht erreichbar.",
|
||||||
},
|
},
|
||||||
fr: {
|
fr: {
|
||||||
|
folders: "Dossiers",
|
||||||
|
savePlaylist: "ENREGISTRER LA LISTE",
|
||||||
|
playlistSaved: "ENREGISTRÉE",
|
||||||
|
noSavedPlaylists: "Aucune liste de lecture enregistrée.",
|
||||||
|
savePlaylistHint: "Enregistrez une liste de lecture pour la retrouver ici.",
|
||||||
|
openPlaylistNamed: "Ouvrir {name} dans un onglet",
|
||||||
|
closePlaylist: "Fermer l’onglet",
|
||||||
|
playingTime: "{duration} de lecture",
|
||||||
output: "SORTIE", searchPlayers: "Rechercher les lecteurs réseau", logout: "DÉCONNEXION",
|
output: "SORTIE", searchPlayers: "Rechercher les lecteurs réseau", logout: "DÉCONNEXION",
|
||||||
rendererLocal: "LOCAL", defaultPlaylist: "Par défaut",
|
rendererLocal: "LOCAL", defaultPlaylist: "Par défaut",
|
||||||
playbackControls: "Commandes de lecture", previousTrack: "Piste précédente",
|
playbackControls: "Commandes de lecture", previousTrack: "Piste précédente",
|
||||||
@@ -97,8 +147,22 @@
|
|||||||
channels: "canaux", oneChannel: "canal", searchingPlayers: "Recherche des lecteurs réseau…",
|
channels: "canaux", oneChannel: "canal", searchingPlayers: "Recherche des lecteurs réseau…",
|
||||||
authUnknown: "État d’authentification inconnu : {message}", noConnection: "Aucune connexion : {message}",
|
authUnknown: "État d’authentification inconnu : {message}", noConnection: "Aucune connexion : {message}",
|
||||||
loggedOut: "Vous avez été déconnecté.", volumePercent: "Régler le volume, {value} pour cent",
|
loggedOut: "Vous avez été déconnecté.", volumePercent: "Régler le volume, {value} pour cent",
|
||||||
|
"login-rate-limited": "Trop de tentatives de connexion ont échoué ; réessayez dans quelques minutes.",
|
||||||
|
"invalid-credentials": "Nom d’utilisateur ou mot de passe incorrect.",
|
||||||
|
"json-required": "Le Content-Type application/json est requis.",
|
||||||
|
"authentication-required": "La connexion est requise.",
|
||||||
|
"dlna-renderer-no-start-of-track-confirmation": "Le lecteur DLNA n’a pas confirmé le démarrage de la piste.",
|
||||||
|
"dlna-renderer-unreachable": "Le lecteur DLNA est inaccessible.",
|
||||||
},
|
},
|
||||||
es: {
|
es: {
|
||||||
|
folders: "Carpetas",
|
||||||
|
savePlaylist: "GUARDAR LISTA",
|
||||||
|
playlistSaved: "GUARDADA",
|
||||||
|
noSavedPlaylists: "Todavía no hay listas guardadas.",
|
||||||
|
savePlaylistHint: "Guarda una lista de reproducción para encontrarla aquí.",
|
||||||
|
openPlaylistNamed: "Abrir {name} en una pestaña",
|
||||||
|
closePlaylist: "Cerrar pestaña",
|
||||||
|
playingTime: "{duration} de reproducción",
|
||||||
output: "SALIDA", searchPlayers: "Buscar reproductores de red", logout: "CERRAR SESIÓN",
|
output: "SALIDA", searchPlayers: "Buscar reproductores de red", logout: "CERRAR SESIÓN",
|
||||||
rendererLocal: "LOCAL", defaultPlaylist: "Predeterminada",
|
rendererLocal: "LOCAL", defaultPlaylist: "Predeterminada",
|
||||||
playbackControls: "Controles de reproducción", previousTrack: "Pista anterior",
|
playbackControls: "Controles de reproducción", previousTrack: "Pista anterior",
|
||||||
@@ -121,8 +185,22 @@
|
|||||||
channels: "canales", oneChannel: "canal", searchingPlayers: "Buscando reproductores de red…",
|
channels: "canales", oneChannel: "canal", searchingPlayers: "Buscando reproductores de red…",
|
||||||
authUnknown: "Estado de autenticación desconocido: {message}", noConnection: "Sin conexión: {message}",
|
authUnknown: "Estado de autenticación desconocido: {message}", noConnection: "Sin conexión: {message}",
|
||||||
loggedOut: "Has cerrado la sesión.", volumePercent: "Ajustar volumen, {value} por ciento",
|
loggedOut: "Has cerrado la sesión.", volumePercent: "Ajustar volumen, {value} por ciento",
|
||||||
|
"login-rate-limited": "Demasiados intentos de inicio de sesión fallidos; inténtalo de nuevo en unos minutos.",
|
||||||
|
"invalid-credentials": "Nombre de usuario o contraseña no válidos.",
|
||||||
|
"json-required": "Se requiere Content-Type application/json.",
|
||||||
|
"authentication-required": "Es necesario iniciar sesión.",
|
||||||
|
"dlna-renderer-no-start-of-track-confirmation": "El renderizador DLNA no confirmó el inicio de la pista.",
|
||||||
|
"dlna-renderer-unreachable": "No se puede acceder al renderizador DLNA.",
|
||||||
},
|
},
|
||||||
it: {
|
it: {
|
||||||
|
folders: "Cartelle",
|
||||||
|
savePlaylist: "SALVA PLAYLIST",
|
||||||
|
playlistSaved: "SALVATA",
|
||||||
|
noSavedPlaylists: "Nessuna playlist salvata.",
|
||||||
|
savePlaylistHint: "Salva una playlist per ritrovarla qui.",
|
||||||
|
openPlaylistNamed: "Apri {name} in una scheda",
|
||||||
|
closePlaylist: "Chiudi scheda",
|
||||||
|
playingTime: "{duration} di riproduzione",
|
||||||
output: "USCITA", searchPlayers: "Cerca lettori di rete", logout: "ESCI",
|
output: "USCITA", searchPlayers: "Cerca lettori di rete", logout: "ESCI",
|
||||||
rendererLocal: "LOCALE", defaultPlaylist: "Predefinita",
|
rendererLocal: "LOCALE", defaultPlaylist: "Predefinita",
|
||||||
playbackControls: "Controlli di riproduzione", previousTrack: "Traccia precedente",
|
playbackControls: "Controlli di riproduzione", previousTrack: "Traccia precedente",
|
||||||
@@ -145,8 +223,22 @@
|
|||||||
channels: "canali", oneChannel: "canale", searchingPlayers: "Ricerca dei lettori di rete…",
|
channels: "canali", oneChannel: "canale", searchingPlayers: "Ricerca dei lettori di rete…",
|
||||||
authUnknown: "Stato di autenticazione sconosciuto: {message}", noConnection: "Nessuna connessione: {message}",
|
authUnknown: "Stato di autenticazione sconosciuto: {message}", noConnection: "Nessuna connessione: {message}",
|
||||||
loggedOut: "Hai effettuato la disconnessione.", volumePercent: "Regola il volume, {value} percento",
|
loggedOut: "Hai effettuato la disconnessione.", volumePercent: "Regola il volume, {value} percento",
|
||||||
|
"login-rate-limited": "Troppi tentativi di accesso non riusciti; riprova tra qualche minuto.",
|
||||||
|
"invalid-credentials": "Nome utente o password non validi.",
|
||||||
|
"json-required": "È richiesto Content-Type application/json.",
|
||||||
|
"authentication-required": "È necessario effettuare l’accesso.",
|
||||||
|
"dlna-renderer-no-start-of-track-confirmation": "Il renderer DLNA non ha confermato l’avvio della traccia.",
|
||||||
|
"dlna-renderer-unreachable": "Il renderer DLNA non è raggiungibile.",
|
||||||
},
|
},
|
||||||
sv: {
|
sv: {
|
||||||
|
folders: "Mappar",
|
||||||
|
savePlaylist: "SPARA SPELLISTA",
|
||||||
|
playlistSaved: "SPARAD",
|
||||||
|
noSavedPlaylists: "Inga sparade spellistor ännu.",
|
||||||
|
savePlaylistHint: "Spara en spellista för att hitta den här.",
|
||||||
|
openPlaylistNamed: "Öppna {name} som en flik",
|
||||||
|
closePlaylist: "Stäng fliken",
|
||||||
|
playingTime: "{duration} speltid",
|
||||||
output: "UTGÅNG", searchPlayers: "Sök efter nätverksspelare", logout: "LOGGA UT",
|
output: "UTGÅNG", searchPlayers: "Sök efter nätverksspelare", logout: "LOGGA UT",
|
||||||
rendererLocal: "LOKAL", defaultPlaylist: "Standard",
|
rendererLocal: "LOKAL", defaultPlaylist: "Standard",
|
||||||
playbackControls: "Uppspelningskontroller", previousTrack: "Föregående spår",
|
playbackControls: "Uppspelningskontroller", previousTrack: "Föregående spår",
|
||||||
@@ -169,8 +261,22 @@
|
|||||||
channels: "kanaler", oneChannel: "kanal", searchingPlayers: "Söker efter nätverksspelare…",
|
channels: "kanaler", oneChannel: "kanal", searchingPlayers: "Söker efter nätverksspelare…",
|
||||||
authUnknown: "Okänd autentiseringsstatus: {message}", noConnection: "Ingen anslutning: {message}",
|
authUnknown: "Okänd autentiseringsstatus: {message}", noConnection: "Ingen anslutning: {message}",
|
||||||
loggedOut: "Du har loggats ut.", volumePercent: "Ställ in volymen på {value} procent",
|
loggedOut: "Du har loggats ut.", volumePercent: "Ställ in volymen på {value} procent",
|
||||||
|
"login-rate-limited": "För många misslyckade inloggningsförsök; försök igen om några minuter.",
|
||||||
|
"invalid-credentials": "Ogiltigt användarnamn eller lösenord.",
|
||||||
|
"json-required": "Content-Type application/json krävs.",
|
||||||
|
"authentication-required": "Inloggning krävs.",
|
||||||
|
"dlna-renderer-no-start-of-track-confirmation": "DLNA-renderaren bekräftade inte att spåret startade.",
|
||||||
|
"dlna-renderer-unreachable": "DLNA-renderaren kan inte nås.",
|
||||||
},
|
},
|
||||||
no: {
|
no: {
|
||||||
|
folders: "Mapper",
|
||||||
|
savePlaylist: "LAGRE SPILLELISTE",
|
||||||
|
playlistSaved: "LAGRET",
|
||||||
|
noSavedPlaylists: "Ingen lagrede spillelister ennå.",
|
||||||
|
savePlaylistHint: "Lagre en spilleliste for å finne den her.",
|
||||||
|
openPlaylistNamed: "Åpne {name} som en fane",
|
||||||
|
closePlaylist: "Lukk fanen",
|
||||||
|
playingTime: "{duration} spilletid",
|
||||||
output: "UTGANG", searchPlayers: "Søk etter nettverksspillere", logout: "LOGG UT",
|
output: "UTGANG", searchPlayers: "Søk etter nettverksspillere", logout: "LOGG UT",
|
||||||
rendererLocal: "LOKAL", defaultPlaylist: "Standard",
|
rendererLocal: "LOKAL", defaultPlaylist: "Standard",
|
||||||
playbackControls: "Avspillingskontroller", previousTrack: "Forrige spor",
|
playbackControls: "Avspillingskontroller", previousTrack: "Forrige spor",
|
||||||
@@ -193,8 +299,22 @@
|
|||||||
channels: "kanaler", oneChannel: "kanal", searchingPlayers: "Søker etter nettverksspillere…",
|
channels: "kanaler", oneChannel: "kanal", searchingPlayers: "Søker etter nettverksspillere…",
|
||||||
authUnknown: "Ukjent autentiseringsstatus: {message}", noConnection: "Ingen tilkobling: {message}",
|
authUnknown: "Ukjent autentiseringsstatus: {message}", noConnection: "Ingen tilkobling: {message}",
|
||||||
loggedOut: "Du er logget ut.", volumePercent: "Still inn volumet på {value} prosent",
|
loggedOut: "Du er logget ut.", volumePercent: "Still inn volumet på {value} prosent",
|
||||||
|
"login-rate-limited": "For mange mislykkede innloggingsforsøk; prøv igjen om noen minutter.",
|
||||||
|
"invalid-credentials": "Ugyldig brukernavn eller passord.",
|
||||||
|
"json-required": "Content-Type application/json er påkrevd.",
|
||||||
|
"authentication-required": "Innlogging er påkrevd.",
|
||||||
|
"dlna-renderer-no-start-of-track-confirmation": "DLNA-gjengiveren bekreftet ikke at sporet startet.",
|
||||||
|
"dlna-renderer-unreachable": "DLNA-gjengiveren kan ikke nås.",
|
||||||
},
|
},
|
||||||
fi: {
|
fi: {
|
||||||
|
folders: "Kansiot",
|
||||||
|
savePlaylist: "TALLENNA SOITTOLISTA",
|
||||||
|
playlistSaved: "TALLENNETTU",
|
||||||
|
noSavedPlaylists: "Ei vielä tallennettuja soittolistoja.",
|
||||||
|
savePlaylistHint: "Tallenna soittolista, niin löydät sen täältä.",
|
||||||
|
openPlaylistNamed: "Avaa {name} välilehtenä",
|
||||||
|
closePlaylist: "Sulje välilehti",
|
||||||
|
playingTime: "Toistoaika: {duration}",
|
||||||
output: "ULOSTULO", searchPlayers: "Etsi verkkosoittimia", logout: "KIRJAUDU ULOS",
|
output: "ULOSTULO", searchPlayers: "Etsi verkkosoittimia", logout: "KIRJAUDU ULOS",
|
||||||
rendererLocal: "PAIKALLINEN", defaultPlaylist: "Oletus",
|
rendererLocal: "PAIKALLINEN", defaultPlaylist: "Oletus",
|
||||||
playbackControls: "Toiston ohjaimet", previousTrack: "Edellinen kappale",
|
playbackControls: "Toiston ohjaimet", previousTrack: "Edellinen kappale",
|
||||||
@@ -217,8 +337,22 @@
|
|||||||
channels: "kanavaa", oneChannel: "kanava", searchingPlayers: "Etsitään verkkosoittimia…",
|
channels: "kanavaa", oneChannel: "kanava", searchingPlayers: "Etsitään verkkosoittimia…",
|
||||||
authUnknown: "Todennuksen tila ei ole tiedossa: {message}", noConnection: "Ei yhteyttä: {message}",
|
authUnknown: "Todennuksen tila ei ole tiedossa: {message}", noConnection: "Ei yhteyttä: {message}",
|
||||||
loggedOut: "Olet kirjautunut ulos.", volumePercent: "Säädä äänenvoimakkuudeksi {value} prosenttia",
|
loggedOut: "Olet kirjautunut ulos.", volumePercent: "Säädä äänenvoimakkuudeksi {value} prosenttia",
|
||||||
|
"login-rate-limited": "Liian monta epäonnistunutta kirjautumisyritystä; yritä uudelleen muutaman minuutin kuluttua.",
|
||||||
|
"invalid-credentials": "Virheellinen käyttäjänimi tai salasana.",
|
||||||
|
"json-required": "Content-Type application/json vaaditaan.",
|
||||||
|
"authentication-required": "Kirjautuminen vaaditaan.",
|
||||||
|
"dlna-renderer-no-start-of-track-confirmation": "DLNA-toistin ei vahvistanut kappaleen käynnistymistä.",
|
||||||
|
"dlna-renderer-unreachable": "DLNA-toistimeen ei saada yhteyttä.",
|
||||||
},
|
},
|
||||||
is: {
|
is: {
|
||||||
|
folders: "Möppur",
|
||||||
|
savePlaylist: "VISTA SPILUNARLISTA",
|
||||||
|
playlistSaved: "VISTAÐ",
|
||||||
|
noSavedPlaylists: "Engir vistaðir spilunarlistar enn.",
|
||||||
|
savePlaylistHint: "Vistaðu spilunarlista til að finna hann hér.",
|
||||||
|
openPlaylistNamed: "Opna {name} í flipa",
|
||||||
|
closePlaylist: "Loka flipa",
|
||||||
|
playingTime: "Spilunartími: {duration}",
|
||||||
output: "ÚTTAK", searchPlayers: "Leita að netspilurum", logout: "SKRÁ ÚT",
|
output: "ÚTTAK", searchPlayers: "Leita að netspilurum", logout: "SKRÁ ÚT",
|
||||||
rendererLocal: "STAÐBUNDIÐ", defaultPlaylist: "Sjálfgefið",
|
rendererLocal: "STAÐBUNDIÐ", defaultPlaylist: "Sjálfgefið",
|
||||||
playbackControls: "Stýringar spilunar", previousTrack: "Fyrra lag",
|
playbackControls: "Stýringar spilunar", previousTrack: "Fyrra lag",
|
||||||
@@ -241,6 +375,12 @@
|
|||||||
channels: "rásir", oneChannel: "rás", searchingPlayers: "Leita að netspilurum…",
|
channels: "rásir", oneChannel: "rás", searchingPlayers: "Leita að netspilurum…",
|
||||||
authUnknown: "Staða auðkenningar óþekkt: {message}", noConnection: "Engin tenging: {message}",
|
authUnknown: "Staða auðkenningar óþekkt: {message}", noConnection: "Engin tenging: {message}",
|
||||||
loggedOut: "Þú hefur skráð þig út.", volumePercent: "Stilla hljóðstyrk á {value} prósent",
|
loggedOut: "Þú hefur skráð þig út.", volumePercent: "Stilla hljóðstyrk á {value} prósent",
|
||||||
|
"login-rate-limited": "Of margar misheppnaðar innskráningartilraunir; reyndu aftur eftir nokkrar mínútur.",
|
||||||
|
"invalid-credentials": "Ógilt notandanafn eða lykilorð.",
|
||||||
|
"json-required": "Content-Type application/json er áskilið.",
|
||||||
|
"authentication-required": "Innskráningar er krafist.",
|
||||||
|
"dlna-renderer-no-start-of-track-confirmation": "DLNA-spilarinn staðfesti ekki að spilun lagsins hefði hafist.",
|
||||||
|
"dlna-renderer-unreachable": "Ekki næst samband við DLNA-spilarann.",
|
||||||
},
|
},
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|||||||
@@ -6,6 +6,7 @@ port=8080
|
|||||||
dlna-port=8734
|
dlna-port=8734
|
||||||
; Set to false when the server itself must not appear as an audio output.
|
; Set to false when the server itself must not appear as an audio output.
|
||||||
local-output=true
|
local-output=true
|
||||||
|
; playlist-keystore=./data/playlists.keystore
|
||||||
|
|
||||||
[libraries]
|
[libraries]
|
||||||
; muziek=D:\Muziek
|
; muziek=D:\Muziek
|
||||||
@@ -29,3 +30,9 @@ session-seconds=604800
|
|||||||
;
|
;
|
||||||
; hans=$argon2id$v=19$m=19456,t=2,p=1$...
|
; hans=$argon2id$v=19$m=19456,t=2,p=1$...
|
||||||
;
|
;
|
||||||
|
|
||||||
|
[logging]
|
||||||
|
; log-file=./data/rkt-web-player.log
|
||||||
|
; log-retention-days=7
|
||||||
|
; log-level=debug
|
||||||
|
|
||||||
|
|||||||
@@ -4,17 +4,125 @@
|
|||||||
racket/contract
|
racket/contract
|
||||||
rkt-web-player
|
rkt-web-player
|
||||||
rkt-web-player/player-agent
|
rkt-web-player/player-agent
|
||||||
|
rkt-web-player/set-user
|
||||||
rkt-web-player/users))
|
rkt-web-player/users))
|
||||||
|
|
||||||
@title{RKT Web Player}
|
@title{RKT Web Player}
|
||||||
@author{Hans van Dijkema}
|
@author[@author+email["Hans Dijkema" "hans@dijkewijk.nl"]]
|
||||||
|
|
||||||
@defmodule[rkt-web-player]
|
@defmodule[rkt-web-player]
|
||||||
|
|
||||||
RKT Web Player combines local playback through @tt{racket-audio}
|
RKT Web Player is a central music server for a trusted network. It makes one
|
||||||
with UPnP and Sonos discovery and playback through
|
or more configured music libraries available through a web interface and
|
||||||
@tt{racket-audio-dlna}. The user interface is served to a web
|
plays that music on different kinds of renderers: the server's own audio
|
||||||
browser by Racket's web server.
|
device, UPnP devices, Sonos groups, and player agents. The package also
|
||||||
|
provides those player agents as GUI and headless CLI applications, so a
|
||||||
|
computer without UPnP support can become a network renderer of its own. The
|
||||||
|
central server and each agent communicate over HTTP; the agent downloads its
|
||||||
|
assigned tracks and plays them on its local audio device.
|
||||||
|
|
||||||
|
@section{What the player provides}
|
||||||
|
|
||||||
|
The central server is the heart of the application. Its main features are:
|
||||||
|
|
||||||
|
@itemlist[
|
||||||
|
@item{Multiple named music libraries, including local and UNC/network paths.}
|
||||||
|
@item{Lazy directory browsing: startup reads only the library roots, while
|
||||||
|
recursive contents and audio metadata are read when needed.}
|
||||||
|
@item{Playback of the central library through the server's local audio
|
||||||
|
device, discovered UPnP renderers, Sonos groups, or registered agents.}
|
||||||
|
@item{Playlist tabs with adding, removing, reordering, renaming and
|
||||||
|
drag-and-drop support. Tracks from different libraries can share a
|
||||||
|
playlist. The playlist toolbar shows the selected playlist's track count
|
||||||
|
and total known playing time, rounded to minutes and expressed in hours
|
||||||
|
and minutes. Tracks without duration metadata contribute zero to the total.}
|
||||||
|
@item{Gapless network playback where the renderer or playback agent supports
|
||||||
|
preloading the next track, with a server-side fallback.}
|
||||||
|
@item{Transport controls, seeking, volume, repeat mode and live playback
|
||||||
|
status.}
|
||||||
|
@item{Embedded album art and adjacent @tt{cover}, @tt{folder} and
|
||||||
|
@tt{front} JPEG/PNG artwork.}
|
||||||
|
@item{Per-user playlists, language preference and playback pipeline, with
|
||||||
|
shared physical outputs that can be transferred between users.}
|
||||||
|
@item{Dutch, English, German, French, Spanish, Italian, Swedish, Norwegian,
|
||||||
|
Finnish and Icelandic interfaces.}
|
||||||
|
@item{Optional Argon2id browser authentication and a separate default-deny
|
||||||
|
allowlist for playback agents.}
|
||||||
|
]
|
||||||
|
|
||||||
|
The browser is a thin remote control, not a second player. It polls player
|
||||||
|
status once per second and sends commands to the central server;
|
||||||
|
playlists, preferences and playback state are kept there. The server exposes
|
||||||
|
the browser application under the root URL and its JSON API under @tt{/api}.
|
||||||
|
The API includes state, discovery, playback commands, preferences, artwork and
|
||||||
|
the agent registration, polling and media routes.
|
||||||
|
|
||||||
|
@subsection{Playlist synchronization}
|
||||||
|
|
||||||
|
State responses include an opaque @tt{playlistVersion} for the selected
|
||||||
|
playlist. The browser sends its last received version as the
|
||||||
|
@tt{playlistVersion} query parameter on @tt{/api/state}, @tt{/api/discover}
|
||||||
|
and @tt{/api/command/}@italic{command}. When that version still matches,
|
||||||
|
@tt{tracks} is JSON @tt{null}; otherwise the response includes the complete
|
||||||
|
track array. Requests without a version continue to receive all tracks.
|
||||||
|
The version and track data are returned together in one consistent snapshot.
|
||||||
|
|
||||||
|
The server caches serialized tracks, count and total duration per playlist.
|
||||||
|
Changing the track list invalidates that snapshot and generates a fresh version
|
||||||
|
when it is next requested. Renaming a tab or updating playback position does
|
||||||
|
not invalidate the tracks. Versions are renewed after a server restart and
|
||||||
|
are distinct between playlists and users. Changes from another browser are
|
||||||
|
picked up by the next poll.
|
||||||
|
|
||||||
|
The browser keeps the active playlist in memory and serializes state-producing
|
||||||
|
requests through @tt{PlayerStateClient}, so a delayed response cannot replace
|
||||||
|
newer state. Unchanged playlist rows are reused; changing the interface language
|
||||||
|
still rebuilds their translated labels.
|
||||||
|
|
||||||
|
@subsection{Saved playlists in the library}
|
||||||
|
|
||||||
|
The library has @italic{Folders} and @italic{Playlists} tabs. The playlist
|
||||||
|
toolbar's @italic{Save playlist} button names and saves the current tab in
|
||||||
|
the user's library. The library row's @tt{+} button opens that playlist as
|
||||||
|
its own tab, or selects its existing tab. @tt{▶} does the same and starts
|
||||||
|
playback. These actions never append tracks to or replace another tab.
|
||||||
|
|
||||||
|
A saved playlist and its open tab share one UUID and one track list. Track
|
||||||
|
edits and renaming therefore update the saved playlist automatically. Closing
|
||||||
|
the tab keeps it in the library. Closing the last saved tab leaves a new empty
|
||||||
|
default tab. Existing tabs remain open and appear in the library only after
|
||||||
|
the user explicitly saves them.
|
||||||
|
|
||||||
|
The keystore retains @tt{playlists-for-}@italic{username} for the ordered open
|
||||||
|
tabs and adds @tt{saved-playlists-for-}@italic{username} for library playlists.
|
||||||
|
Each UUID has one stored value, shared by both indexes. The private storage
|
||||||
|
procedure @tt{load-user-playlists} reads the open index by default and the saved
|
||||||
|
index with @tt{#:saved? #t}. @tt{save-user-playlists!} accepts the saved collection
|
||||||
|
through @tt{#:saved} and updates both indexes atomically. Values absent from
|
||||||
|
both indexes are removed. Legacy stores without a saved index need no migration.
|
||||||
|
|
||||||
|
Browser state includes @tt{savedPlaylists} summaries without track arrays and
|
||||||
|
a @tt{saved} flag on each tab. @tt{playlist-save} takes an open tab's @tt{id}
|
||||||
|
and a @tt{name}; @tt{playlist-open} and @tt{playlist-play} take a saved playlist's
|
||||||
|
@tt{id}. All three commands operate within the requesting user's collection.
|
||||||
|
|
||||||
|
@subsection{Player agents}
|
||||||
|
|
||||||
|
A player agent is an additional renderer implemented by this package. It runs
|
||||||
|
on a computer connected to speakers, registers with the central server, polls
|
||||||
|
for commands, downloads the selected music and plays it locally. Agents do not
|
||||||
|
open an inbound network port. The package supplies two forms:
|
||||||
|
|
||||||
|
@itemlist[
|
||||||
|
@item{The GUI agent, with a desktop window and system-tray integration.}
|
||||||
|
@item{The headless CLI agent, suitable for a small always-on computer or a
|
||||||
|
machine without a graphical desktop.}
|
||||||
|
]
|
||||||
|
|
||||||
|
The server treats each registered agent as an output alongside UPnP and Sonos
|
||||||
|
renderers. The server can prefetch the next track to an agent for gapless
|
||||||
|
transitions. A 256-bit application ID identifies the agent; the server's
|
||||||
|
@tt{[playback-agents]} allowlist decides which agents may connect.
|
||||||
|
|
||||||
@defproc[(run-web-player
|
@defproc[(run-web-player
|
||||||
[music-paths (listof (or/c path-string?
|
[music-paths (listof (or/c path-string?
|
||||||
@@ -28,7 +136,10 @@ browser by Racket's web server.
|
|||||||
[#:dlna-port dlna-port exact-positive-integer? 8734]
|
[#:dlna-port dlna-port exact-positive-integer? 8734]
|
||||||
[#:local-output? local-output? boolean? #t]
|
[#:local-output? local-output? boolean? #t]
|
||||||
[#:playlist-keystore playlist-keystore (or/c path-string? #f)]
|
[#:playlist-keystore playlist-keystore (or/c path-string? #f)]
|
||||||
[#:launch-browser? launch-browser? boolean? #t]) any/c] {
|
[#:log-file log-file path-string?]
|
||||||
|
[#:log-retention-days log-retention-days exact-positive-integer? 7]
|
||||||
|
[#:log-level log-level symbol? 'debug]
|
||||||
|
[#:launch-browser? launch-browser? boolean? #t]) any/c]{
|
||||||
|
|
||||||
Treats every entry in @racket[music-paths] as a separate music library. A
|
Treats every entry in @racket[music-paths] as a separate music library. A
|
||||||
two-element list supplies an explicit display name and path. The
|
two-element list supplies an explicit display name and path. The
|
||||||
@@ -59,10 +170,127 @@ Sessions have a sliding idle timeout; an active browser cookie is renewed once
|
|||||||
half of @racket[session-seconds] has elapsed. Playback-agent endpoints continue
|
half of @racket[session-seconds] has elapsed. Playback-agent endpoints continue
|
||||||
to use their separate application-ID allowlist.
|
to use their separate application-ID allowlist.
|
||||||
|
|
||||||
|
Logging is written to @racket[log-file]. Files are rotated after
|
||||||
|
@racket[log-retention-days] days, and @racket[log-level] selects the
|
||||||
|
@tt{simple-log} level. The default log file is
|
||||||
|
@tt{data/rkt-web-player.log} below the installed collection. The
|
||||||
|
@racket[playlist-keystore], @racket[log-file] and @racket[log-level] arguments
|
||||||
|
are useful when embedding the player; the command-line entry point can also
|
||||||
|
read these values from an INI file.
|
||||||
|
|
||||||
The default listen address only exposes the interface to the local computer.
|
The default listen address only exposes the interface to the local computer.
|
||||||
Use a LAN address deliberately if other devices should control the player.
|
Use a LAN address deliberately if other devices should control the player.
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@section{Command line and INI configuration}
|
||||||
|
|
||||||
|
The package entry point accepts one or more music directories:
|
||||||
|
|
||||||
|
@verbatim{
|
||||||
|
racket main.rkt MUSIC-DIRECTORY [...]
|
||||||
|
racket main.rkt --config rkt-web-player.ini --no-browser
|
||||||
|
}
|
||||||
|
|
||||||
|
The @tt{--config} option reads defaults from an INI file. The file is normally
|
||||||
|
named @tt{rkt-web-player.ini} and is read from the current directory when the
|
||||||
|
server is started with @tt{--config}. Relative paths are interpreted in the
|
||||||
|
process's working directory.
|
||||||
|
|
||||||
|
Command-line values for @tt{--listen-ip}, @tt{--port}, @tt{--dlna-port},
|
||||||
|
@tt{--playlist-keystore}, @tt{--log-file} and @tt{--no-browser} override the
|
||||||
|
corresponding defaults. Logging retention, log level, authentication and the
|
||||||
|
playback-agent allowlist are configured in the INI file. Libraries configured
|
||||||
|
under @tt{[libraries]} use the INI key as their display name and the value as
|
||||||
|
the root directory. The legacy @tt{[library] paths} setting accepts a
|
||||||
|
semicolon-separated list and is also supported. A complete example is:
|
||||||
|
|
||||||
|
@verbatim{
|
||||||
|
[server]
|
||||||
|
listen-ip=127.0.0.1
|
||||||
|
port=8080
|
||||||
|
|
||||||
|
[player]
|
||||||
|
dlna-port=8734
|
||||||
|
local-output=true
|
||||||
|
playlist-keystore=data/playlists.keystore
|
||||||
|
|
||||||
|
[logging]
|
||||||
|
log-file=data/rkt-web-player.log
|
||||||
|
log-retention-days=7
|
||||||
|
log-level=debug
|
||||||
|
|
||||||
|
[authentication]
|
||||||
|
trusted-proxies=127.0.0.0/8;::1/128
|
||||||
|
session-seconds=604800
|
||||||
|
|
||||||
|
[playback-agents]
|
||||||
|
; 64 hexadecimal characters, copied from an agent
|
||||||
|
0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef=true
|
||||||
|
|
||||||
|
[users]
|
||||||
|
; Generate hashes with make-password-hash or set-user.
|
||||||
|
hans=$argon2id$v=19$m=19456,t=2,p=1$...
|
||||||
|
}
|
||||||
|
|
||||||
|
The @tt{[server]} section controls the browser server. The default
|
||||||
|
@tt{listen-ip} is @tt{127.0.0.1}, so the interface is local-only by default;
|
||||||
|
@tt{0.0.0.0} or a LAN address makes it reachable from other machines.
|
||||||
|
@tt{port} defaults to @tt{8080}.
|
||||||
|
|
||||||
|
The @tt{[player]} section controls playback. @tt{dlna-port} defaults to
|
||||||
|
@tt{8734} and must be reachable by network renderers when they play files
|
||||||
|
published by the server. @tt{local-output=true} (the default) adds the
|
||||||
|
server's own audio device as an output. @tt{playlist-keystore} selects the
|
||||||
|
keystore for playlist tabs and language preferences; omission uses
|
||||||
|
@tt{data/playlists.keystore} below the installed collection. When embedding
|
||||||
|
the player through @racket[run-web-player], passing @racket[#f] disables
|
||||||
|
persistence.
|
||||||
|
|
||||||
|
The @tt{[logging]} section controls the rotating log file. The default file is
|
||||||
|
@tt{data/rkt-web-player.log}, retention defaults to seven days, and the default
|
||||||
|
level is @tt{debug}. The level is passed to @tt{simple-log}; use a level
|
||||||
|
supported by that package.
|
||||||
|
|
||||||
|
The @tt{[playback-agents]} section is a default-deny allowlist. Each key must
|
||||||
|
be the complete 64-character hexadecimal application ID of an agent and a
|
||||||
|
value other than @tt{false} permits registration. An empty section rejects all
|
||||||
|
agents. This ID is a shared bearer credential, not a replacement for HTTPS.
|
||||||
|
|
||||||
|
The @tt{[authentication]} section enables browser login when @tt{[users]} has
|
||||||
|
at least one entry. Each user value is an Argon2id hash, not a plaintext
|
||||||
|
password. @tt{session-seconds} defaults to seven days and is a sliding idle
|
||||||
|
timeout. @tt{trusted-proxies} is a semicolon-separated list of IP addresses or
|
||||||
|
CIDR ranges whose forwarded client address may be trusted; keep it limited to
|
||||||
|
the actual reverse proxy. The application does not terminate TLS, so use
|
||||||
|
HTTPS at the reverse proxy before exposing an authenticated instance beyond a
|
||||||
|
trusted LAN.
|
||||||
|
|
||||||
|
Create a password hash with @racket[make-password-hash], or run
|
||||||
|
@racket[set-user] in the directory containing the INI file. The
|
||||||
|
@racket[set-user] procedure updates @tt{rkt-web-player.ini} interactively.
|
||||||
|
|
||||||
|
@subsection{Playback-agent INI file}
|
||||||
|
|
||||||
|
The GUI and CLI agents use a separate private INI file named
|
||||||
|
@tt{rkt-web-player-agent.ini} in the user's Racket configuration directory.
|
||||||
|
It contains the following values:
|
||||||
|
|
||||||
|
@verbatim{
|
||||||
|
[server]
|
||||||
|
url=http://127.0.0.1:8080
|
||||||
|
|
||||||
|
[agent]
|
||||||
|
name=My playback
|
||||||
|
app-id=64 hexadecimal characters
|
||||||
|
}
|
||||||
|
|
||||||
|
The agent generates @tt{app-id} once and reuses it so the server allowlist
|
||||||
|
continues to work. The GUI writes the server URL and display name; the CLI can
|
||||||
|
override them with @tt{--server} and @tt{--name}. Use @tt{--config} with the
|
||||||
|
CLI to select another agent INI file and therefore another identity. Agents
|
||||||
|
make only outbound HTTP requests: they register and poll the server, download
|
||||||
|
assigned tracks, and play them locally. They do not open an inbound port.
|
||||||
|
|
||||||
@defmodule[rkt-web-player/users]
|
@defmodule[rkt-web-player/users]
|
||||||
|
|
||||||
@defproc[(make-password-hash [password string?]) string?] {
|
@defproc[(make-password-hash [password string?]) string?] {
|
||||||
@@ -77,6 +305,15 @@ Creates a salted Argon2id password hash suitable for a value in the INI
|
|||||||
Checks a password against an encoded Argon2id hash.
|
Checks a password against an encoded Argon2id hash.
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@defmodule[rkt-web-player/set-user]
|
||||||
|
|
||||||
|
@defproc[(set-user) void?] {
|
||||||
|
|
||||||
|
Interactively reads a username and password and writes the corresponding
|
||||||
|
Argon2id hash to the @tt{[users]} section of @filepath{rkt-web-player.ini} in
|
||||||
|
the current directory. The password must contain at least twelve characters.
|
||||||
|
}
|
||||||
|
|
||||||
@defmodule[rkt-web-player/player-agent]
|
@defmodule[rkt-web-player/player-agent]
|
||||||
|
|
||||||
@defproc[(run-player-agent) any/c] {
|
@defproc[(run-player-agent) any/c] {
|
||||||
@@ -87,8 +324,10 @@ configured RKT Web Player server, downloads assigned tracks over HTTP, and
|
|||||||
plays them with @tt{racket-audio}. Its configured display name is authoritative
|
plays them with @tt{racket-audio}. Its configured display name is authoritative
|
||||||
and is followed by the server. Importing the module does not start the GUI; the
|
and is followed by the server. Importing the module does not start the GUI; the
|
||||||
function must be called explicitly.
|
function must be called explicitly.
|
||||||
The GUI and optional tray support the same ten languages based on the
|
The GUI and its @tt{racket-tray} system tray support the same ten languages
|
||||||
operating-system language, with English as fallback.
|
based on the operating-system language, with English as fallback. Closing or
|
||||||
|
minimizing the window hides it in the tray. The tray menu restores the window
|
||||||
|
or shuts down the agent; no SDL3 runtime is required.
|
||||||
}
|
}
|
||||||
|
|
||||||
@defproc[(run-player-agent-cli [#:server-url server-url
|
@defproc[(run-player-agent-cli [#:server-url server-url
|
||||||
|
|||||||
+26
-14
@@ -1,24 +1,36 @@
|
|||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(require "users.rkt"
|
(require racket/class
|
||||||
simple-ini/class)
|
racket/contract
|
||||||
|
simple-ini/class
|
||||||
|
"users.rkt")
|
||||||
|
|
||||||
(provide set-user)
|
(provide set-user)
|
||||||
|
|
||||||
(define (set-user)
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Provided functions
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
; goal : Interactively add or replace one configured web-player user.
|
||||||
|
; pre : Standard input supplies a username and a password of at least
|
||||||
|
; twelve characters; rkt-web-player.ini is writable.
|
||||||
|
; post : The INI file's [users] section contains an Argon2id hash for the
|
||||||
|
; entered username; the clear-text password is not stored.
|
||||||
|
; result : Void after the configuration file has been updated.
|
||||||
|
; internals:
|
||||||
|
; The small utility uses simple-ini directly and intentionally owns
|
||||||
|
; no duplicate configuration representation.
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(define/contract (set-user)
|
||||||
|
(-> void?)
|
||||||
(displayln "Using rkt-web-player.ini as configuration file")
|
(displayln "Using rkt-web-player.ini as configuration file")
|
||||||
(newline)
|
(newline)
|
||||||
(display "Give username: >")
|
(display "Give username: >")
|
||||||
(define user (read-line))
|
(let ((user (read-line)))
|
||||||
(display "Give password: >")
|
(display "Give password: >")
|
||||||
(define pwd (read-line))
|
(let* ((password (read-line))
|
||||||
|
(hash (make-password-hash password))
|
||||||
(let ((hash (make-password-hash pwd)))
|
(ini (new ini% (file "rkt-web-player.ini"))))
|
||||||
(define ini (new ini% [file "rkt-web-player.ini"]))
|
|
||||||
(send ini set! 'users (string->symbol user) hash)
|
(send ini set! 'users (string->symbol user) hash)
|
||||||
)
|
(void))))
|
||||||
)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
@@ -1,227 +0,0 @@
|
|||||||
---
|
|
||||||
name: racket-programmeer-skill
|
|
||||||
description: Hiermee wordt mijn voorkeur racket programmeerstijl aangegeven.
|
|
||||||
---
|
|
||||||
|
|
||||||
---
|
|
||||||
name: racket-programmeerstijl
|
|
||||||
description: Gebruik deze skill wanneer je Racket-code voor Hans schrijft, wijzigt, refactort of beoordeelt. Pas de bestaande, eenvoudige en procedurele programmeerstijl toe; voorkom over-engineering en onnodige abstracties. Gebruik deze skill niet voor algemene uitleg over Racket waarbij geen code voor zijn projecten wordt gemaakt of aangepast.
|
|
||||||
---
|
|
||||||
|
|
||||||
# Racket-programmeerstijl
|
|
||||||
|
|
||||||
Gebruik deze stijl wanneer je Racket-code voor Hans schrijft of aanpast.
|
|
||||||
|
|
||||||
## Uitgangspunt
|
|
||||||
|
|
||||||
Het *allerbelangrijkste* uitgangspunt is dat je de programmerstijl van aangeleverde code volgt.
|
|
||||||
Als je een zip met een package aangeleverd krijgt via de prompt dan volg je de programmeerstijl die je in de aangeleverde code vindt.
|
|
||||||
Wanneer bestaande broncode beschikbaar is, heeft de stijl van die broncode voorrang. Sluit daar zo nauw mogelijk op aan.
|
|
||||||
|
|
||||||
Schrijf eenvoudige, directe en goed leesbare Racket-code.
|
|
||||||
Kies de kleinste oplossing die het huidige probleem netjes oplost.
|
|
||||||
Bouw geen abstraheringslaag voor mogelijk toekomstig gebruik.
|
|
||||||
En maak geen helpers die alleen maar in de weg staan.
|
|
||||||
|
|
||||||
## Structuur
|
|
||||||
|
|
||||||
- Houd modules klein en doelgericht.
|
|
||||||
- Splits functionaliteit alleen af naar een private module wanneer die een duidelijk eigen doel heeft.
|
|
||||||
- Gebruik voor duidelijke secties bij voorkeur commentaar in deze vorm:
|
|
||||||
|
|
||||||
```racket
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;; Supporting functions
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
```
|
|
||||||
|
|
||||||
of, wanneer dat beter bij de module past:
|
|
||||||
|
|
||||||
```racket
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;; Internal state / functions
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
```
|
|
||||||
|
|
||||||
Voor publieke functies:
|
|
||||||
|
|
||||||
```racket
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;; Provided functions
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
```
|
|
||||||
|
|
||||||
- Houd `provide` en `require` eenvoudig en overzichtelijk.
|
|
||||||
- Voeg geen extra framework, wrapperlaag of generieke infrastructuur toe zonder concrete noodzaak.
|
|
||||||
|
|
||||||
## pre/postcondities
|
|
||||||
|
|
||||||
Geëxporteerde functies/procedures/classes of functies/procedures/classes die daarvoor duidelijk in
|
|
||||||
aanmerking komen, d.w.z. die die provided zijn of naar verwachting zullen worden, moeten gedocumenteerd worden.
|
|
||||||
Zowel in een module scribble als in de code zelf. In het engels.
|
|
||||||
|
|
||||||
In de code zelf: minimaal:
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
; goal : <doel>
|
|
||||||
; pre : <preconditie(s)>
|
|
||||||
; post : <postconditie(s)>
|
|
||||||
; [result:] <resultaat en onder welke conditie>
|
|
||||||
|
|
||||||
Over het algemeen wil je de internals van een functie weten. Hoe werkt het en waarom werkt het zo.
|
|
||||||
|
|
||||||
; [internals:]
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
Als een functie/procedure/class overduidelijk in aanmerking komt voor 'provide' en hij staat er nog niet in.
|
|
||||||
Verzamel dan de lijst en vraag of je ze moet toevoegen.
|
|
||||||
|
|
||||||
## Procedures en control flow
|
|
||||||
|
|
||||||
- Geef de voorkeur aan gewone procedures met een direct leesbare control flow.
|
|
||||||
- Gebruik van `let`, `let*`, `letrec`, `if`, `when`, `unless`, `begin` en `cond` heeft de voorkeur.
|
|
||||||
- `map`, `filter`, en dat soort constructies gaan boven meer abstracte constructies als `for/or`, etc.
|
|
||||||
- Gebruik bij voorkeur geen `define` binnen een procedure, tenzij het echt om een locale
|
|
||||||
functie definitie gaat die een dermate omvang krijgt dat het binnen de closure gerechtvaardigd is.
|
|
||||||
- `let-values` is prima om te gebruiken.
|
|
||||||
- Maak niet voor iedere kleine stap een aparte helperprocedure.
|
|
||||||
- Introduceer geen hogere-orde of functionele constructies alleen omdat dat compacter kan.
|
|
||||||
- Gebruik recursie of een named `let` wanneer dat de meest directe oplossing is.
|
|
||||||
- Gebruik bij `cond` bij voorkeur deze vorm:
|
|
||||||
|
|
||||||
```racket
|
|
||||||
(cond
|
|
||||||
([condition] korte body)
|
|
||||||
([other-condition]
|
|
||||||
langere body))
|
|
||||||
(else ... alleen als het nodig is)
|
|
||||||
```
|
|
||||||
|
|
||||||
## Mate van abstractie vs leesbaarheid
|
|
||||||
|
|
||||||
Liever concreet dan abstract.
|
|
||||||
|
|
||||||
Geef expliciete, goed leesbare constructies de voorkeur boven compacte abstracte idiomen.
|
|
||||||
|
|
||||||
Bijvoorbeeld combinaties als (filter values (list (and condition 'symbol) ...)).
|
|
||||||
Schrijf dan liever expliciet (filter (lambda (x) x) (list (if condition 'symbol #f) ...)).
|
|
||||||
Vermijd vooral het stapelen van meerdere impliciete idiomen wanneer dat de leesbaarheid vermindert.
|
|
||||||
|
|
||||||
## Gebruik lambda.
|
|
||||||
|
|
||||||
Geef de voorkeur aan λ boven lambda.
|
|
||||||
|
|
||||||
## Waarden en state
|
|
||||||
|
|
||||||
- Gebruik `#f` als normale waarde voor "niet gevonden", "niet beschikbaar" of "nog niet geïnitialiseerd" wanneer dat natuurlijk past.
|
|
||||||
- Expliciete vergelijkingen zoals `(eq? value #f)` zijn prima wanneer dat de bedoeling duidelijk maakt.
|
|
||||||
- Houd state eenvoudig. Een gewone modulevariabele zoals `cached-git-exe` is prima wanneer daarvoor geen zwaarder mechanisme nodig is.
|
|
||||||
- Gebruik geen parameters, structs, classes of objectlagen wanneer een gewone variabele of procedure voldoende is.
|
|
||||||
|
|
||||||
## Publieke API
|
|
||||||
|
|
||||||
- Gebruik `define/contract` voor publieke procedures wanneer een contract nuttige documentatie en controle geeft.
|
|
||||||
- Houd publieke procedures klein en voorspelbaar.
|
|
||||||
- Verander een bestaande publieke API niet zonder noodzaak.
|
|
||||||
- Voeg geen extra publieke functies toe voor hypothetische toekomstige behoeften.
|
|
||||||
|
|
||||||
## Fouten en interactie
|
|
||||||
|
|
||||||
- Geef duidelijke en concrete foutmeldingen.
|
|
||||||
- Los eenvoudige interactieve invoer lokaal en procedureel op.
|
|
||||||
- Maak foutafhandeling niet generieker dan nodig.
|
|
||||||
- Als een externe executable of voorziening ontbreekt, meld precies wat ontbreekt en wat de gebruiker kan doen.
|
|
||||||
|
|
||||||
## Configuratie
|
|
||||||
|
|
||||||
- Bewaar lokale configuratie in een kleine, afzonderlijke private module wanneer dat de hoofdmodule eenvoudiger maakt.
|
|
||||||
- Gebruik bestaande projectvoorzieningen, zoals `simple-ini`, rechtstreeks in plaats van er een extra abstractielaag omheen te bouwen.
|
|
||||||
- Dupliceer geen configuratie die al door een extern programma zelf wordt beheerd.
|
|
||||||
|
|
||||||
## Naamgeving en leesbaarheid
|
|
||||||
|
|
||||||
- Kies concrete, korte namen die passen bij de bestaande code.
|
|
||||||
- Gebruik Engels voor identifiers en technische namen wanneer de bestaande code dat doet.
|
|
||||||
- Schrijf comments alleen wanneer ze iets toevoegen dat niet al vanzelf uit de code blijkt.
|
|
||||||
- Geef de voorkeur aan een paar duidelijke regels boven een compacte maar moeilijker leesbare expressie.
|
|
||||||
|
|
||||||
## Vermijd
|
|
||||||
|
|
||||||
Vermijd zonder concrete noodzaak:
|
|
||||||
|
|
||||||
- over-engineering;
|
|
||||||
- generieke wrappers;
|
|
||||||
- extra abstraheringslagen;
|
|
||||||
- dynamische `require`-constructies;
|
|
||||||
- classes wanneer procedures volstaan;
|
|
||||||
- structs wanneer een eenvoudige waarde volstaat;
|
|
||||||
- configuratie-objecten of dependency-injectionpatronen;
|
|
||||||
- veel kleine helperprocedures die de control flow versnipperen;
|
|
||||||
- refactors die alleen bedoeld zijn om code "slimmer" of abstracter te maken.
|
|
||||||
|
|
||||||
## Werkwijze bij aanpassen van bestaande code
|
|
||||||
|
|
||||||
1. Lees eerst de omliggende module(s).
|
|
||||||
2. Neem naamgeving, inspringing, control-flow-stijl en module-indeling over.
|
|
||||||
3. Wijzig alleen wat voor de gevraagde stap nodig is.
|
|
||||||
4. Houd bestaande werkende code intact als er geen reden is die te veranderen.
|
|
||||||
5. Voeg geen volgende architectuurstappen alvast toe.
|
|
||||||
6. Controleer of de oplossing eenvoudiger is dan het probleem; zo niet, vereenvoudig.
|
|
||||||
|
|
||||||
## Referentiestijl
|
|
||||||
|
|
||||||
Deze vorm is representatief:
|
|
||||||
|
|
||||||
```racket
|
|
||||||
(define cached-value #f)
|
|
||||||
|
|
||||||
(define/contract (get-value)
|
|
||||||
(-> (or/c path? #f))
|
|
||||||
(if (eq? cached-value #f)
|
|
||||||
(let ((value (find-value)))
|
|
||||||
(set! cached-value value)
|
|
||||||
value)
|
|
||||||
cached-value))
|
|
||||||
```
|
|
||||||
|
|
||||||
Een wat langere maar direct leesbare implementatie heeft de voorkeur boven een kortere oplossing met meerdere nieuwe abstracties.
|
|
||||||
|
|
||||||
# Schrijven van testgevallen voor modules/packages
|
|
||||||
|
|
||||||
Een test die alleen werkt vanuit de development directory, op het development-OS of met de lokale shell/environment is geen geldige package-test.
|
|
||||||
|
|
||||||
## Racket Package Index / build-service tests
|
|
||||||
|
|
||||||
Behandel de Racket Package Index/build service als een aparte, strikte
|
|
||||||
en onbekende testomgeving.
|
|
||||||
|
|
||||||
Bij packagecode en tests gelden daarom altijd de volgende regels:
|
|
||||||
|
|
||||||
- Maak nooit aannames over `current-directory` of de directory van waaruit
|
|
||||||
code of tests worden uitgevoerd. Bepaal testdata en paden expliciet en
|
|
||||||
relocatable, bijvoorbeeld met runtime paths en tijdelijke directories.
|
|
||||||
|
|
||||||
- Maak nooit impliciete aannames over het besturingssysteem. Vermijd
|
|
||||||
OS-specifieke paden, shells, executables en gedrag, of handel verschillen
|
|
||||||
expliciet per platform af.
|
|
||||||
|
|
||||||
- Maak tests onafhankelijk van lokale environment state. Benodigde
|
|
||||||
environment variables moeten expliciet en bij voorkeur geïsoleerd worden
|
|
||||||
ingesteld.
|
|
||||||
|
|
||||||
- Een succesvolle test moet stil en ondubbelzinnig succesvol zijn.
|
|
||||||
Laat geen verwachte foutmeldingen naar de echte stdout/stderr lekken,
|
|
||||||
omdat `raco test --drdr` en de Package Index dergelijke output als een
|
|
||||||
mogelijke test failure kunnen classificeren.
|
|
||||||
|
|
||||||
- Verwachte foutoutput moet worden gecaptureerd en geassert.
|
|
||||||
|
|
||||||
- Tests moeten hun eigen tijdelijke state en testbestanden aanmaken en
|
|
||||||
mogen geen bestanden, processen, environment changes of andere state
|
|
||||||
achterlaten.
|
|
||||||
|
|
||||||
- Test packagewijzigingen waar mogelijk ook in een omgeving die lijkt op:
|
|
||||||
`raco setup --check-pkg-deps` en
|
|
||||||
`raco test --drdr --package <package>`.
|
|
||||||
|
|
||||||
|
|
||||||
@@ -0,0 +1,87 @@
|
|||||||
|
import assert from "node:assert/strict";
|
||||||
|
import { test } from "node:test";
|
||||||
|
import { PlayerStateClient } from "../public/player-state.js";
|
||||||
|
|
||||||
|
test("polls reuse tracks and accept edits from another browser", async () => {
|
||||||
|
const tracks = [{ title: "First" }];
|
||||||
|
const changedTracks = [{ title: "Second" }];
|
||||||
|
const responses = [
|
||||||
|
{ playlistVersion: "first", tracks, position: 0 },
|
||||||
|
{ playlistVersion: "first", tracks: null, position: 1 },
|
||||||
|
{ playlistVersion: "changed", tracks: changedTracks, position: 2 },
|
||||||
|
{ playlistVersion: "changed", tracks: null, position: 3 },
|
||||||
|
];
|
||||||
|
const paths = [];
|
||||||
|
const client = new PlayerStateClient(async (path) => {
|
||||||
|
paths.push(path);
|
||||||
|
return responses.shift();
|
||||||
|
});
|
||||||
|
assert.equal((await client.request("/api/state")).tracks, tracks);
|
||||||
|
const unchanged = await client.request("/api/state");
|
||||||
|
assert.equal(unchanged.tracks, tracks);
|
||||||
|
assert.equal(unchanged.position, 1);
|
||||||
|
assert.equal((await client.request("/api/state")).tracks, changedTracks);
|
||||||
|
assert.equal((await client.request("/api/state")).tracks, changedTracks);
|
||||||
|
assert.deepEqual(paths, [
|
||||||
|
"/api/state", "/api/state?playlistVersion=first",
|
||||||
|
"/api/state?playlistVersion=first", "/api/state?playlistVersion=changed",
|
||||||
|
]);
|
||||||
|
});
|
||||||
|
|
||||||
|
test("commands and discovery wait for polling and use its latest version", async () => {
|
||||||
|
let finishPoll;
|
||||||
|
const paths = [];
|
||||||
|
const commandBody = { index: 1 };
|
||||||
|
const client = new PlayerStateClient((path, body) => {
|
||||||
|
paths.push(path);
|
||||||
|
if (paths.length === 1) {
|
||||||
|
return new Promise((resolve) => { finishPoll = resolve; });
|
||||||
|
}
|
||||||
|
if (paths.length === 2) {
|
||||||
|
assert.equal(body, commandBody);
|
||||||
|
return { playlistVersion: "other-tab", tracks: [] };
|
||||||
|
}
|
||||||
|
return { playlistVersion: "other-tab", tracks: null };
|
||||||
|
});
|
||||||
|
const poll = client.request("/api/state");
|
||||||
|
const command = client.request("/api/command/tab-select", commandBody);
|
||||||
|
const discovery = client.request("/api/discover", {});
|
||||||
|
await Promise.resolve();
|
||||||
|
assert.deepEqual(paths, ["/api/state"]);
|
||||||
|
finishPoll({ playlistVersion: "original-tab", tracks: [{ title: "First" }] });
|
||||||
|
await poll;
|
||||||
|
assert.deepEqual((await command).tracks, []);
|
||||||
|
assert.deepEqual((await discovery).tracks, []);
|
||||||
|
assert.deepEqual(paths, [
|
||||||
|
"/api/state",
|
||||||
|
"/api/command/tab-select?playlistVersion=original-tab",
|
||||||
|
"/api/discover?playlistVersion=other-tab",
|
||||||
|
]);
|
||||||
|
});
|
||||||
|
|
||||||
|
test("a failed request leaves the queue usable", async () => {
|
||||||
|
let calls = 0;
|
||||||
|
const client = new PlayerStateClient(async () => {
|
||||||
|
if (++calls === 1) throw new Error("Offline");
|
||||||
|
return { playlistVersion: "recovered", tracks: [] };
|
||||||
|
});
|
||||||
|
await assert.rejects(client.request("/api/state"), /Offline/);
|
||||||
|
assert.deepEqual((await client.request("/api/state")).tracks, []);
|
||||||
|
});
|
||||||
|
|
||||||
|
test("mismatched omitted tracks force a full refresh instead of stale reuse", async () => {
|
||||||
|
const paths = [];
|
||||||
|
const responses = [
|
||||||
|
{ playlistVersion: "before", tracks: [{ title: "Before" }] },
|
||||||
|
{ playlistVersion: "after", tracks: null },
|
||||||
|
{ playlistVersion: "after", tracks: [] },
|
||||||
|
];
|
||||||
|
const client = new PlayerStateClient(async (path) => {
|
||||||
|
paths.push(path);
|
||||||
|
return responses.shift();
|
||||||
|
});
|
||||||
|
await client.request("/api/state");
|
||||||
|
await assert.rejects(client.request("/api/state"), /Playlist cache/);
|
||||||
|
assert.deepEqual((await client.request("/api/state")).tracks, []);
|
||||||
|
assert.equal(paths[2], "/api/state");
|
||||||
|
});
|
||||||
@@ -0,0 +1,96 @@
|
|||||||
|
import assert from "node:assert/strict";
|
||||||
|
import { test } from "node:test";
|
||||||
|
import { PlaylistLibrary } from "../public/playlist-library.js";
|
||||||
|
|
||||||
|
// Minimal DOM elements let the view's actions run without a browser dependency.
|
||||||
|
class Element {
|
||||||
|
constructor() {
|
||||||
|
this.children = [];
|
||||||
|
this.dataset = {};
|
||||||
|
this.attributes = {};
|
||||||
|
this.listeners = {};
|
||||||
|
this.classes = new Set();
|
||||||
|
this.classList = { toggle: (name, active) => active ? this.classes.add(name) : this.classes.delete(name) };
|
||||||
|
}
|
||||||
|
append(...children) { this.children.push(...children); }
|
||||||
|
replaceChildren(...children) { this.children = children; }
|
||||||
|
setAttribute(name, value) { this.attributes[name] = value; }
|
||||||
|
addEventListener(name, callback) { this.listeners[name] = callback; }
|
||||||
|
fire(name, values = {}) { this.listeners[name]({ target: this, stopPropagation() {}, preventDefault() {}, ...values }); }
|
||||||
|
focus() {}
|
||||||
|
closest() { return null; }
|
||||||
|
}
|
||||||
|
|
||||||
|
class Fixture {
|
||||||
|
constructor() {
|
||||||
|
this.nodes = new Map();
|
||||||
|
this.commands = [];
|
||||||
|
this.language = "en";
|
||||||
|
globalThis.window = { RktTranslate: {
|
||||||
|
language: () => this.language,
|
||||||
|
t: (key, values = {}) => `${key} ${values.name || ""}`,
|
||||||
|
} };
|
||||||
|
globalThis.document = { createElement: () => new Element() };
|
||||||
|
this.view = new PlaylistLibrary({ querySelector: (selector) => this.node(selector) },
|
||||||
|
(name, data) => this.commands.push({ name, data }), duration => `${duration} seconds`);
|
||||||
|
}
|
||||||
|
node(selector) {
|
||||||
|
if (!this.nodes.has(selector)) this.nodes.set(selector, new Element());
|
||||||
|
return this.nodes.get(selector);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
test("library tabs change only the visible panel", () => {
|
||||||
|
const fixture = new Fixture();
|
||||||
|
fixture.node("#saved-playlists-tab").fire("click");
|
||||||
|
assert.equal(fixture.node("#folders-panel").hidden, true);
|
||||||
|
assert.equal(fixture.node("#saved-playlists-panel").hidden, false);
|
||||||
|
assert.equal(fixture.node("#saved-playlists-tab").attributes["aria-selected"], "true");
|
||||||
|
fixture.node("#saved-playlists-tab").fire("keydown", { key: "ArrowLeft" });
|
||||||
|
assert.equal(fixture.node("#folders-panel").hidden, false);
|
||||||
|
assert.deepEqual(fixture.commands, []);
|
||||||
|
});
|
||||||
|
|
||||||
|
test("plus and play address the saved playlist UUID and never use item-add/play", () => {
|
||||||
|
const fixture = new Fixture();
|
||||||
|
fixture.view.render([{ id: "saved-id", name: "Music", count: 2, duration: 120 }]);
|
||||||
|
const row = fixture.node("#saved-playlists").children[0];
|
||||||
|
row.fire("click");
|
||||||
|
assert.deepEqual(fixture.commands, []);
|
||||||
|
assert.ok(row.classes.has("selected"));
|
||||||
|
row.children[2].children[1].fire("click");
|
||||||
|
row.children[2].children[0].fire("click");
|
||||||
|
assert.deepEqual(fixture.commands, [
|
||||||
|
{ name: "playlist-open", data: { id: "saved-id" } },
|
||||||
|
{ name: "playlist-play", data: { id: "saved-id" } },
|
||||||
|
]);
|
||||||
|
assert.equal(fixture.node("#saved-playlists-empty").hidden, true);
|
||||||
|
});
|
||||||
|
|
||||||
|
test("unchanged summaries reuse rows while metadata and language changes refresh them", () => {
|
||||||
|
const fixture = new Fixture();
|
||||||
|
const playlists = [{ id: "one", name: "Music", count: 0, duration: 0 }];
|
||||||
|
fixture.view.render(playlists);
|
||||||
|
const row = fixture.node("#saved-playlists").children[0];
|
||||||
|
assert.equal(row.children[2].children[0].disabled, true);
|
||||||
|
assert.equal(row.children[2].children[1].disabled, false);
|
||||||
|
fixture.view.render(playlists);
|
||||||
|
assert.equal(fixture.node("#saved-playlists").children[0], row);
|
||||||
|
fixture.language = "nl";
|
||||||
|
fixture.view.render(playlists);
|
||||||
|
assert.notEqual(fixture.node("#saved-playlists").children[0], row);
|
||||||
|
fixture.view.render([{ ...playlists[0], name: "Renamed" }]);
|
||||||
|
assert.equal(fixture.node("#saved-playlists").children[0].children[1].textContent, "Renamed");
|
||||||
|
fixture.view.render([]);
|
||||||
|
assert.equal(fixture.node("#saved-playlists-empty").hidden, false);
|
||||||
|
});
|
||||||
|
|
||||||
|
test("keyboard opening does not intercept a nested action button", () => {
|
||||||
|
const fixture = new Fixture();
|
||||||
|
fixture.view.render([{ id: "one", name: "Music", count: 1, duration: 60 }]);
|
||||||
|
const row = fixture.node("#saved-playlists").children[0];
|
||||||
|
row.fire("keydown", { key: "Enter", target: row.children[2].children[0] });
|
||||||
|
assert.deepEqual(fixture.commands, []);
|
||||||
|
row.fire("keydown", { key: "Enter" });
|
||||||
|
assert.deepEqual(fixture.commands, [{ name: "playlist-open", data: { id: "one" } }]);
|
||||||
|
});
|
||||||
Reference in New Issue
Block a user