fix: replace r-simple-rate sliding-window with fixed-window rate limiter

The upstream r-simple-rate tax-rate updates the timestamp on every request,
preventing the window from ever resetting while polling is active. This
caused 429 errors on all API endpoints during normal browser usage.

limiter.lisp:
- Add fixed-window-check that uses proper fixed windows (timestamp only
  resets when window expires, not on every request)
- Rewrite define-page-with-limit and define-api-with-limit to call
  fixed-window-check directly, bypassing rate:with-limitation entirely
- Immune to Radiance module reload ordering (no monkey-patches)

frontend-partials.lisp:
- Bump now-playing, now-playing-inline, now-playing-json rate limits
  from 10/1s to 120/60s to accommodate normal polling intervals

parenscript/front-page.lisp:
- Normalize channel-name polling from 10s to 15s (matches stream-player)
This commit is contained in:
Glenn Thompson 2026-04-13 15:17:47 +01:00
parent ed5ede437b
commit b76cef600d
3 changed files with 72 additions and 22 deletions

View File

@ -93,7 +93,7 @@
(:track-id . ,(find-track-by-title title)) (:track-id . ,(find-track-by-title title))
(:favorite-count . ,(or (get-track-favorite-count title) 1)))))))) (:favorite-count . ,(or (get-track-favorite-count title) 1))))))))
(define-api-with-limit asteroid/partial/now-playing (&optional mount) (:limit 10 :timeout 1) (define-api-with-limit asteroid/partial/now-playing (&optional mount) (:limit 120 :timeout 60)
"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."
@ -123,7 +123,7 @@
:connection-error t :connection-error t
:stats nil)))))) :stats nil))))))
(define-api-with-limit asteroid/partial/now-playing-inline (&optional mount) (:limit 10 :timeout 1) (define-api-with-limit asteroid/partial/now-playing-inline (&optional mount) (:limit 120 :timeout 60)
"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
@ -137,7 +137,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 10 :timeout 1) (define-api-with-limit asteroid/partial/now-playing-json (&optional mount) (:limit 120 :timeout 60)
"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."
;; Register web listener for geo stats (keeps listener active during playback) ;; Register web listener for geo stats (keeps listener active during playback)

View File

@ -1,4 +1,10 @@
;;;; limiter.lisp - Rate limiter definitions for the application ;;;; limiter.lisp - Rate limiter definitions for the application
;;;;
;;;; Replaces r-simple-rate's with-limitation with a fixed-window
;;;; implementation. The upstream tax-rate updates the timestamp on
;;;; EVERY request, preventing the window from ever resetting while
;;;; polling is active. Our define-*-with-limit macros bypass
;;;; rate:with-limitation entirely and call fixed-window-check instead.
(in-package :asteroid) (in-package :asteroid)
@ -15,6 +21,50 @@
(error (e) (error (e)
(l:warn :rate-limiter "Failed to cleanup rate limits: ~a" e)))) (l:warn :rate-limiter "Failed to cleanup rate limits: ~a" e))))
;;; --- Fixed-window rate limiter ---
;;;
;;; r-simple-rate has a sliding-window bug: tax-rate updates the timestamp
;;; on every request, so the window never resets while polling is active.
;;; Rather than monkey-patching (Radiance may reload the module and clobber
;;; our overrides), we implement our own fixed-window logic directly.
(defun fixed-window-check (limit-name max-requests timeout-seconds)
"Check and tax a fixed-window rate limit. Returns T if the request
is allowed, or (VALUES NIL seconds-remaining) if rate-limited.
LIMIT-NAME is a string key, MAX-REQUESTS and TIMEOUT-SECONDS are integers.
Uses the SIMPLE-RATE/TRACKING table for storage."
(let* ((ip (remote *request*))
(tracking (dm:get-one 'simple-rate::tracking
(db:query (:and (:= 'limit limit-name)
(:= 'ip ip)))))
(now (get-universal-time)))
(cond
;; Existing entry
(tracking
(let ((window-end (+ (dm:field tracking "time") timeout-seconds)))
(when (<= window-end now)
;; Window expired - reset counter and start new window
(setf (dm:field tracking "amount") max-requests)
(setf (dm:field tracking "time") now)
(setf window-end (+ now timeout-seconds)))
;; Check budget
(if (<= (dm:field tracking "amount") 0)
;; Exhausted - report time remaining
(values nil (- window-end now))
;; Allowed - decrement and save
(progn
(decf (dm:field tracking "amount"))
(dm:save tracking)
t))))
;; First request ever from this IP for this limit
(t
(db:insert 'simple-rate::tracking
`((limit . ,limit-name)
(time . ,now)
(amount . ,(1- max-requests))
(ip . ,ip)))
t))))
(define-trigger db:connected () (define-trigger db:connected ()
"Clean up any corrupted rate limit entries on startup" "Clean up any corrupted rate limit entries on startup"
(cleanup-corrupted-rate-limits)) (cleanup-corrupted-rate-limits))
@ -43,31 +93,31 @@
(defmacro define-page-with-limit (name uri options &body body) (defmacro define-page-with-limit (name uri options &body body)
"Rate limit for a page route. Defaults to 30 requests per minute." "Rate limit for a page route. Defaults to 30 requests per minute.
Uses fixed-window rate limiting (not r-simple-rate's sliding window)."
(multiple-value-bind (limit timeout group rest) (extract-limit-options options) (multiple-value-bind (limit timeout group rest) (extract-limit-options options)
(let* ((limit-name (string-upcase (format nil "~a-route-limit" (or group name)))) (let* ((limit-name (string-upcase (format nil "~a-route-limit" (or group name))))
(limit-sym (intern limit-name))
(limit (or limit 30)) (limit (or limit 30))
(timeout (or timeout 60))) (timeout (or timeout 60)))
`(eval-when (:compile-toplevel :load-toplevel :execute) `(define-page ,name ,uri ,rest
(rate:define-limit ,limit-sym (time-left :limit ,limit :timeout ,timeout) (multiple-value-bind (allowed time-left)
;; (format t "Route limit '~a' hit. Wait ~a seconds and retry.~%" ,(string name) time-left) (fixed-window-check ,limit-name ,limit ,timeout)
(render-rate-limit-error-page)) (declare (ignorable time-left))
(define-page ,name ,uri ,rest (if allowed
(rate:with-limitation (,limit-sym) (progn ,@body)
,@body)))))) (render-rate-limit-error-page)))))))
(defmacro define-api-with-limit (name args options &body body) (defmacro define-api-with-limit (name args options &body body)
"Rate limit for api routes. Defaults to 60 requests per minute." "Rate limit for api routes. Defaults to 60 requests per minute.
Uses fixed-window rate limiting (not r-simple-rate's sliding window)."
(multiple-value-bind (limit timeout group rest) (extract-limit-options options) (multiple-value-bind (limit timeout group rest) (extract-limit-options options)
(let* ((limit-name (string-upcase (format nil "~a-api-limit" (or group name)))) (let* ((limit-name (string-upcase (format nil "~a-api-limit" (or group name))))
(limit-sym (intern limit-name))
(limit (or limit 60)) (limit (or limit 60))
(timeout (or timeout 60))) (timeout (or timeout 60)))
`(eval-when (:compile-toplevel :load-toplevel :execute) `(define-api ,name ,args ,rest
(rate:define-limit ,limit-sym (time-left :limit ,limit :timeout ,timeout) (multiple-value-bind (allowed time-left)
;; (format t "API Rate limit '~a' hit. Wait ~a seconds and retry.~%" ,(string name) time-left) (fixed-window-check ,limit-name ,limit ,timeout)
(api-limit-error-output)) (declare (ignorable time-left))
(define-api ,name ,args ,rest (if allowed
(rate:with-limitation (,limit-sym) (progn ,@body)
,@body)))))) (api-limit-error-output)))))))

View File

@ -776,7 +776,7 @@
(setf (ps:@ curated-option text-content) (+ "🎧 " current-channel-name))))))))))) (setf (ps:@ curated-option text-content) (+ "🎧 " current-channel-name)))))))))))
(catch (lambda (error) (catch (lambda (error)
(ps:chain console (log "Could not fetch channel name:" error)))))) (ps:chain console (log "Could not fetch channel name:" error))))))
10000)) ;; Poll every 10 seconds 15000)) ;; Poll every 15 seconds
;; Listen for messages from popout window ;; Listen for messages from popout window
(ps:chain window (ps:chain window