refactoring
This commit is contained in:
+253
-156
@@ -1,6 +1,7 @@
|
||||
#lang racket/base
|
||||
|
||||
(require keystore
|
||||
racket/contract
|
||||
racket/file
|
||||
racket/list
|
||||
racket/path
|
||||
@@ -15,18 +16,32 @@
|
||||
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)
|
||||
(struct playlist-store (keystore lock) #:transparent)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Supporting functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; Produces the keystore key containing one user's ordered playlist ids.
|
||||
(define (user-playlists-key username)
|
||||
(format "playlists-for-~a" 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)
|
||||
@@ -35,111 +50,177 @@
|
||||
'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 (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)
|
||||
(and (hash? value)
|
||||
(let ((file (hash-ref value 'file #f))
|
||||
(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)))
|
||||
(and (path-string? file)
|
||||
(string? title)
|
||||
(string? artist)
|
||||
(string? album)
|
||||
(or (not duration)
|
||||
(and (number? duration) (not (negative? duration))))
|
||||
(optional-string? mime-type)
|
||||
(library-contains-audio-file? libraries file)
|
||||
(track (path->complete-path file)
|
||||
title artist album duration mime-type)))))
|
||||
(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)
|
||||
(and (uuid-string? id)
|
||||
(hash? value)
|
||||
(let ((name (hash-ref value 'name #f))
|
||||
(tracks (hash-ref value 'tracks #f)))
|
||||
(and (string? name)
|
||||
(not (string=? name ""))
|
||||
(list? tracks)
|
||||
(persisted-tab
|
||||
id
|
||||
name
|
||||
(filter-map
|
||||
(λ (item) (datum->track item libraries))
|
||||
tracks))))))
|
||||
(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))))
|
||||
|
||||
(define (open-playlist-store file)
|
||||
(and file
|
||||
(let ((target (path->complete-path file)))
|
||||
(make-parent-directory* target)
|
||||
(playlist-store (ks-open target) (make-semaphore 1)))))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Provided functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (close-playlist-store! store)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; 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
|
||||
(call-with-semaphore
|
||||
(playlist-store-lock store)
|
||||
(λ () (ks-close (playlist-store-keystore store)))))
|
||||
(ks-with-lock store (λ () (ks-close store))))
|
||||
(void))
|
||||
|
||||
(define (load-user-playlists store username libraries)
|
||||
(if (not store)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Restore one user's ordered playlist tabs.
|
||||
; 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)
|
||||
(-> (or/c keystore? #f)
|
||||
string?
|
||||
(listof music-library?)
|
||||
(listof persisted-tab?))
|
||||
(if (eq? store #f)
|
||||
'()
|
||||
(call-with-semaphore
|
||||
(playlist-store-lock store)
|
||||
(ks-with-lock
|
||||
store
|
||||
(λ ()
|
||||
(define ks (playlist-store-keystore store))
|
||||
(define ids (ks-get ks (user-playlists-key username) '()))
|
||||
(if (list? ids)
|
||||
(filter-map
|
||||
(λ (id)
|
||||
(datum->tab id (ks-get ks id #f) libraries))
|
||||
(remove-duplicates (filter uuid-string? ids) string=?))
|
||||
'())))))
|
||||
(let ((ids (ks-get store (user-playlists-key username) '())))
|
||||
(if (list? ids)
|
||||
(filter-map
|
||||
(λ (id)
|
||||
(datum->tab id (ks-get store id #f) libraries))
|
||||
(remove-duplicates (filter uuid-string? ids) string=?))
|
||||
'()))))))
|
||||
|
||||
(define (save-user-playlists! store username tabs)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Persist one user's complete ordered collection of playlist tabs.
|
||||
; 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.
|
||||
; 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.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define/contract (save-user-playlists! store username tabs)
|
||||
(-> (or/c keystore? #f) string? (listof persisted-tab?) void?)
|
||||
(when store
|
||||
(call-with-semaphore
|
||||
(playlist-store-lock store)
|
||||
(ks-with-lock
|
||||
store
|
||||
(λ ()
|
||||
(define ks (playlist-store-keystore store))
|
||||
(define index-key (user-playlists-key username))
|
||||
(define old-ids (ks-get ks index-key '()))
|
||||
(define ids (map persisted-tab-id tabs))
|
||||
(ks-transaction
|
||||
ks
|
||||
(for ((id (in-list (if (list? old-ids) old-ids '())))
|
||||
#:when (and (string? id) (not (member id ids string=?))))
|
||||
(ks-drop! ks id))
|
||||
(for ((tab (in-list tabs)))
|
||||
(ks-set!
|
||||
ks
|
||||
(persisted-tab-id tab)
|
||||
(hasheq 'name (persisted-tab-name tab)
|
||||
'tracks (map track->datum
|
||||
(persisted-tab-tracks tab)))))
|
||||
(ks-set! ks index-key ids))
|
||||
(void)))))
|
||||
(let* ((index-key (user-playlists-key username))
|
||||
(old-ids (ks-get store index-key '()))
|
||||
(ids (map persisted-tab-id tabs))
|
||||
(stale-ids
|
||||
(filter
|
||||
(λ (id)
|
||||
(and (string? id)
|
||||
(not (member id ids string=?))))
|
||||
(if (list? old-ids) 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)))))
|
||||
tabs)
|
||||
(ks-set! store index-key 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 (load-user-language store username)
|
||||
(and store
|
||||
(call-with-semaphore
|
||||
(playlist-store-lock store)
|
||||
(λ ()
|
||||
(define value
|
||||
(ks-get (playlist-store-keystore store)
|
||||
(user-language-key username)
|
||||
#f))
|
||||
(and (member value supported-language-names) value)))))
|
||||
(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.
|
||||
@@ -147,22 +228,27 @@
|
||||
; 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 (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)
|
||||
(raise-argument-error
|
||||
'save-user-language!
|
||||
"one of en, nl, de, fr, es, it, sv, no, fi, or is"
|
||||
language))
|
||||
(when store
|
||||
(call-with-semaphore
|
||||
(playlist-store-lock store)
|
||||
(ks-with-lock
|
||||
store
|
||||
(λ ()
|
||||
(ks-set! (playlist-store-keystore store)
|
||||
(user-language-key username)
|
||||
language))))
|
||||
(ks-set! store (user-language-key username) language))))
|
||||
(void))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Tests for module playlists.rkt
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(module+ test
|
||||
(require rackunit
|
||||
uuid/random)
|
||||
@@ -173,6 +259,11 @@
|
||||
(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)
|
||||
@@ -181,76 +272,82 @@
|
||||
(call-with-output-file (build-path music-two "two.flac") void)
|
||||
(call-with-output-file outside void))
|
||||
(λ ()
|
||||
(define libraries (make-music-libraries (list music music-two)))
|
||||
(define store (open-playlist-store store-file))
|
||||
(define first-id (uuid-string))
|
||||
(define second-id (uuid-string))
|
||||
(define item
|
||||
(track (build-path music "one.flac")
|
||||
"One" "Artist" "Album" 60 "audio/flac"))
|
||||
(define item-two
|
||||
(track (build-path music-two "two.flac")
|
||||
"Two" "Artist" "Album" 70 "audio/flac"))
|
||||
(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* ((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")))
|
||||
|
||||
(define loaded (load-user-playlists store "hans" libraries))
|
||||
(define ks (playlist-store-keystore store))
|
||||
(check-equal? (ks-get ks "playlists-for-hans")
|
||||
(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? (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"))
|
||||
|
||||
;; Rewriting the user's GUID index durably removes the omitted playlist.
|
||||
(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? ks second-id))
|
||||
;; An omitted GUID is deleted rather than becoming orphaned.
|
||||
(check-equal?
|
||||
(map persisted-tab-name (load-user-playlists store "local" libraries))
|
||||
'("Local"))
|
||||
|
||||
;; A playlist entry may not restore tracks outside configured libraries.
|
||||
(define unsafe-id (uuid-string))
|
||||
(ks-set!
|
||||
(playlist-store-keystore 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! (playlist-store-keystore store)
|
||||
(user-playlists-key "unsafe")
|
||||
(list unsafe-id))
|
||||
(check-equal?
|
||||
(persisted-tab-tracks
|
||||
(car (load-user-playlists store "unsafe" libraries)))
|
||||
'())
|
||||
(close-playlist-store! store))
|
||||
;; 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))))
|
||||
|
||||
Reference in New Issue
Block a user