hans/rkt-web-player
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

ok

Browse Source
This commit is contained in:
Hans Dijkema
2026-09-08 15:20:27 +02:00
parent 4b9e6c5651
commit 2eb9a9590e
15 changed files with 1023 additions and 127 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/player.rkt
+301 -59
View File
@@ -50,11 +50,13 @@
#:transparent)
(struct playlist-tab
(id [name #:mutable] [tracks #:mutable])
(id [name #:mutable] [tracks #:mutable] [snapshot #:auto #:mutable])
#:auto-value #f
#:transparent)
(struct playlist-context
([tabs #:mutable] [current-index #:mutable])
([tabs #:mutable] [current-index #:mutable] [saved #:auto #:mutable])
#:auto-value '()
#:transparent)
(struct playback-session
@@ -260,36 +262,45 @@
(list-ref (player-tabs value)
(player-current-tab-index value)))
;;; Invalidate the browser snapshot only when the immutable track list changes.
(define (save-current-tab! value)
(set-playlist-tab-tracks!
(current-tab value)
(player-tracks value)))
(let ((tab (current-tab value))
(tracks (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)
(let ((value (and (string? username)
(string-downcase (string-trim username)))))
(if (and value (not (string=? value ""))) value "anonymous")))
(define (new-playlist-context value username)
(define stored
(load-user-playlists (player-playlist-store value)
username
(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-tracks tab)))
(list (playlist-tab (uuid-string) "Default" '())))
0))
;;; Restore open tabs and the library using the same object for a shared UUID.
;;; Old stores have no saved index, so their tabs remain open and unsaved.
(define (restore-playlist-context store username libraries)
(let* ((restore (λ (tab) (playlist-tab (persisted-tab-id tab)
(persisted-tab-name tab)
(persisted-tab-tracks tab))))
(opened (map restore (load-user-playlists store username libraries)))
(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 normalized (normal-playlist-username username))
(hash-ref!
(player-playlist-contexts value)
normalized
(λ () (new-playlist-context value normalized))))
(λ () (restore-playlist-context (player-playlist-store value)
normalized (player-libraries value)))))
(define (context-tracks context)
(playlist-tab-tracks
@@ -361,7 +372,12 @@
(for/list ((tab (in-list (player-tabs value))))
(persisted-tab (playlist-tab-id 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)
(cond
@@ -927,25 +943,28 @@
trimmed)
(persist-playlists! value)))))
;;; Close a tab, retaining saved playlists in the user's library.
(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)
(< index (length (player-tabs value))))
(raise-arguments-error
'player-command!
"playlist tab does not exist"
"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)
(with-state-lock
value
(λ ()
(save-current-tab! value)
(let* ((tabs
(let* ((remaining
(append (take (player-tabs value) index)
(drop (player-tabs value) (+ index 1))))
(tabs (if (pair? remaining) remaining
(list (playlist-tab (uuid-string) "Default" '()))))
(new-index
(min (player-current-tab-index value)
(- (length tabs) 1))))
@@ -958,6 +977,44 @@
(set-playback-session-current-index! session #f)
(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)
(hasheq 'index index
'title (track-title item)
@@ -984,14 +1041,29 @@
'name (browser-entry-name entry)
'kind (symbol->string (browser-entry-kind entry))))
;;; Include the sum of known track durations in each tab's browser summary.
(define (tab->jsexpr tab index)
(hasheq 'index index
'id (playlist-tab-id tab)
'name (playlist-tab-name tab)
'count (length (playlist-tab-tracks tab))
'duration (apply + (map (λ (item) (or (track-duration item) 0))
(playlist-tab-tracks tab)))))
;;; 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
'id (playlist-tab-id tab)
'name (playlist-tab-name tab)
'saved saved?
'count (hash-ref snapshot 'count)
'duration (hash-ref snapshot 'duration))))
(define (normal-device-id device)
(let ((id (upnp-device-udn device)))
@@ -1121,7 +1193,12 @@
(rename-tab! value index
(or (json-string data 'name #f) "")))
((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)
(cond
@@ -1131,7 +1208,7 @@
((member command '("track-remove" "track-move"
"playlist-clear" "tab-add"
"tab-select" "tab-rename"
"tab-delete"))
"tab-delete" "playlist-save" "playlist-open" "playlist-play"))
(perform-playlist-command! value session command data))
((string=? command "play")
(play-index!
@@ -1278,23 +1355,15 @@
app-id))
(string-downcase app-id)))
(define store (open-playlist-store playlist-keystore))
(define stored-tabs
(load-user-playlists store "anonymous" libraries))
(let* ((library (and (pair? libraries) (car libraries)))
(browser-entries
(if library
(browse-library library '())
'()))
(tabs
(if (pair? stored-tabs)
(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" '()))))
(initial-context (restore-playlist-context store "anonymous" libraries))
(tabs (playlist-context-tabs initial-context))
(selected-index 0)
(contexts (make-hash))
(initial-context (playlist-context tabs selected-index)))
(contexts (make-hash)))
(hash-set! contexts "anonymous" initial-context)
(define value
(player libraries
@@ -1324,12 +1393,17 @@
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.
; 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))
(call-with-semaphore
(player-command-lock value)
@@ -1340,7 +1414,7 @@
(define context (playlist-context-for! value normalized))
(define tabs (playlist-context-tabs 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
value
(λ ()
@@ -1366,12 +1440,17 @@
'tabs
(for/list ((tab (in-list tabs))
(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
'playlistVersion (hash-ref snapshot 'version)
'tracks
(for/list ((item (in-list tracks))
(index (in-naturals)))
(track->jsexpr item index))
(if (equal? playlist-version (hash-ref snapshot 'version))
'null
(hash-ref snapshot 'tracks))
'renderers (map renderer->jsexpr
(player-renderers value))
'rendererId (or (playback-session-selected-id session) 'null)
@@ -1401,14 +1480,16 @@
; goal : Execute one browser player command.
; pre : Command is a string and data is a JSON object hash.
; 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
'("item-play" "item-add" "track-remove" "track-move"
"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))
(call-with-semaphore
(player-command-lock value)
@@ -1426,7 +1507,8 @@
(when (member command playlist-context-commands)
(activate-playlist-user! value normalized session))
(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.
@@ -1739,16 +1821,176 @@
(λ ()
(set-player-closed?! value #t)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests for module player.rkt
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module+ test
(require rackunit
(require json
rackunit
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
(make-temporary-file "rkt-web-player-~a" 'directory))
private/playlists.rkt
+31 -20
View File
@@ -30,9 +30,9 @@
;; Supporting functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Produces the keystore key containing one user's ordered playlist ids.
(define (user-playlists-key username)
(format "playlists-for-~a" username))
;;; 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)
@@ -135,7 +135,7 @@
(void))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Restore one user's ordered playlist tabs.
; 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.
@@ -144,17 +144,16 @@
; validates each referenced tab and delegates track safety checks to
; datum->track.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (load-user-playlists store username libraries)
(-> (or/c keystore? #f)
string?
(listof music-library?)
(listof persisted-tab?))
(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)
'()
(ks-with-lock
store
(λ ()
(let ((ids (ks-get store (user-playlists-key username) '())))
(let ((ids (ks-get store (user-playlists-key username saved?) '())))
(if (list? ids)
(filter-map
(λ (id)
@@ -163,29 +162,40 @@
'()))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Persist one user's complete ordered collection of playlist 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 : The UUID index and tab data match tabs; omitted old tabs are removed.
; 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
; every tab using track->datum, and atomically replaces the index.
; each distinct playlist using track->datum, and replaces both indexes.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (save-user-playlists! store username tabs)
(-> (or/c keystore? #f) string? (listof persisted-tab?) void?)
(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
(ks-with-lock
store
(λ ()
(let* ((index-key (user-playlists-key username))
(old-ids (ks-get store index-key '()))
(saved-key (user-playlists-key username #t))
(old-open (ks-get store index-key '()))
(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=?))))
(if (list? old-ids) old-ids '()))))
(not (member id ids string=?))
(not (member id saved-ids string=?))))
(remove-duplicates old-ids))))
(ks-transaction
store
(for-each (λ (id) (ks-drop! store id)) stale-ids)
@@ -197,8 +207,9 @@
(hasheq 'name (persisted-tab-name tab)
'tracks (map track->datum
(persisted-tab-tracks tab)))))
tabs)
(ks-set! store index-key ids))
all-tabs)
(ks-set! store index-key ids)
(ks-set! store saved-key saved-ids))
(void)))))
(void))
private/server.rkt
+37 -4
View File
@@ -101,12 +101,18 @@
(define (request-username auth request)
(or (auth-request-user auth request) "anonymous"))
;;; Returns the player state belonging to the requesting user.
;;; 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
(player-state->jsexpr
player
#:username (request-username auth request))))
#:username (request-username auth request)
#:playlist-version (request-playlist-version request))))
;;; Starts renderer discovery and returns the updated player state.
(define (discover-handler player auth request)
@@ -114,7 +120,8 @@
(json-response
(player-state->jsexpr
player
#:username (request-username auth request))))
#:username (request-username auth request)
#:playlist-version (request-playlist-version request))))
;;; Applies one player command for the requesting user.
(define (command-handler player auth request command)
@@ -125,7 +132,8 @@
player
command
(request-jsexpr request)
#:username (request-username auth request)))))
#:username (request-username auth request)
#:playlist-version (request-playlist-version request)))))
;;; Returns the persisted interface preferences for the requesting user.
(define (preferences-handler player auth request)
@@ -405,6 +413,31 @@
(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"