Compare commits

..

No commits in common. "820228bac1dacdc27f627d5b0c9bbcab8686c9cd" and "c01d99da853b5e542fb052c39b0a4de1aa3360c5" have entirely different histories.

8 changed files with 92 additions and 212 deletions

View File

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

View File

@ -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,7 +1128,7 @@
|# |#
;; 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"))
@ -1202,7 +1199,7 @@
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"))
@ -1260,7 +1257,7 @@
:error-message "" :error-message ""
:success-message "")))) :success-message ""))))
(define-page-with-limit player #@"/player" (:limit-group "public") (define-page player #@"/player" ()
(clip:process-to-string (clip:process-to-string
(load-template "player") (load-template "player")
:title "Asteroid Radio - Web Player" :title "Asteroid Radio - Web Player"
@ -1273,7 +1270,7 @@
: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")
@ -1282,7 +1279,7 @@
: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")
@ -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,7 +1323,7 @@
("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*))
@ -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)"

View File

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

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-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."
@ -105,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
@ -119,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
@ -137,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

View File

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

View File

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

View File

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

View File

@ -111,11 +111,11 @@
(:raw (format nil "INSERT INTO listening_history (\"user-id\", \"track-id\", track_title, \"listen-duration\", completed) VALUES (~a, ~a, ~a, ~a, ~a)" (:raw (format nil "INSERT INTO listening_history (\"user-id\", \"track-id\", track_title, \"listen-duration\", completed) VALUES (~a, ~a, ~a, ~a, ~a)"
user-id track-id user-id track-id
(if track-title (format nil "'~a'" (sql-escape-string track-title)) "NULL") (if track-title (format nil "'~a'" (sql-escape-string track-title)) "NULL")
duration (if completed 1 0)))) duration (if completed "TRUE" "FALSE"))))
(when track-title (when track-title
(postmodern:query (postmodern:query
(:raw (format nil "INSERT INTO listening_history (\"user-id\", track_title, \"listen-duration\", completed) VALUES (~a, '~a', ~a, ~a)" (:raw (format nil "INSERT INTO listening_history (\"user-id\", track_title, \"listen-duration\", completed) VALUES (~a, '~a', ~a, ~a)"
user-id (sql-escape-string track-title) duration (if completed 1 0)))))))))) user-id (sql-escape-string track-title) duration (if completed "TRUE" "FALSE"))))))))))
(defun get-listening-history (user-id &key (limit 20) (offset 0)) (defun get-listening-history (user-id &key (limit 20) (offset 0))
"Get user's listening history - works with title-based history" "Get user's listening history - works with title-based history"