Merge remote-tracking branch 'upstream/main' into glenneth/user-profile-enhancements
This commit is contained in:
glenneth
commit
9a767a7550
|
|
@ -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")
|
||||
|
|
|
|||
148
asteroid.lisp
148
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"))
|
||||
|
|
@ -1137,7 +1140,7 @@
|
|||
("isAdmin" . ,(if (and user (user-has-role-p user :admin)) t nil))
|
||||
("username" . ,(if user
|
||||
(dm:field user "username")
|
||||
nil)))))))
|
||||
nil)))))))
|
||||
|
||||
;; User profile API endpoints
|
||||
(define-api asteroid/user/profile () ()
|
||||
|
|
@ -1199,65 +1202,65 @@
|
|||
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 ""))
|
||||
(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 ""))
|
||||
;; 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 ""))))
|
||||
;; 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 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,13 +1326,13 @@
|
|||
("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"))))
|
||||
:want-stream nil
|
||||
:basic-authorization '("admin" "asteroid_admin_2024"))))
|
||||
(if response
|
||||
(let ((xml-string (if (stringp response)
|
||||
response
|
||||
|
|
@ -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")))
|
||||
|
|
|
|||
|
|
@ -91,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."
|
||||
|
|
@ -121,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
|
||||
|
|
@ -135,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
|
||||
|
|
@ -153,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))))))
|
||||
|
|
@ -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>
|
||||
Loading…
Reference in New Issue