glenn
/
asteroid
mirror of https://github.com/glenneth1/asteroid.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

feat: move routes to use rate-limit macros

This commit is contained in:
Luis Pereira 2025-12-26 11:19:05 +00:00 committed by Brian O'Reilly
parent 8ae905a2c1
commit 6499c0a9ab
3 changed files with 90 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

169
asteroid.lisp
View File

@ -1128,16 +1128,16 @@
|# |#
;; Auth status API endpoint ;; 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" "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 () ()
@ -1199,66 +1199,66 @@
artists))))))) artists)))))))
;; Register page (GET) ;; Register page (GET)
(define-page register #@"/register" () (define-page-with-limit 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 ""))))
(define-page player #@"/player" () ;; Check if username already exists
(clip:process-to-string ((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") (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*
@ -1270,18 +1270,18 @@
:player-status "Stopped")) :player-status "Stopped"))
;; Player content frame (for frameset mode) ;; 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)" "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 popout-player #@"/popout-player" () (define-page-with-limit popout-player #@"/popout-player" (:limit-group "public")
"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)
@ -1289,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 about-page #@"/about" () (define-page-with-limit about-page #@"/about" (:limit-group "public")
"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 about-content #@"/about-content" () (define-page-with-limit about-content #@"/about-content" (:limit-group "public")
"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 status-content #@"/status-content" () (define-page-with-limit status-content #@"/status-content" (:limit-group "public")
"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 asteroid/status () () (define-api-with-limit asteroid/status () ()
"Get server status" "Get server status"
(api-output `(("status" . "running") (api-output `(("status" . "running")
("server" . "asteroid-radio") ("server" . "asteroid-radio")
@ -1323,23 +1323,23 @@
("stream-status" . "live")))) ("stream-status" . "live"))))
;; Live stream status from Icecast ;; Live stream status from Icecast
(define-api asteroid/icecast-status () () (define-api-with-limit 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))
@ -1360,12 +1360,13 @@
;;; Listener Statistics API Endpoints ;;; Listener Statistics API Endpoints
(define-api asteroid/stats/current () () (define-api-with-limit asteroid/stats/current () ()
"Get current listener count from recent snapshots" "Get current listener count from recent snapshots"
(let ((listeners (get-current-listeners))) (with-error-handling
(api-output `(("status" . "success") (let ((listeners (get-current-listeners)))
("listeners" . ,listeners) (api-output `(("status" . "success")
("timestamp" . ,(get-universal-time)))))) ("listeners" . ,listeners)
("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)"

2
auth-routes.lisp
View File

@ -4,7 +4,7 @@
(in-package :asteroid) (in-package :asteroid)
;; Login page (GET) ;; Login page (GET)
(define-page login #@"/login" () (define-page-with-limit 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")))

8
frontend-partials.lisp
View File

@ -75,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 asteroid/partial/now-playing (&optional mount) () (define-api-with-limit 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."
@ -105,7 +105,7 @@
:connection-error t :connection-error t
:stats nil)))))) :stats nil))))))
(define-api asteroid/partial/now-playing-inline (&optional mount) () (define-api-with-limit 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
@ -119,7 +119,7 @@
(setf (header "Content-Type") "text/plain") (setf (header "Content-Type") "text/plain")
"Stream Offline"))))) "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. "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
@ -137,7 +137,7 @@
("title" . "Stream Offline") ("title" . "Stream Offline")
("track_id" . nil))))))) ("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. "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