Compare commits
No commits in common. "9a767a7550bfab96c0c9c787963e5495253369b2" and "f5ff17b510530d4722d48e04229a6e971b9ceaac" have entirely different histories.
9a767a7550
...
f5ff17b510
|
|
@ -36,7 +36,6 @@
|
||||||
:r-data-model
|
:r-data-model
|
||||||
(:interface :auth)
|
(:interface :auth)
|
||||||
(:interface :database)
|
(:interface :database)
|
||||||
(:interface :rate)
|
|
||||||
(:interface :user))
|
(:interface :user))
|
||||||
:pathname "./"
|
:pathname "./"
|
||||||
:components ((:file "app-utils")
|
:components ((:file "app-utils")
|
||||||
|
|
@ -44,7 +43,6 @@
|
||||||
(:module :config
|
(:module :config
|
||||||
:components ((:file radiance-postgres)))
|
:components ((:file radiance-postgres)))
|
||||||
(:file "conditions")
|
(:file "conditions")
|
||||||
(:file "limiter")
|
|
||||||
(:file "database")
|
(:file "database")
|
||||||
(:file "template-utils")
|
(:file "template-utils")
|
||||||
(:file "parenscript-utils")
|
(:file "parenscript-utils")
|
||||||
|
|
|
||||||
174
asteroid.lisp
174
asteroid.lisp
|
|
@ -39,10 +39,7 @@
|
||||||
(define-api-format json (data)
|
(define-api-format json (data)
|
||||||
"JSON API format for Radiance"
|
"JSON API format for Radiance"
|
||||||
(setf (header "Content-Type") "application/json")
|
(setf (header "Content-Type") "application/json")
|
||||||
(let ((status (gethash "status" data)))
|
(cl-json:encode-json-to-string 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
|
;; Set JSON as the default API format
|
||||||
(setf *default-api-format* "json")
|
(setf *default-api-format* "json")
|
||||||
|
|
@ -1131,16 +1128,16 @@
|
||||||
|#
|
|#
|
||||||
|
|
||||||
;; Auth status API endpoint
|
;; Auth status API endpoint
|
||||||
(define-api-with-limit asteroid/auth-status () ()
|
(define-api asteroid/auth-status () ()
|
||||||
"Check if user is logged in and their role"
|
"Check if user is logged in and their role"
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
(let* ((user-id (session:field "user-id"))
|
(let* ((user-id (session:field "user-id"))
|
||||||
(user (when user-id (find-user-by-id user-id))))
|
(user (when user-id (find-user-by-id user-id))))
|
||||||
(api-output `(("loggedIn" . ,(if user t nil))
|
(api-output `(("loggedIn" . ,(if user t nil))
|
||||||
("isAdmin" . ,(if (and user (user-has-role-p user :admin)) t nil))
|
("isAdmin" . ,(if (and user (user-has-role-p user :admin)) t nil))
|
||||||
("username" . ,(if user
|
("username" . ,(if user
|
||||||
(dm:field user "username")
|
(dm:field user "username")
|
||||||
nil)))))))
|
nil)))))))
|
||||||
|
|
||||||
;; User profile API endpoints
|
;; User profile API endpoints
|
||||||
(define-api asteroid/user/profile () ()
|
(define-api asteroid/user/profile () ()
|
||||||
|
|
@ -1202,66 +1199,66 @@
|
||||||
artists)))))))
|
artists)))))))
|
||||||
|
|
||||||
;; Register page (GET)
|
;; Register page (GET)
|
||||||
(define-page-with-limit register #@"/register" ()
|
(define-page register #@"/register" ()
|
||||||
"User registration page"
|
"User registration page"
|
||||||
(let ((username (radiance:post-var "username"))
|
(let ((username (radiance:post-var "username"))
|
||||||
(email (radiance:post-var "email"))
|
(email (radiance:post-var "email"))
|
||||||
(password (radiance:post-var "password"))
|
(password (radiance:post-var "password"))
|
||||||
(confirm-password (radiance:post-var "confirm-password")))
|
(confirm-password (radiance:post-var "confirm-password")))
|
||||||
(if (and username password)
|
(if (and username password)
|
||||||
;; Handle registration form submission
|
;; Handle registration form submission
|
||||||
(cond
|
(cond
|
||||||
;; Validate passwords match
|
;; Validate passwords match
|
||||||
((not (string= password confirm-password))
|
((not (string= password confirm-password))
|
||||||
(format t "Failed to register new user '~a': passwords do not match.~%" username)
|
(format t "Failed to register new user '~a': passwords do not match.~%" username)
|
||||||
(clip:process-to-string
|
(clip:process-to-string
|
||||||
(load-template "register")
|
(load-template "register")
|
||||||
:title "Asteroid Radio - Register"
|
:title "Asteroid Radio - Register"
|
||||||
:display-error "display: block;"
|
:display-error "display: block;"
|
||||||
:display-success "display: none;"
|
:display-success "display: none;"
|
||||||
:error-message "Passwords do not match"
|
:error-message "Passwords do not match"
|
||||||
:success-message ""))
|
: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 ""))))
|
||||||
|
|
||||||
;; Check if username already exists
|
(define-page player #@"/player" ()
|
||||||
((find-user-by-username username)
|
(clip:process-to-string
|
||||||
(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")
|
(load-template "player")
|
||||||
:title "Asteroid Radio - Web Player"
|
:title "Asteroid Radio - Web Player"
|
||||||
:stream-base-url *stream-base-url*
|
:stream-base-url *stream-base-url*
|
||||||
|
|
@ -1273,18 +1270,18 @@
|
||||||
:player-status "Stopped"))
|
:player-status "Stopped"))
|
||||||
|
|
||||||
;; Player content frame (for frameset mode)
|
;; Player content frame (for frameset mode)
|
||||||
(define-page-with-limit player-content #@"/player-content" (:limit-group "public")
|
(define-page player-content #@"/player-content" ()
|
||||||
"Player page content (displayed in content frame)"
|
"Player page content (displayed in content frame)"
|
||||||
(clip:process-to-string
|
(clip:process-to-string
|
||||||
(load-template "player-content")
|
(load-template "player-content")
|
||||||
:title "Asteroid Radio - Web Player"
|
:title "Asteroid Radio - Web Player"
|
||||||
:stream-base-url *stream-base-url*
|
:stream-base-url *stream-base-url*
|
||||||
:default-stream-url (format nil "~a/asteroid.aac" *stream-base-url*)
|
:default-stream-url (format nil "~a/asteroid.aac" *stream-base-url*)
|
||||||
:default-stream-encoding "audio/aac"))
|
:default-stream-encoding "audio/aac"))
|
||||||
|
|
||||||
(define-page-with-limit popout-player #@"/popout-player" (:limit-group "public")
|
(define-page popout-player #@"/popout-player" ()
|
||||||
"Pop-out player window"
|
"Pop-out player window"
|
||||||
(clip:process-to-string
|
(clip:process-to-string
|
||||||
(load-template "popout-player")
|
(load-template "popout-player")
|
||||||
:stream-base-url *stream-base-url*
|
:stream-base-url *stream-base-url*
|
||||||
:curated-channel-name (get-curated-channel-name)
|
:curated-channel-name (get-curated-channel-name)
|
||||||
|
|
@ -1292,27 +1289,27 @@
|
||||||
:default-stream-encoding "audio/aac"))
|
:default-stream-encoding "audio/aac"))
|
||||||
|
|
||||||
;; About page (non-frameset mode)
|
;; About page (non-frameset mode)
|
||||||
(define-page-with-limit about-page #@"/about" (:limit-group "public")
|
(define-page about-page #@"/about" ()
|
||||||
"About Asteroid Radio"
|
"About Asteroid Radio"
|
||||||
(clip:process-to-string
|
(clip:process-to-string
|
||||||
(load-template "about")
|
(load-template "about")
|
||||||
:title "About - Asteroid Radio"))
|
:title "About - Asteroid Radio"))
|
||||||
|
|
||||||
;; About content (for frameset mode)
|
;; About content (for frameset mode)
|
||||||
(define-page-with-limit about-content #@"/about-content" (:limit-group "public")
|
(define-page about-content #@"/about-content" ()
|
||||||
"About page content (displayed in content frame)"
|
"About page content (displayed in content frame)"
|
||||||
(clip:process-to-string
|
(clip:process-to-string
|
||||||
(load-template "about-content")
|
(load-template "about-content")
|
||||||
:title "About - Asteroid Radio"))
|
:title "About - Asteroid Radio"))
|
||||||
|
|
||||||
;; Status content (for frameset mode)
|
;; Status content (for frameset mode)
|
||||||
(define-page-with-limit status-content #@"/status-content" (:limit-group "public")
|
(define-page status-content #@"/status-content" ()
|
||||||
"Status page content (displayed in content frame)"
|
"Status page content (displayed in content frame)"
|
||||||
(clip:process-to-string
|
(clip:process-to-string
|
||||||
(load-template "status-content")
|
(load-template "status-content")
|
||||||
:title "Status - Asteroid Radio"))
|
:title "Status - Asteroid Radio"))
|
||||||
|
|
||||||
(define-api-with-limit asteroid/status () ()
|
(define-api asteroid/status () ()
|
||||||
"Get server status"
|
"Get server status"
|
||||||
(api-output `(("status" . "running")
|
(api-output `(("status" . "running")
|
||||||
("server" . "asteroid-radio")
|
("server" . "asteroid-radio")
|
||||||
|
|
@ -1326,23 +1323,23 @@
|
||||||
("stream-status" . "live"))))
|
("stream-status" . "live"))))
|
||||||
|
|
||||||
;; Live stream status from Icecast
|
;; Live stream status from Icecast
|
||||||
(define-api-with-limit asteroid/icecast-status () ()
|
(define-api asteroid/icecast-status () ()
|
||||||
"Get live status from Icecast server"
|
"Get live status from Icecast server"
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
(let* ((icecast-url (format nil "~a/admin/stats.xml" *stream-base-url*))
|
(let* ((icecast-url (format nil "~a/admin/stats.xml" *stream-base-url*))
|
||||||
(response (drakma:http-request icecast-url
|
(response (drakma:http-request icecast-url
|
||||||
:want-stream nil
|
:want-stream nil
|
||||||
:basic-authorization '("admin" "asteroid_admin_2024"))))
|
:basic-authorization '("admin" "asteroid_admin_2024"))))
|
||||||
(if response
|
(if response
|
||||||
(let ((xml-string (if (stringp response)
|
(let ((xml-string (if (stringp response)
|
||||||
response
|
response
|
||||||
(babel:octets-to-string response :encoding :utf-8))))
|
(babel:octets-to-string response :encoding :utf-8))))
|
||||||
;; Simple XML parsing to extract source information
|
;; Simple XML parsing to extract source information
|
||||||
;; Look for <source mount="/asteroid.mp3"> sections and extract title, listeners, etc.
|
;; Look for <source mount="/asteroid.mp3"> sections and extract title, listeners, etc.
|
||||||
(multiple-value-bind (match-start match-end)
|
(multiple-value-bind (match-start match-end)
|
||||||
(cl-ppcre:scan "<source mount=\"/asteroid\\.mp3\">" xml-string)
|
(cl-ppcre:scan "<source mount=\"/asteroid\\.mp3\">" xml-string)
|
||||||
(if match-start
|
(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)
|
(or (cl-ppcre:scan "</source>" xml-string :start match-start)
|
||||||
(length xml-string))))
|
(length xml-string))))
|
||||||
(titlep (cl-ppcre:all-matches "<title>" source-section))
|
(titlep (cl-ppcre:all-matches "<title>" source-section))
|
||||||
|
|
@ -1363,13 +1360,12 @@
|
||||||
|
|
||||||
;;; Listener Statistics API Endpoints
|
;;; Listener Statistics API Endpoints
|
||||||
|
|
||||||
(define-api-with-limit asteroid/stats/current () ()
|
(define-api asteroid/stats/current () ()
|
||||||
"Get current listener count from recent snapshots"
|
"Get current listener count from recent snapshots"
|
||||||
(with-error-handling
|
(let ((listeners (get-current-listeners)))
|
||||||
(let ((listeners (get-current-listeners)))
|
(api-output `(("status" . "success")
|
||||||
(api-output `(("status" . "success")
|
("listeners" . ,listeners)
|
||||||
("listeners" . ,listeners)
|
("timestamp" . ,(get-universal-time))))))
|
||||||
("timestamp" . ,(get-universal-time)))))))
|
|
||||||
|
|
||||||
(define-api asteroid/stats/daily (&optional (days "30")) ()
|
(define-api asteroid/stats/daily (&optional (days "30")) ()
|
||||||
"Get daily listener statistics (admin only)"
|
"Get daily listener statistics (admin only)"
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,7 @@
|
||||||
(in-package :asteroid)
|
(in-package :asteroid)
|
||||||
|
|
||||||
;; Login page (GET)
|
;; Login page (GET)
|
||||||
(define-page-with-limit login #@"/login" ()
|
(define-page login #@"/login" ()
|
||||||
"User login page"
|
"User login page"
|
||||||
(let ((username (radiance:post-var "username"))
|
(let ((username (radiance:post-var "username"))
|
||||||
(password (radiance:post-var "password")))
|
(password (radiance:post-var "password")))
|
||||||
|
|
|
||||||
|
|
@ -1,39 +1,23 @@
|
||||||
(in-package :asteroid)
|
(in-package :asteroid)
|
||||||
|
|
||||||
(defun find-track-by-title (title)
|
(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")))
|
(when (and title (not (string= title "Unknown")))
|
||||||
(handler-case
|
(handler-case
|
||||||
(with-db
|
(with-db
|
||||||
;; Parse 'Artist - Title' format if present
|
(let* ((search-pattern (format nil "%~a%" title))
|
||||||
(let* ((parts (cl-ppcre:split " - " title :limit 2))
|
(result (postmodern:query
|
||||||
(has-artist (> (length parts) 1))
|
(:limit
|
||||||
(artist-part (when has-artist (first parts)))
|
(:select '_id
|
||||||
(title-part (if has-artist (second parts) title))
|
:from 'tracks
|
||||||
(result
|
:where (:ilike 'title search-pattern))
|
||||||
(if has-artist
|
1)
|
||||||
;; Search by both artist and title
|
:single)))
|
||||||
(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))
|
result))
|
||||||
(error (e)
|
(error (e)
|
||||||
(declare (ignore e))
|
(declare (ignore e))
|
||||||
nil))))
|
nil))))
|
||||||
|
|
||||||
(defun icecast-now-playing (icecast-base-url &optional (mount "asteroid.mp3"))
|
(defun icecast-now-playing (icecast-base-url &optional (mount "asteroid.mp3"))
|
||||||
"Fetch now-playing information from Icecast server.
|
"Fetch now-playing information from Icecast server.
|
||||||
|
|
||||||
|
|
@ -91,7 +75,7 @@
|
||||||
(:listeners . ,total-listeners)
|
(:listeners . ,total-listeners)
|
||||||
(:track-id . ,(find-track-by-title title))))))))
|
(:track-id . ,(find-track-by-title title))))))))
|
||||||
|
|
||||||
(define-api-with-limit asteroid/partial/now-playing (&optional mount) (:limit 3 :timeout 1)
|
(define-api asteroid/partial/now-playing (&optional mount) ()
|
||||||
"Get Partial HTML with live status from Icecast server.
|
"Get Partial HTML with live status from Icecast server.
|
||||||
Optional MOUNT parameter specifies which stream to get metadata from.
|
Optional MOUNT parameter specifies which stream to get metadata from.
|
||||||
Always polls both streams to keep recently played lists updated."
|
Always polls both streams to keep recently played lists updated."
|
||||||
|
|
@ -121,7 +105,7 @@
|
||||||
:connection-error t
|
:connection-error t
|
||||||
:stats nil))))))
|
:stats nil))))))
|
||||||
|
|
||||||
(define-api-with-limit asteroid/partial/now-playing-inline (&optional mount) (:limit 3 :timeout 1)
|
(define-api asteroid/partial/now-playing-inline (&optional mount) ()
|
||||||
"Get inline text with now playing info (for admin dashboard and widgets).
|
"Get inline text with now playing info (for admin dashboard and widgets).
|
||||||
Optional MOUNT parameter specifies which stream to get metadata from."
|
Optional MOUNT parameter specifies which stream to get metadata from."
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
|
|
@ -135,7 +119,7 @@
|
||||||
(setf (header "Content-Type") "text/plain")
|
(setf (header "Content-Type") "text/plain")
|
||||||
"Stream Offline")))))
|
"Stream Offline")))))
|
||||||
|
|
||||||
(define-api-with-limit asteroid/partial/now-playing-json (&optional mount) (:limit 2 :timeout 1)
|
(define-api asteroid/partial/now-playing-json (&optional mount) ()
|
||||||
"Get JSON with now playing info including track ID for favorites.
|
"Get JSON with now playing info including track ID for favorites.
|
||||||
Optional MOUNT parameter specifies which stream to get metadata from."
|
Optional MOUNT parameter specifies which stream to get metadata from."
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
|
|
@ -153,7 +137,7 @@
|
||||||
("title" . "Stream Offline")
|
("title" . "Stream Offline")
|
||||||
("track_id" . nil)))))))
|
("track_id" . nil)))))))
|
||||||
|
|
||||||
(define-api-with-limit asteroid/channel-name () (:limit 2 :timeout 1)
|
(define-api asteroid/channel-name () ()
|
||||||
"Get the current curated channel name for live updates.
|
"Get the current curated channel name for live updates.
|
||||||
Returns JSON with the channel name from the current playlist's PHASE header."
|
Returns JSON with the channel name from the current playlist's PHASE header."
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
|
|
|
||||||
56
limiter.lisp
56
limiter.lisp
|
|
@ -1,56 +0,0 @@
|
||||||
;;;; 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,9 +183,7 @@
|
||||||
(when (and data (ps:@ data data) (ps:@ data data favorites))
|
(when (and data (ps:@ data data) (ps:@ data data favorites))
|
||||||
(setf *user-favorites-cache*
|
(setf *user-favorites-cache*
|
||||||
(ps:chain (ps:@ data data favorites)
|
(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))))
|
(catch (lambda (error) nil))))
|
||||||
|
|
||||||
;; Check if current track is in favorites and update UI
|
;; Check if current track is in favorites and update UI
|
||||||
|
|
@ -701,9 +699,8 @@
|
||||||
(= (ps:@ data data status) "success")))
|
(= (ps:@ data data status) "success")))
|
||||||
(ps:chain btn class-list (remove "favorited"))
|
(ps:chain btn class-list (remove "favorited"))
|
||||||
(setf (ps:@ (ps:chain btn (query-selector ".star-icon")) text-content) "☆")
|
(setf (ps:@ (ps:chain btn (query-selector ".star-icon")) text-content) "☆")
|
||||||
;; Reload cache (don't call update-now-playing as it would
|
;; Refresh now playing to update favorite count
|
||||||
;; check the old cache before reload completes)
|
(update-now-playing))))
|
||||||
(load-favorites-cache))))
|
|
||||||
(catch (lambda (error)
|
(catch (lambda (error)
|
||||||
(ps:chain console (error "Error removing favorite:" error)))))
|
(ps:chain console (error "Error removing favorite:" error)))))
|
||||||
;; Add favorite
|
;; Add favorite
|
||||||
|
|
@ -721,9 +718,7 @@
|
||||||
(= (ps:@ data data status) "success")))
|
(= (ps:@ data data status) "success")))
|
||||||
(ps:chain btn class-list (add "favorited"))
|
(ps:chain btn class-list (add "favorited"))
|
||||||
(setf (ps:@ (ps:chain btn (query-selector ".star-icon")) text-content) "★")
|
(setf (ps:@ (ps:chain btn (query-selector ".star-icon")) text-content) "★")
|
||||||
;; Reload cache (don't call update-now-playing as it would
|
(update-now-playing))))
|
||||||
;; check the old cache before reload completes)
|
|
||||||
(load-favorites-cache))))
|
|
||||||
(catch (lambda (error)
|
(catch (lambda (error)
|
||||||
(ps:chain console (error "Error adding favorite:" error)))))))))))
|
(ps:chain console (error "Error adding favorite:" error)))))))))))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -213,15 +213,10 @@
|
||||||
(ps:chain response (json))
|
(ps:chain response (json))
|
||||||
nil)))
|
nil)))
|
||||||
(then (lambda (data)
|
(then (lambda (data)
|
||||||
(when data
|
(when (and data (ps:@ data data) (ps:@ data data favorites))
|
||||||
;; Handle both wrapped (data.data.favorites) and unwrapped (data.favorites) responses
|
(setf *user-favorites-cache-mini*
|
||||||
(let ((favorites (or (and (ps:@ data data) (ps:@ data data favorites))
|
(ps:chain (ps:@ data data favorites)
|
||||||
(ps:@ data favorites))))
|
(map (lambda (f) (ps:@ f title))))))))
|
||||||
(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))))
|
(catch (lambda (error) nil))))
|
||||||
|
|
||||||
;; Check if current track is in favorites and update mini player UI
|
;; Check if current track is in favorites and update mini player UI
|
||||||
|
|
@ -229,10 +224,9 @@
|
||||||
(let ((title-el (ps:chain document (get-element-by-id "mini-now-playing")))
|
(let ((title-el (ps:chain document (get-element-by-id "mini-now-playing")))
|
||||||
(btn (ps:chain document (get-element-by-id "favorite-btn-mini"))))
|
(btn (ps:chain document (get-element-by-id "favorite-btn-mini"))))
|
||||||
(when (and title-el btn)
|
(when (and title-el btn)
|
||||||
(let* ((track-title (ps:@ title-el text-content))
|
(let ((title (ps:@ title-el text-content))
|
||||||
(star-icon (ps:chain btn (query-selector ".star-icon")))
|
(star-icon (ps:chain btn (query-selector ".star-icon"))))
|
||||||
(is-in-cache (ps:chain *user-favorites-cache-mini* (includes track-title))))
|
(if (ps:chain *user-favorites-cache-mini* (includes title))
|
||||||
(if is-in-cache
|
|
||||||
(progn
|
(progn
|
||||||
(ps:chain btn class-list (add "favorited"))
|
(ps:chain btn class-list (add "favorited"))
|
||||||
(when star-icon (setf (ps:@ star-icon text-content) "★")))
|
(when star-icon (setf (ps:@ star-icon text-content) "★")))
|
||||||
|
|
@ -316,9 +310,9 @@
|
||||||
(= (ps:@ data data status) "success")))
|
(= (ps:@ data data status) "success")))
|
||||||
(ps:chain btn class-list (remove "favorited"))
|
(ps:chain btn class-list (remove "favorited"))
|
||||||
(setf (ps:@ (ps:chain btn (query-selector ".star-icon")) text-content) "☆")
|
(setf (ps:@ (ps:chain btn (query-selector ".star-icon")) text-content) "☆")
|
||||||
;; Reload cache to update favorite count (don't call update-mini-now-playing
|
;; Reload cache and refresh display to update favorite count
|
||||||
;; as it would check the old cache before reload completes)
|
(load-favorites-cache-mini)
|
||||||
(load-favorites-cache-mini))))
|
(update-mini-now-playing))))
|
||||||
(catch (lambda (error)
|
(catch (lambda (error)
|
||||||
(ps:chain console (error "Error removing favorite:" error)))))
|
(ps:chain console (error "Error removing favorite:" error)))))
|
||||||
;; Add favorite
|
;; Add favorite
|
||||||
|
|
@ -336,9 +330,9 @@
|
||||||
(= (ps:@ data data status) "success")))
|
(= (ps:@ data data status) "success")))
|
||||||
(ps:chain btn class-list (add "favorited"))
|
(ps:chain btn class-list (add "favorited"))
|
||||||
(setf (ps:@ (ps:chain btn (query-selector ".star-icon")) text-content) "★")
|
(setf (ps:@ (ps:chain btn (query-selector ".star-icon")) text-content) "★")
|
||||||
;; Reload cache to update favorite count (don't call update-mini-now-playing
|
;; Reload cache and refresh display to update favorite count
|
||||||
;; as it would check the old cache before reload completes)
|
(load-favorites-cache-mini)
|
||||||
(load-favorites-cache-mini))))
|
(update-mini-now-playing))))
|
||||||
(catch (lambda (error)
|
(catch (lambda (error)
|
||||||
(ps:chain console (error "Error adding favorite:" error)))))))))))
|
(ps:chain console (error "Error adding favorite:" error)))))))))))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -135,7 +135,6 @@
|
||||||
;; Simple file copy endpoint for manual uploads
|
;; Simple file copy endpoint for manual uploads
|
||||||
(define-page copy-files #@"/admin/copy-files" ()
|
(define-page copy-files #@"/admin/copy-files" ()
|
||||||
"Copy files from incoming directory to library"
|
"Copy files from incoming directory to library"
|
||||||
(require-role :admin)
|
|
||||||
(handler-case
|
(handler-case
|
||||||
(let ((incoming-dir (merge-pathnames "music/incoming/"
|
(let ((incoming-dir (merge-pathnames "music/incoming/"
|
||||||
(asdf:system-source-directory :asteroid)))
|
(asdf:system-source-directory :asteroid)))
|
||||||
|
|
|
||||||
|
|
@ -1,57 +0,0 @@
|
||||||
<!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,8 +10,6 @@
|
||||||
(defun add-favorite (user-id track-id &optional (rating 1) track-title)
|
(defun add-favorite (user-id track-id &optional (rating 1) track-title)
|
||||||
"Add a track to user's favorites with optional rating (1-5).
|
"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."
|
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)))))
|
(let ((rating-val (max 1 (min 5 (or rating 1)))))
|
||||||
(with-db
|
(with-db
|
||||||
(if track-id
|
(if track-id
|
||||||
|
|
@ -28,8 +26,6 @@
|
||||||
|
|
||||||
(defun remove-favorite (user-id track-id &optional track-title)
|
(defun remove-favorite (user-id track-id &optional track-title)
|
||||||
"Remove a track from user's favorites by track-id or title"
|
"Remove a track from user's favorites by track-id or title"
|
||||||
(when (null user-id)
|
|
||||||
(return-from remove-favorite nil))
|
|
||||||
(with-db
|
(with-db
|
||||||
(if track-id
|
(if track-id
|
||||||
(postmodern:query
|
(postmodern:query
|
||||||
|
|
@ -42,8 +38,6 @@
|
||||||
|
|
||||||
(defun update-favorite-rating (user-id track-id rating)
|
(defun update-favorite-rating (user-id track-id rating)
|
||||||
"Update the rating for a favorited track"
|
"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))))
|
(let ((rating-val (max 1 (min 5 rating))))
|
||||||
(with-db
|
(with-db
|
||||||
(postmodern:query
|
(postmodern:query
|
||||||
|
|
@ -54,8 +48,6 @@
|
||||||
|
|
||||||
(defun get-user-favorites (user-id &key (limit 50) (offset 0))
|
(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"
|
"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
|
(with-db
|
||||||
(postmodern:query
|
(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"
|
(: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"
|
||||||
|
|
@ -64,8 +56,6 @@
|
||||||
|
|
||||||
(defun is-track-favorited (user-id track-id)
|
(defun is-track-favorited (user-id track-id)
|
||||||
"Check if a track is in user's favorites, returns rating or nil"
|
"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
|
(with-db
|
||||||
(postmodern:query
|
(postmodern:query
|
||||||
(:raw (format nil "SELECT rating FROM user_favorites WHERE \"user-id\" = ~a AND \"track-id\" = ~a"
|
(:raw (format nil "SELECT rating FROM user_favorites WHERE \"user-id\" = ~a AND \"track-id\" = ~a"
|
||||||
|
|
@ -74,8 +64,6 @@
|
||||||
|
|
||||||
(defun get-favorites-count (user-id)
|
(defun get-favorites-count (user-id)
|
||||||
"Get total count of user's favorites"
|
"Get total count of user's favorites"
|
||||||
(when (null user-id)
|
|
||||||
(return-from get-favorites-count 0))
|
|
||||||
(with-db
|
(with-db
|
||||||
(postmodern:query
|
(postmodern:query
|
||||||
(:raw (format nil "SELECT COUNT(*) FROM user_favorites WHERE \"user-id\" = ~a" user-id))
|
(:raw (format nil "SELECT COUNT(*) FROM user_favorites WHERE \"user-id\" = ~a" user-id))
|
||||||
|
|
@ -173,10 +161,6 @@
|
||||||
;;; API Endpoints for User Favorites
|
;;; 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 () ()
|
(define-api asteroid/user/favorites () ()
|
||||||
"Get current user's favorite tracks"
|
"Get current user's favorite tracks"
|
||||||
(require-authentication)
|
(require-authentication)
|
||||||
|
|
@ -184,13 +168,13 @@
|
||||||
(let* ((user-id (session:field "user-id"))
|
(let* ((user-id (session:field "user-id"))
|
||||||
(favorites (get-user-favorites user-id)))
|
(favorites (get-user-favorites user-id)))
|
||||||
(api-output `(("status" . "success")
|
(api-output `(("status" . "success")
|
||||||
("favorites" . ,(or (mapcar (lambda (fav)
|
("favorites" . ,(mapcar (lambda (fav)
|
||||||
`(("id" . ,(aget-profile "-ID" fav))
|
`(("id" . ,(cdr (assoc :_id fav)))
|
||||||
("track_id" . ,(aget-profile "TRACK-ID" fav))
|
("track_id" . ,(cdr (assoc :track-id fav)))
|
||||||
("title" . ,(aget-profile "TRACK-TITLE" fav))
|
("title" . ,(or (cdr (assoc :track-title fav))
|
||||||
("rating" . ,(aget-profile "RATING" fav))))
|
(cdr (assoc :track_title fav))))
|
||||||
favorites)
|
("rating" . ,(cdr (assoc :rating fav)))))
|
||||||
(list))) ; Return empty list instead of null
|
favorites))
|
||||||
("count" . ,(get-favorites-count user-id)))))))
|
("count" . ,(get-favorites-count user-id)))))))
|
||||||
|
|
||||||
(define-api asteroid/user/favorites/add (&optional track-id rating title) ()
|
(define-api asteroid/user/favorites/add (&optional track-id rating title) ()
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue