Merge remote-tracking branch 'upstream/main' into glenneth/user-profile-enhancements

Prevents PostgreSQL errors when favorites API is called without
authentication. Functions now return early (nil or 0) instead of
generating invalid SQL with NIL in WHERE clause.

asteroid.asd

@@ -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")

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,7 +1131,7 @@
 |#
 
 ;; 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"))
@@ -1199,7 +1202,7 @@
                                           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"))
@@ -1257,7 +1260,7 @@
            :error-message ""
            :success-message ""))))
 
-(define-page player #@"/player" ()
+(define-page-with-limit player #@"/player" (:limit-group "public")
   (clip:process-to-string
    (load-template "player")
    :title "Asteroid Radio - Web Player"
@@ -1270,7 +1273,7 @@
    :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
    (load-template "player-content")
@@ -1279,7 +1282,7 @@
    :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
    (load-template "popout-player")
@@ -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
    (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
    (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
    (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,7 +1326,7 @@
                 ("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*))
@@ -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"
+  (with-error-handling
     (let ((listeners (get-current-listeners)))
       (api-output `(("status" . "success")
                     ("listeners" . ,listeners)
-                  ("timestamp" . ,(get-universal-time))))))
+                    ("timestamp" . ,(get-universal-time)))))))
 
 (define-api asteroid/stats/daily (&optional (days "30")) ()
   "Get daily listener statistics (admin only)"

auth-routes.lisp

@@ -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")))

frontend-partials.lisp

@@ -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))
+          ;; Parse 'Artist - Title' format if present
-                 (result (postmodern:query
+          (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 (:ilike 'title search-pattern))
+                          :where (:and (:ilike 'artist (format nil "%~a%" artist-part))
+                                       (:ilike 'title (format nil "%~a%" title-part))))
                          1)
-                          :single)))
+                        :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

limiter.lisp

@@ -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))))))

parenscript/front-page.lisp

@@ -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
+                              ;; 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)
                              (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)))))))))))
      

parenscript/stream-player.lisp

@@ -213,10 +213,15 @@
                     (ps:chain response (json))
                     nil)))
         (then (lambda (data)
-                (when (and data (ps:@ data data) (ps:@ data data favorites))
+                (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 (ps:@ data data favorites) 
+                            (ps:chain favorites (map (lambda (f) (ps:@ f title)))))
-                                  (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))
+           (let* ((track-title (ps:@ title-el text-content))
-                 (star-icon (ps:chain btn (query-selector ".star-icon"))))
+                  (star-icon (ps:chain btn (query-selector ".star-icon")))
-             (if (ps:chain *user-favorites-cache-mini* (includes title))
+                  (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
+                              ;; Reload cache to update favorite count (don't call update-mini-now-playing
-                              (load-favorites-cache-mini)
+                              ;; as it would check the old cache before reload completes)
-                              (update-mini-now-playing))))
+                              (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
+                              ;; Reload cache to update favorite count (don't call update-mini-now-playing
-                              (load-favorites-cache-mini)
+                              ;; as it would check the old cache before reload completes)
-                              (update-mini-now-playing))))
+                              (load-favorites-cache-mini))))
                     (catch (lambda (error)
                              (ps:chain console (error "Error adding favorite:" error)))))))))))
      

stream-media.lisp

@@ -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)))

template/error.ctml

@@ -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>

user-profile.lisp

@@ -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)
+                    ("favorites" . ,(or (mapcar (lambda (fav)
-                                              `(("id" . ,(cdr (assoc :_id fav)))
+                                                  `(("id" . ,(aget-profile "-ID" fav))
-                                                ("track_id" . ,(cdr (assoc :track-id fav)))
+                                                    ("track_id" . ,(aget-profile "TRACK-ID" fav))
-                                                ("title" . ,(or (cdr (assoc :track-title fav))
+                                                    ("title" . ,(aget-profile "TRACK-TITLE" fav))
-                                                                (cdr (assoc :track_title fav))))
+                                                    ("rating" . ,(aget-profile "RATING" fav))))
-                                                ("rating" . ,(cdr (assoc :rating fav)))))
+                                                favorites)
-                                            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) ()