Compare commits
20 Commits
f5ff17b510
...
9a767a7550
| Author | SHA1 | Date |
|---|---|---|
|
|
9a767a7550 | |
|
|
820228bac1 | |
|
|
b32e0bdbb0 | |
|
|
6499c0a9ab | |
|
|
8ae905a2c1 | |
|
|
1a39e0c6d2 | |
|
|
753ff822ce | |
|
|
25a6341a7b | |
|
|
116d9ceebf | |
|
|
827d090a7e | |
|
|
c01d99da85 | |
|
|
20e5c37beb | |
|
|
01b00d448c | |
|
|
868b13af3d | |
|
|
7351d7f800 | |
|
|
62dde5e3cf | |
|
|
adce831a95 | |
|
|
00ec59014d | |
|
|
254106de75 | |
|
|
bfc33c8d4e |
|
|
@ -36,6 +36,7 @@
|
|||
:r-data-model
|
||||
(:interface :auth)
|
||||
(:interface :database)
|
||||
(:interface :rate)
|
||||
(:interface :user))
|
||||
:pathname "./"
|
||||
:components ((:file "app-utils")
|
||||
|
|
@ -43,6 +44,7 @@
|
|||
(:module :config
|
||||
:components ((:file radiance-postgres)))
|
||||
(:file "conditions")
|
||||
(:file "limiter")
|
||||
(:file "database")
|
||||
(:file "template-utils")
|
||||
(:file "parenscript-utils")
|
||||
|
|
|
|||
174
asteroid.lisp
174
asteroid.lisp
|
|
@ -39,7 +39,10 @@
|
|||
(define-api-format json (data)
|
||||
"JSON API format for Radiance"
|
||||
(setf (header "Content-Type") "application/json")
|
||||
(cl-json:encode-json-to-string data))
|
||||
(let ((status (gethash "status" data)))
|
||||
(when (and status (boundp '*response*))
|
||||
(setf (return-code *response*) status))
|
||||
(cl-json:encode-json-to-string data)))
|
||||
|
||||
;; Set JSON as the default API format
|
||||
(setf *default-api-format* "json")
|
||||
|
|
@ -1128,16 +1131,16 @@
|
|||
|#
|
||||
|
||||
;; Auth status API endpoint
|
||||
(define-api asteroid/auth-status () ()
|
||||
(define-api-with-limit asteroid/auth-status () ()
|
||||
"Check if user is logged in and their role"
|
||||
(with-error-handling
|
||||
(let* ((user-id (session:field "user-id"))
|
||||
(user (when user-id (find-user-by-id user-id))))
|
||||
(api-output `(("loggedIn" . ,(if user t nil))
|
||||
("isAdmin" . ,(if (and user (user-has-role-p user :admin)) t nil))
|
||||
("username" . ,(if user
|
||||
("username" . ,(if user
|
||||
(dm:field user "username")
|
||||
nil)))))))
|
||||
nil)))))))
|
||||
|
||||
;; User profile API endpoints
|
||||
(define-api asteroid/user/profile () ()
|
||||
|
|
@ -1199,66 +1202,66 @@
|
|||
artists)))))))
|
||||
|
||||
;; Register page (GET)
|
||||
(define-page register #@"/register" ()
|
||||
(define-page-with-limit register #@"/register" ()
|
||||
"User registration page"
|
||||
(let ((username (radiance:post-var "username"))
|
||||
(email (radiance:post-var "email"))
|
||||
(password (radiance:post-var "password"))
|
||||
(confirm-password (radiance:post-var "confirm-password")))
|
||||
(if (and username password)
|
||||
;; Handle registration form submission
|
||||
(cond
|
||||
;; Validate passwords match
|
||||
((not (string= password confirm-password))
|
||||
(format t "Failed to register new user '~a': passwords do not match.~%" username)
|
||||
(clip:process-to-string
|
||||
(load-template "register")
|
||||
:title "Asteroid Radio - Register"
|
||||
:display-error "display: block;"
|
||||
:display-success "display: none;"
|
||||
:error-message "Passwords do not match"
|
||||
:success-message ""))
|
||||
|
||||
;; Check if username already exists
|
||||
((find-user-by-username username)
|
||||
(format t "Failed to register new user '~a': Username already exists.~%" username)
|
||||
(clip:process-to-string
|
||||
(load-template "register")
|
||||
:title "Asteroid Radio - Register"
|
||||
:display-error "display: block;"
|
||||
:display-success "display: none;"
|
||||
:error-message "Username already exists"
|
||||
:success-message ""))
|
||||
|
||||
;; Create the user
|
||||
(t
|
||||
(if (create-user username email password :role :listener :active t)
|
||||
(progn
|
||||
;; Auto-login after successful registration
|
||||
(let ((user (find-user-by-username username)))
|
||||
(when user
|
||||
(let ((user-id (dm:id user)))
|
||||
(setf (session:field "user-id") user-id))))
|
||||
;; Redirect new users to their profile page
|
||||
(radiance:redirect "/asteroid/profile"))
|
||||
(clip:process-to-string
|
||||
(load-template "register")
|
||||
:title "Asteroid Radio - Register"
|
||||
:display-error "display: block;"
|
||||
:display-success "display: none;"
|
||||
:error-message "Registration failed. Please try again."
|
||||
:success-message ""))))
|
||||
;; Show registration form (no POST data)
|
||||
(clip:process-to-string
|
||||
(load-template "register")
|
||||
:title "Asteroid Radio - Register"
|
||||
:display-error "display: none;"
|
||||
:display-success "display: none;"
|
||||
:error-message ""
|
||||
:success-message ""))))
|
||||
(let ((username (radiance:post-var "username"))
|
||||
(email (radiance:post-var "email"))
|
||||
(password (radiance:post-var "password"))
|
||||
(confirm-password (radiance:post-var "confirm-password")))
|
||||
(if (and username password)
|
||||
;; Handle registration form submission
|
||||
(cond
|
||||
;; Validate passwords match
|
||||
((not (string= password confirm-password))
|
||||
(format t "Failed to register new user '~a': passwords do not match.~%" username)
|
||||
(clip:process-to-string
|
||||
(load-template "register")
|
||||
:title "Asteroid Radio - Register"
|
||||
:display-error "display: block;"
|
||||
:display-success "display: none;"
|
||||
:error-message "Passwords do not match"
|
||||
:success-message ""))
|
||||
|
||||
(define-page player #@"/player" ()
|
||||
(clip:process-to-string
|
||||
;; Check if username already exists
|
||||
((find-user-by-username username)
|
||||
(format t "Failed to register new user '~a': Username already exists.~%" username)
|
||||
(clip:process-to-string
|
||||
(load-template "register")
|
||||
:title "Asteroid Radio - Register"
|
||||
:display-error "display: block;"
|
||||
:display-success "display: none;"
|
||||
:error-message "Username already exists"
|
||||
:success-message ""))
|
||||
|
||||
;; Create the user
|
||||
(t
|
||||
(if (create-user username email password :role :listener :active t)
|
||||
(progn
|
||||
;; Auto-login after successful registration
|
||||
(let ((user (find-user-by-username username)))
|
||||
(when user
|
||||
(let ((user-id (dm:id user)))
|
||||
(setf (session:field "user-id") user-id))))
|
||||
;; Redirect new users to their profile page
|
||||
(radiance:redirect "/asteroid/profile"))
|
||||
(clip:process-to-string
|
||||
(load-template "register")
|
||||
:title "Asteroid Radio - Register"
|
||||
:display-error "display: block;"
|
||||
:display-success "display: none;"
|
||||
:error-message "Registration failed. Please try again."
|
||||
:success-message ""))))
|
||||
;; Show registration form (no POST data)
|
||||
(clip:process-to-string
|
||||
(load-template "register")
|
||||
:title "Asteroid Radio - Register"
|
||||
:display-error "display: none;"
|
||||
:display-success "display: none;"
|
||||
:error-message ""
|
||||
:success-message ""))))
|
||||
|
||||
(define-page-with-limit player #@"/player" (:limit-group "public")
|
||||
(clip:process-to-string
|
||||
(load-template "player")
|
||||
:title "Asteroid Radio - Web Player"
|
||||
:stream-base-url *stream-base-url*
|
||||
|
|
@ -1270,18 +1273,18 @@
|
|||
:player-status "Stopped"))
|
||||
|
||||
;; Player content frame (for frameset mode)
|
||||
(define-page player-content #@"/player-content" ()
|
||||
(define-page-with-limit player-content #@"/player-content" (:limit-group "public")
|
||||
"Player page content (displayed in content frame)"
|
||||
(clip:process-to-string
|
||||
(clip:process-to-string
|
||||
(load-template "player-content")
|
||||
:title "Asteroid Radio - Web Player"
|
||||
:stream-base-url *stream-base-url*
|
||||
:default-stream-url (format nil "~a/asteroid.aac" *stream-base-url*)
|
||||
:default-stream-encoding "audio/aac"))
|
||||
|
||||
(define-page popout-player #@"/popout-player" ()
|
||||
(define-page-with-limit popout-player #@"/popout-player" (:limit-group "public")
|
||||
"Pop-out player window"
|
||||
(clip:process-to-string
|
||||
(clip:process-to-string
|
||||
(load-template "popout-player")
|
||||
:stream-base-url *stream-base-url*
|
||||
:curated-channel-name (get-curated-channel-name)
|
||||
|
|
@ -1289,27 +1292,27 @@
|
|||
:default-stream-encoding "audio/aac"))
|
||||
|
||||
;; About page (non-frameset mode)
|
||||
(define-page about-page #@"/about" ()
|
||||
(define-page-with-limit about-page #@"/about" (:limit-group "public")
|
||||
"About Asteroid Radio"
|
||||
(clip:process-to-string
|
||||
(clip:process-to-string
|
||||
(load-template "about")
|
||||
:title "About - Asteroid Radio"))
|
||||
|
||||
;; About content (for frameset mode)
|
||||
(define-page about-content #@"/about-content" ()
|
||||
(define-page-with-limit about-content #@"/about-content" (:limit-group "public")
|
||||
"About page content (displayed in content frame)"
|
||||
(clip:process-to-string
|
||||
(clip:process-to-string
|
||||
(load-template "about-content")
|
||||
:title "About - Asteroid Radio"))
|
||||
|
||||
;; Status content (for frameset mode)
|
||||
(define-page status-content #@"/status-content" ()
|
||||
(define-page-with-limit status-content #@"/status-content" (:limit-group "public")
|
||||
"Status page content (displayed in content frame)"
|
||||
(clip:process-to-string
|
||||
(clip:process-to-string
|
||||
(load-template "status-content")
|
||||
:title "Status - Asteroid Radio"))
|
||||
|
||||
(define-api asteroid/status () ()
|
||||
(define-api-with-limit asteroid/status () ()
|
||||
"Get server status"
|
||||
(api-output `(("status" . "running")
|
||||
("server" . "asteroid-radio")
|
||||
|
|
@ -1323,23 +1326,23 @@
|
|||
("stream-status" . "live"))))
|
||||
|
||||
;; Live stream status from Icecast
|
||||
(define-api asteroid/icecast-status () ()
|
||||
(define-api-with-limit asteroid/icecast-status () ()
|
||||
"Get live status from Icecast server"
|
||||
(with-error-handling
|
||||
(let* ((icecast-url (format nil "~a/admin/stats.xml" *stream-base-url*))
|
||||
(response (drakma:http-request icecast-url
|
||||
:want-stream nil
|
||||
:basic-authorization '("admin" "asteroid_admin_2024"))))
|
||||
(response (drakma:http-request icecast-url
|
||||
:want-stream nil
|
||||
:basic-authorization '("admin" "asteroid_admin_2024"))))
|
||||
(if response
|
||||
(let ((xml-string (if (stringp response)
|
||||
response
|
||||
(let ((xml-string (if (stringp response)
|
||||
response
|
||||
(babel:octets-to-string response :encoding :utf-8))))
|
||||
;; Simple XML parsing to extract source information
|
||||
;; Look for <source mount="/asteroid.mp3"> sections and extract title, listeners, etc.
|
||||
(multiple-value-bind (match-start match-end)
|
||||
(cl-ppcre:scan "<source mount=\"/asteroid\\.mp3\">" xml-string)
|
||||
(if match-start
|
||||
(let* ((source-section (subseq xml-string match-start
|
||||
(let* ((source-section (subseq xml-string match-start
|
||||
(or (cl-ppcre:scan "</source>" xml-string :start match-start)
|
||||
(length xml-string))))
|
||||
(titlep (cl-ppcre:all-matches "<title>" source-section))
|
||||
|
|
@ -1360,12 +1363,13 @@
|
|||
|
||||
;;; Listener Statistics API Endpoints
|
||||
|
||||
(define-api asteroid/stats/current () ()
|
||||
(define-api-with-limit asteroid/stats/current () ()
|
||||
"Get current listener count from recent snapshots"
|
||||
(let ((listeners (get-current-listeners)))
|
||||
(api-output `(("status" . "success")
|
||||
("listeners" . ,listeners)
|
||||
("timestamp" . ,(get-universal-time))))))
|
||||
(with-error-handling
|
||||
(let ((listeners (get-current-listeners)))
|
||||
(api-output `(("status" . "success")
|
||||
("listeners" . ,listeners)
|
||||
("timestamp" . ,(get-universal-time)))))))
|
||||
|
||||
(define-api asteroid/stats/daily (&optional (days "30")) ()
|
||||
"Get daily listener statistics (admin only)"
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
(in-package :asteroid)
|
||||
|
||||
;; Login page (GET)
|
||||
(define-page login #@"/login" ()
|
||||
(define-page-with-limit login #@"/login" ()
|
||||
"User login page"
|
||||
(let ((username (radiance:post-var "username"))
|
||||
(password (radiance:post-var "password")))
|
||||
|
|
|
|||
|
|
@ -1,23 +1,39 @@
|
|||
(in-package :asteroid)
|
||||
|
||||
(defun find-track-by-title (title)
|
||||
"Find a track in the database by its title. Returns track ID or nil."
|
||||
"Find a track in the database by its title. Returns track ID or nil.
|
||||
Handles 'Artist - Title' format from Icecast metadata."
|
||||
(when (and title (not (string= title "Unknown")))
|
||||
(handler-case
|
||||
(with-db
|
||||
(let* ((search-pattern (format nil "%~a%" title))
|
||||
(result (postmodern:query
|
||||
(:limit
|
||||
(:select '_id
|
||||
:from 'tracks
|
||||
:where (:ilike 'title search-pattern))
|
||||
1)
|
||||
:single)))
|
||||
;; Parse 'Artist - Title' format if present
|
||||
(let* ((parts (cl-ppcre:split " - " title :limit 2))
|
||||
(has-artist (> (length parts) 1))
|
||||
(artist-part (when has-artist (first parts)))
|
||||
(title-part (if has-artist (second parts) title))
|
||||
(result
|
||||
(if has-artist
|
||||
;; Search by both artist and title
|
||||
(postmodern:query
|
||||
(:limit
|
||||
(:select '_id
|
||||
:from 'tracks
|
||||
:where (:and (:ilike 'artist (format nil "%~a%" artist-part))
|
||||
(:ilike 'title (format nil "%~a%" title-part))))
|
||||
1)
|
||||
:single)
|
||||
;; Fallback: search by title only
|
||||
(postmodern:query
|
||||
(:limit
|
||||
(:select '_id
|
||||
:from 'tracks
|
||||
:where (:ilike 'title (format nil "%~a%" title-part)))
|
||||
1)
|
||||
:single))))
|
||||
result))
|
||||
(error (e)
|
||||
(declare (ignore e))
|
||||
nil))))
|
||||
|
||||
(defun icecast-now-playing (icecast-base-url &optional (mount "asteroid.mp3"))
|
||||
"Fetch now-playing information from Icecast server.
|
||||
|
||||
|
|
@ -75,7 +91,7 @@
|
|||
(:listeners . ,total-listeners)
|
||||
(:track-id . ,(find-track-by-title title))))))))
|
||||
|
||||
(define-api asteroid/partial/now-playing (&optional mount) ()
|
||||
(define-api-with-limit asteroid/partial/now-playing (&optional mount) (:limit 3 :timeout 1)
|
||||
"Get Partial HTML with live status from Icecast server.
|
||||
Optional MOUNT parameter specifies which stream to get metadata from.
|
||||
Always polls both streams to keep recently played lists updated."
|
||||
|
|
@ -105,7 +121,7 @@
|
|||
:connection-error t
|
||||
:stats nil))))))
|
||||
|
||||
(define-api asteroid/partial/now-playing-inline (&optional mount) ()
|
||||
(define-api-with-limit asteroid/partial/now-playing-inline (&optional mount) (:limit 3 :timeout 1)
|
||||
"Get inline text with now playing info (for admin dashboard and widgets).
|
||||
Optional MOUNT parameter specifies which stream to get metadata from."
|
||||
(with-error-handling
|
||||
|
|
@ -119,7 +135,7 @@
|
|||
(setf (header "Content-Type") "text/plain")
|
||||
"Stream Offline")))))
|
||||
|
||||
(define-api asteroid/partial/now-playing-json (&optional mount) ()
|
||||
(define-api-with-limit asteroid/partial/now-playing-json (&optional mount) (:limit 2 :timeout 1)
|
||||
"Get JSON with now playing info including track ID for favorites.
|
||||
Optional MOUNT parameter specifies which stream to get metadata from."
|
||||
(with-error-handling
|
||||
|
|
@ -137,7 +153,7 @@
|
|||
("title" . "Stream Offline")
|
||||
("track_id" . nil)))))))
|
||||
|
||||
(define-api asteroid/channel-name () ()
|
||||
(define-api-with-limit asteroid/channel-name () (:limit 2 :timeout 1)
|
||||
"Get the current curated channel name for live updates.
|
||||
Returns JSON with the channel name from the current playlist's PHASE header."
|
||||
(with-error-handling
|
||||
|
|
|
|||
|
|
@ -0,0 +1,56 @@
|
|||
;;;; limiter.lisp - Rate limiter definitions for the application
|
||||
|
||||
(in-package :asteroid)
|
||||
|
||||
(defun render-rate-limit-error-page()
|
||||
(clip:process-to-string
|
||||
(load-template "error")
|
||||
:error-message "It seems that your acceleration has elevated your orbit out of your designated path."
|
||||
:error-action "Please wait a moment for it to stabilize and try your request again."))
|
||||
|
||||
(defun api-limit-error-output ()
|
||||
(api-output `(("status" . "error")
|
||||
("message" . "It seems that your acceleration has elevated your orbit out of your designated path."))
|
||||
:message "It seems that your acceleration has elevated your orbit out of your designated path."
|
||||
:status 429))
|
||||
|
||||
(defun extract-limit-options (options)
|
||||
"Extracts the rate-limit options and forwards the reamaining radiance route options"
|
||||
(let ((limit (getf options :limit))
|
||||
(timeout (getf options :timeout))
|
||||
(group (getf options :limit-group))
|
||||
(rest (loop for (k v) on options by #'cddr
|
||||
unless (member k '(:limit :timeout :limit-group))
|
||||
append (list k v))))
|
||||
(values limit timeout group rest)))
|
||||
|
||||
|
||||
(defmacro define-page-with-limit (name uri options &body body)
|
||||
"Rate limit for a page route. Defaults to 30 requests per minute."
|
||||
(multiple-value-bind (limit timeout group rest) (extract-limit-options options)
|
||||
(let* ((limit-name (string-upcase (format nil "~a-route-limit" (or group name))))
|
||||
(limit-sym (intern limit-name))
|
||||
(limit (or limit 30))
|
||||
(timeout (or timeout 60)))
|
||||
`(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(rate:define-limit ,limit-sym (time-left :limit ,limit :timeout ,timeout)
|
||||
;; (format t "Route limit '~a' hit. Wait ~a seconds and retry.~%" ,(string name) time-left)
|
||||
(render-rate-limit-error-page))
|
||||
(define-page ,name ,uri ,rest
|
||||
(rate:with-limitation (,limit-sym)
|
||||
,@body))))))
|
||||
|
||||
(defmacro define-api-with-limit (name args options &body body)
|
||||
"Rate limit for api routes. Defaults to 60 requests per minute."
|
||||
(multiple-value-bind (limit timeout group rest) (extract-limit-options options)
|
||||
(let* ((limit-name (string-upcase (format nil "~a-api-limit" (or group name))))
|
||||
(limit-sym (intern limit-name))
|
||||
(limit (or limit 60))
|
||||
(timeout (or timeout 60)))
|
||||
`(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(rate:define-limit ,limit-sym (time-left :limit ,limit :timeout ,timeout)
|
||||
;; (format t "API Rate limit '~a' hit. Wait ~a seconds and retry.~%" ,(string name) time-left)
|
||||
(api-limit-error-output))
|
||||
(define-api ,name ,args ,rest
|
||||
(rate:with-limitation (,limit-sym)
|
||||
,@body))))))
|
||||
|
|
@ -183,7 +183,9 @@
|
|||
(when (and data (ps:@ data data) (ps:@ data data favorites))
|
||||
(setf *user-favorites-cache*
|
||||
(ps:chain (ps:@ data data favorites)
|
||||
(map (lambda (f) (ps:@ f title))))))))
|
||||
(map (lambda (f) (ps:@ f title)))))
|
||||
;; Update UI after cache is loaded
|
||||
(check-favorite-status))))
|
||||
(catch (lambda (error) nil))))
|
||||
|
||||
;; Check if current track is in favorites and update UI
|
||||
|
|
@ -699,8 +701,9 @@
|
|||
(= (ps:@ data data status) "success")))
|
||||
(ps:chain btn class-list (remove "favorited"))
|
||||
(setf (ps:@ (ps:chain btn (query-selector ".star-icon")) text-content) "☆")
|
||||
;; Refresh now playing to update favorite count
|
||||
(update-now-playing))))
|
||||
;; Reload cache (don't call update-now-playing as it would
|
||||
;; check the old cache before reload completes)
|
||||
(load-favorites-cache))))
|
||||
(catch (lambda (error)
|
||||
(ps:chain console (error "Error removing favorite:" error)))))
|
||||
;; Add favorite
|
||||
|
|
@ -718,7 +721,9 @@
|
|||
(= (ps:@ data data status) "success")))
|
||||
(ps:chain btn class-list (add "favorited"))
|
||||
(setf (ps:@ (ps:chain btn (query-selector ".star-icon")) text-content) "★")
|
||||
(update-now-playing))))
|
||||
;; Reload cache (don't call update-now-playing as it would
|
||||
;; check the old cache before reload completes)
|
||||
(load-favorites-cache))))
|
||||
(catch (lambda (error)
|
||||
(ps:chain console (error "Error adding favorite:" error)))))))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -213,10 +213,15 @@
|
|||
(ps:chain response (json))
|
||||
nil)))
|
||||
(then (lambda (data)
|
||||
(when (and data (ps:@ data data) (ps:@ data data favorites))
|
||||
(setf *user-favorites-cache-mini*
|
||||
(ps:chain (ps:@ data data favorites)
|
||||
(map (lambda (f) (ps:@ f title))))))))
|
||||
(when data
|
||||
;; Handle both wrapped (data.data.favorites) and unwrapped (data.favorites) responses
|
||||
(let ((favorites (or (and (ps:@ data data) (ps:@ data data favorites))
|
||||
(ps:@ data favorites))))
|
||||
(when favorites
|
||||
(setf *user-favorites-cache-mini*
|
||||
(ps:chain favorites (map (lambda (f) (ps:@ f title)))))
|
||||
;; Update UI after cache is loaded
|
||||
(check-favorite-status-mini))))))
|
||||
(catch (lambda (error) nil))))
|
||||
|
||||
;; Check if current track is in favorites and update mini player UI
|
||||
|
|
@ -224,9 +229,10 @@
|
|||
(let ((title-el (ps:chain document (get-element-by-id "mini-now-playing")))
|
||||
(btn (ps:chain document (get-element-by-id "favorite-btn-mini"))))
|
||||
(when (and title-el btn)
|
||||
(let ((title (ps:@ title-el text-content))
|
||||
(star-icon (ps:chain btn (query-selector ".star-icon"))))
|
||||
(if (ps:chain *user-favorites-cache-mini* (includes title))
|
||||
(let* ((track-title (ps:@ title-el text-content))
|
||||
(star-icon (ps:chain btn (query-selector ".star-icon")))
|
||||
(is-in-cache (ps:chain *user-favorites-cache-mini* (includes track-title))))
|
||||
(if is-in-cache
|
||||
(progn
|
||||
(ps:chain btn class-list (add "favorited"))
|
||||
(when star-icon (setf (ps:@ star-icon text-content) "★")))
|
||||
|
|
@ -310,9 +316,9 @@
|
|||
(= (ps:@ data data status) "success")))
|
||||
(ps:chain btn class-list (remove "favorited"))
|
||||
(setf (ps:@ (ps:chain btn (query-selector ".star-icon")) text-content) "☆")
|
||||
;; Reload cache and refresh display to update favorite count
|
||||
(load-favorites-cache-mini)
|
||||
(update-mini-now-playing))))
|
||||
;; Reload cache to update favorite count (don't call update-mini-now-playing
|
||||
;; as it would check the old cache before reload completes)
|
||||
(load-favorites-cache-mini))))
|
||||
(catch (lambda (error)
|
||||
(ps:chain console (error "Error removing favorite:" error)))))
|
||||
;; Add favorite
|
||||
|
|
@ -330,9 +336,9 @@
|
|||
(= (ps:@ data data status) "success")))
|
||||
(ps:chain btn class-list (add "favorited"))
|
||||
(setf (ps:@ (ps:chain btn (query-selector ".star-icon")) text-content) "★")
|
||||
;; Reload cache and refresh display to update favorite count
|
||||
(load-favorites-cache-mini)
|
||||
(update-mini-now-playing))))
|
||||
;; Reload cache to update favorite count (don't call update-mini-now-playing
|
||||
;; as it would check the old cache before reload completes)
|
||||
(load-favorites-cache-mini))))
|
||||
(catch (lambda (error)
|
||||
(ps:chain console (error "Error adding favorite:" error)))))))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -135,6 +135,7 @@
|
|||
;; Simple file copy endpoint for manual uploads
|
||||
(define-page copy-files #@"/admin/copy-files" ()
|
||||
"Copy files from incoming directory to library"
|
||||
(require-role :admin)
|
||||
(handler-case
|
||||
(let ((incoming-dir (merge-pathnames "music/incoming/"
|
||||
(asdf:system-source-directory :asteroid)))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,57 @@
|
|||
<!DOCTYPE html>
|
||||
<html lang="en">
|
||||
<head>
|
||||
<title>Error - Asteroid Radio</title>
|
||||
<meta charset="utf-8">
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1">
|
||||
<link rel="icon" type="image/x-icon" href="/asteroid/static/favicon.ico">
|
||||
<link rel="icon" type="image/png" sizes="32x32" href="/asteroid/static/favicon-32x32.png">
|
||||
<link rel="icon" type="image/png" sizes="16x16" href="/asteroid/static/favicon-16x16.png">
|
||||
<link rel="stylesheet" type="text/css" href="/asteroid/static/asteroid.css">
|
||||
</head>
|
||||
<body>
|
||||
<div class="container">
|
||||
<header>
|
||||
<h1 style="display: flex; align-items: center; justify-content: center; gap: 15px;">
|
||||
<img src="/asteroid/static/asteroid.png" alt="Asteroid" style="height: 50px; width: auto;">
|
||||
<span>ASTEROID RADIO</span>
|
||||
<img src="/asteroid/static/asteroid.png" alt="Asteroid" style="height: 50px; width: auto;">
|
||||
</h1>
|
||||
<nav class="nav">
|
||||
<a href="/asteroid/">Home</a>
|
||||
<a href="/asteroid/player">Player</a>
|
||||
<a href="/asteroid/about">About</a>
|
||||
</nav>
|
||||
</header>
|
||||
<main style="max-width: 800px; margin: 0 auto; padding: 20px;">
|
||||
<section style="margin-bottom: 30px;">
|
||||
<h2 style="color: #00ff00; border-bottom: 2px solid #00ff00; padding-bottom: 10px;">
|
||||
<c:if test="error-title">
|
||||
<c:then>
|
||||
<c:splice lquery="(text error-title)"></c:splice>
|
||||
</c:then>
|
||||
<c:else>
|
||||
⚠️ Something went wrong with your request!
|
||||
</c:else>
|
||||
</c:if>
|
||||
</h2>
|
||||
<p style="line-height: 1.6; font-size: 1.2rem;">
|
||||
<c:if test="error-message">
|
||||
<c:then>
|
||||
<c:splice lquery="(text error-message)"></c:splice>
|
||||
</c:then>
|
||||
<c:else>
|
||||
We seem to be unable to process your request right now.
|
||||
</c:else>
|
||||
</c:if>
|
||||
</p>
|
||||
<c:if test="error-action">
|
||||
<c:then>
|
||||
<p style="line-height: 1.6; font-size: 1.2rem;" lquery="(text error-action)"></p>
|
||||
</c:then>
|
||||
</c:if>
|
||||
</section>
|
||||
</main>
|
||||
</div>
|
||||
</body>
|
||||
</html>
|
||||
|
|
@ -10,6 +10,8 @@
|
|||
(defun add-favorite (user-id track-id &optional (rating 1) track-title)
|
||||
"Add a track to user's favorites with optional rating (1-5).
|
||||
If track-id is nil but track-title is provided, stores by title."
|
||||
(when (null user-id)
|
||||
(return-from add-favorite nil))
|
||||
(let ((rating-val (max 1 (min 5 (or rating 1)))))
|
||||
(with-db
|
||||
(if track-id
|
||||
|
|
@ -26,6 +28,8 @@
|
|||
|
||||
(defun remove-favorite (user-id track-id &optional track-title)
|
||||
"Remove a track from user's favorites by track-id or title"
|
||||
(when (null user-id)
|
||||
(return-from remove-favorite nil))
|
||||
(with-db
|
||||
(if track-id
|
||||
(postmodern:query
|
||||
|
|
@ -38,6 +42,8 @@
|
|||
|
||||
(defun update-favorite-rating (user-id track-id rating)
|
||||
"Update the rating for a favorited track"
|
||||
(when (null user-id)
|
||||
(return-from update-favorite-rating nil))
|
||||
(let ((rating-val (max 1 (min 5 rating))))
|
||||
(with-db
|
||||
(postmodern:query
|
||||
|
|
@ -48,6 +54,8 @@
|
|||
|
||||
(defun get-user-favorites (user-id &key (limit 50) (offset 0))
|
||||
"Get user's favorite tracks - works with both track-id and title-based favorites"
|
||||
(when (null user-id)
|
||||
(return-from get-user-favorites nil))
|
||||
(with-db
|
||||
(postmodern:query
|
||||
(:raw (format nil "SELECT _id, rating, \"created-date\", track_title, \"track-id\" FROM user_favorites WHERE \"user-id\" = ~a ORDER BY \"created-date\" DESC LIMIT ~a OFFSET ~a"
|
||||
|
|
@ -56,6 +64,8 @@
|
|||
|
||||
(defun is-track-favorited (user-id track-id)
|
||||
"Check if a track is in user's favorites, returns rating or nil"
|
||||
(when (null user-id)
|
||||
(return-from is-track-favorited nil))
|
||||
(with-db
|
||||
(postmodern:query
|
||||
(:raw (format nil "SELECT rating FROM user_favorites WHERE \"user-id\" = ~a AND \"track-id\" = ~a"
|
||||
|
|
@ -64,6 +74,8 @@
|
|||
|
||||
(defun get-favorites-count (user-id)
|
||||
"Get total count of user's favorites"
|
||||
(when (null user-id)
|
||||
(return-from get-favorites-count 0))
|
||||
(with-db
|
||||
(postmodern:query
|
||||
(:raw (format nil "SELECT COUNT(*) FROM user_favorites WHERE \"user-id\" = ~a" user-id))
|
||||
|
|
@ -161,6 +173,10 @@
|
|||
;;; API Endpoints for User Favorites
|
||||
;;; ==========================================================================
|
||||
|
||||
(defun aget-profile (key alist)
|
||||
"Get value from alist using string-equal comparison for key (Postmodern returns uppercase keys)"
|
||||
(cdr (assoc key alist :test (lambda (a b) (string-equal (string a) (string b))))))
|
||||
|
||||
(define-api asteroid/user/favorites () ()
|
||||
"Get current user's favorite tracks"
|
||||
(require-authentication)
|
||||
|
|
@ -168,13 +184,13 @@
|
|||
(let* ((user-id (session:field "user-id"))
|
||||
(favorites (get-user-favorites user-id)))
|
||||
(api-output `(("status" . "success")
|
||||
("favorites" . ,(mapcar (lambda (fav)
|
||||
`(("id" . ,(cdr (assoc :_id fav)))
|
||||
("track_id" . ,(cdr (assoc :track-id fav)))
|
||||
("title" . ,(or (cdr (assoc :track-title fav))
|
||||
(cdr (assoc :track_title fav))))
|
||||
("rating" . ,(cdr (assoc :rating fav)))))
|
||||
favorites))
|
||||
("favorites" . ,(or (mapcar (lambda (fav)
|
||||
`(("id" . ,(aget-profile "-ID" fav))
|
||||
("track_id" . ,(aget-profile "TRACK-ID" fav))
|
||||
("title" . ,(aget-profile "TRACK-TITLE" fav))
|
||||
("rating" . ,(aget-profile "RATING" fav))))
|
||||
favorites)
|
||||
(list))) ; Return empty list instead of null
|
||||
("count" . ,(get-favorites-count user-id)))))))
|
||||
|
||||
(define-api asteroid/user/favorites/add (&optional track-id rating title) ()
|
||||
|
|
|
|||
Loading…
Reference in New Issue