365 lines
15 KiB
Racket
365 lines
15 KiB
Racket
#lang racket/base
|
|
|
|
(require keystore
|
|
racket/contract
|
|
racket/file
|
|
racket/list
|
|
racket/path
|
|
uuid
|
|
"library.rkt")
|
|
|
|
(provide (struct-out persisted-tab)
|
|
open-playlist-store
|
|
close-playlist-store!
|
|
load-user-playlists
|
|
save-user-playlists!
|
|
load-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)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; 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)
|
|
(format "language-for-~a" username))
|
|
|
|
(define supported-language-names
|
|
'("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)
|
|
(hasheq 'file (path->string (track-file item))
|
|
'title (track-title item)
|
|
'artist (track-artist item)
|
|
'album (track-album item)
|
|
'duration (or (track-duration 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)
|
|
(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)
|
|
(if (not (hash? value))
|
|
#f
|
|
(let* ((file (hash-ref value 'file #f))
|
|
(title (hash-ref value 'title #f))
|
|
(artist (hash-ref value 'artist #f))
|
|
(album (hash-ref value 'album #f))
|
|
(duration (hash-ref value 'duration #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)
|
|
(string? title)
|
|
(string? artist)
|
|
(string? album)
|
|
valid-duration?
|
|
(optional-string? mime-type))))
|
|
(if (and valid-metadata?
|
|
(library-contains-audio-file? libraries file))
|
|
(track (path->complete-path file)
|
|
title artist album duration mime-type)
|
|
#f))))
|
|
|
|
;;; Validates and restores one tab while discarding invalid track entries.
|
|
(define (datum->tab id value libraries)
|
|
(if (not (and (uuid-string? id) (hash? value)))
|
|
#f
|
|
(let ((name (hash-ref value 'name #f))
|
|
(tracks (hash-ref value 'tracks #f)))
|
|
(if (and (string? name)
|
|
(not (string=? name ""))
|
|
(list? tracks))
|
|
(persisted-tab
|
|
id
|
|
name
|
|
(filter-map
|
|
(λ (item) (datum->track item libraries))
|
|
tracks))
|
|
#f))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; 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)))
|
|
(make-parent-directory* target)
|
|
(ks-open target))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; 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
|
|
(ks-with-lock store (λ () (ks-close store))))
|
|
(void))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; 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)
|
|
'()
|
|
(ks-with-lock
|
|
store
|
|
(λ ()
|
|
(let ((ids (ks-get store (user-playlists-key username saved?) '())))
|
|
(if (list? ids)
|
|
(filter-map
|
|
(λ (id)
|
|
(datum->tab id (ks-get store id #f) libraries))
|
|
(remove-duplicates (filter uuid-string? ids) string=?))
|
|
'()))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; 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
|
|
(ks-with-lock
|
|
store
|
|
(λ ()
|
|
(let* ((index-key (user-playlists-key username))
|
|
(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=?))
|
|
(not (member id saved-ids string=?))))
|
|
(remove-duplicates old-ids))))
|
|
(ks-transaction
|
|
store
|
|
(for-each (λ (id) (ks-drop! store id)) stale-ids)
|
|
(for-each
|
|
(λ (tab)
|
|
(ks-set!
|
|
store
|
|
(persisted-tab-id tab)
|
|
(hasheq 'name (persisted-tab-name tab)
|
|
'tracks (map track->datum
|
|
(persisted-tab-tracks tab)))))
|
|
all-tabs)
|
|
(ks-set! store index-key ids)
|
|
(ks-set! store saved-key saved-ids))
|
|
(void)))))
|
|
(void))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Load one user's persisted interface language.
|
|
; pre : Store is #f or an open playlist store; username is normalized.
|
|
; post : Store contents remain unchanged.
|
|
; 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/contract (load-user-language store username)
|
|
(-> (or/c keystore? #f) string? (or/c string? #f))
|
|
(if (eq? store #f)
|
|
#f
|
|
(ks-with-lock
|
|
store
|
|
(λ ()
|
|
(let ((value (ks-get store (user-language-key username) #f)))
|
|
(if (member value supported-language-names)
|
|
value
|
|
#f))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Persist one user's interface language.
|
|
; pre : Store is #f or open, username is normalized, and language is one of
|
|
; en, nl, de, fr, es, it, sv, no, fi, or is.
|
|
; post : The user's language key contains language when a store exists.
|
|
; 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/contract (save-user-language! store username language)
|
|
(-> (or/c keystore? #f) string? string? void?)
|
|
(unless (member language supported-language-names)
|
|
(raise-argument-error
|
|
'save-user-language!
|
|
"one of en, nl, de, fr, es, it, sv, no, fi, or is"
|
|
language))
|
|
(when store
|
|
(ks-with-lock
|
|
store
|
|
(λ ()
|
|
(ks-set! store (user-language-key username) language))))
|
|
(void))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Tests for module playlists.rkt
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(module+ test
|
|
(require rackunit
|
|
uuid/random)
|
|
|
|
(define root
|
|
(make-temporary-file "rkt-playlists-~a" 'directory))
|
|
(define music (build-path root "music"))
|
|
(define music-two (build-path root "music-two"))
|
|
(define outside (build-path root "outside.flac"))
|
|
(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
|
|
(λ ()
|
|
(make-directory music)
|
|
(make-directory music-two)
|
|
(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 outside void))
|
|
(λ ()
|
|
(let* ((libraries (make-music-libraries (list music music-two)))
|
|
(store (open-playlist-store store-file))
|
|
(first-id (uuid-string))
|
|
(second-id (uuid-string))
|
|
(item
|
|
(track (build-path music "one.flac")
|
|
"One" "Artist" "Album" 60 "audio/flac"))
|
|
(item-two
|
|
(track (build-path music-two "two.flac")
|
|
"Two" "Artist" "Album" 70 "audio/flac")))
|
|
(dynamic-wind
|
|
void
|
|
(λ ()
|
|
(save-user-playlists!
|
|
store
|
|
"hans"
|
|
(list (persisted-tab first-id "First" (list item item-two))
|
|
(persisted-tab second-id "Second" '())))
|
|
(save-user-playlists!
|
|
store
|
|
"local"
|
|
(list (persisted-tab (uuid-string) "Local" '())))
|
|
(let ((loaded (load-user-playlists store "hans" libraries)))
|
|
(check-equal? (ks-get store "playlists-for-hans")
|
|
(list first-id second-id))
|
|
(check-equal? (hash-ref (ks-get store 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?
|
|
(map track-title (persisted-tab-tracks (car loaded)))
|
|
'("One" "Two"))
|
|
(check-equal?
|
|
(map persisted-tab-name
|
|
(load-user-playlists store "local" libraries))
|
|
'("Local"))
|
|
(check-false (load-user-language store "hans"))
|
|
(save-user-language! store "hans" "fr")
|
|
(check-equal? (load-user-language store "hans") "fr")
|
|
(save-user-language! store "hans" "fi")
|
|
(check-equal? (load-user-language store "hans") "fi")
|
|
(check-exn exn:fail:contract?
|
|
(λ () (save-user-language! store "hans" "da")))
|
|
|
|
;; Rewriting the user's GUID index durably removes the omitted
|
|
;; playlist instead of leaving it orphaned.
|
|
(save-user-playlists!
|
|
store "hans"
|
|
(list (persisted-tab first-id "First" (list item item-two))))
|
|
(check-equal?
|
|
(map persisted-tab-id
|
|
(load-user-playlists store "hans" libraries))
|
|
(list first-id))
|
|
(check-false (ks-exists? store second-id))
|
|
(check-equal?
|
|
(map persisted-tab-name
|
|
(load-user-playlists store "local" libraries))
|
|
'("Local"))
|
|
|
|
;; A playlist may not restore tracks outside configured libraries.
|
|
(let ((unsafe-id (uuid-string)))
|
|
(ks-set!
|
|
store
|
|
unsafe-id
|
|
(hasheq
|
|
'name "Unsafe"
|
|
'tracks
|
|
(list (hasheq 'file (path->string outside)
|
|
'title "Outside" 'artist "" 'album ""
|
|
'duration #f 'mime-type "audio/flac"))))
|
|
(ks-set! store
|
|
(user-playlists-key "unsafe")
|
|
(list unsafe-id))
|
|
(check-equal?
|
|
(persisted-tab-tracks
|
|
(car (load-user-playlists store "unsafe" libraries)))
|
|
'()))))
|
|
(λ () (close-playlist-store! store)))))
|
|
(λ () (delete-directory/files root))))
|