Add CL-REDIS-backed stores fixed-window rate limiting

Author: Copilot

io.github.cl-sdk.wst.rate-limit.redis-store.asd

@@ -0,0 +1,10 @@
+(asdf:defsystem #:io.github.cl-sdk.wst.rate-limit.redis-store
+  :description "Redis-backed storage backend for wst.rate-limit."
+  :author "Bruno Dias"
+  :license "Unlicense"
+  :version "0.0.1"
+  :depends-on (#:io.github.cl-sdk.wst.rate-limit
+	       #:cl-redis)
+  :pathname "rate-limit"
+  :serial t
+  :components ((:file "redis-store")))

io.github.cl-sdk.wst.rate-limit.redis-store.test.asd

@@ -0,0 +1,10 @@
+(asdf:defsystem #:io.github.cl-sdk.wst.rate-limit.redis-store.test
+  :description "Redis-backed rate limit storage backend."
+  :author "Bruno Dias"
+  :license "Unlicense"
+  :version "0.0.1"
+  :depends-on (#:fiveam
+               #:io.github.cl-sdk.wst.rate-limit.redis-store)
+  :pathname "t"
+  :serial t
+  :components ((:file "rate-limit-redis-store-tests")))

io.github.cl-sdk.wst.test.asd

@@ -17,4 +17,5 @@
                #:io.github.cl-sdk.wst.trace-context.routing.test
                #:io.github.cl-sdk.wst.feature-flag.test
                #:io.github.cl-sdk.wst.feature-flag.routing.test
-               #:io.github.cl-sdk.wst.session.sqlite.test))
+               #:io.github.cl-sdk.wst.session.sqlite.test
+               #:io.github.cl-sdk.wst.rate-limit.redis-store.test))

rate-limit/redis-store.lisp

@@ -0,0 +1,75 @@
+(defpackage :io.github.cl-sdk.wst.rate-limit.redis-store
+  (:use #:cl)
+  (:documentation "Redis-backed storage backend for wst.rate-limit.
+
+This backend implements the wst.rate-limit.store protocol using Redis hash
+entries with fields:
+  - \"count\" : current request count
+  - \"start\" : window start time (universal-time)")
+  (:export
+   #:redis-store))
+
+(in-package :io.github.cl-sdk.wst.rate-limit.redis-store)
+
+(defclass redis-store ()
+  ((key-prefix :initarg :key-prefix
+               :initform "wst:rate-limit:"
+               :reader redis-store-key-prefix)
+   (window-seconds :initarg :window-seconds
+                   :initform nil
+                   :reader redis-store-window-seconds)
+   (connection :initarg :connection
+               :initform nil
+               :reader redis-store-connection))
+  (:documentation "Redis-backed implementation of the rate-limit store protocol.
+
+Slots:
+- KEY-PREFIX: string prefix used to namespace Redis keys.
+- WINDOW-SECONDS: optional TTL set on each saved key via EXPIRE.
+- CONNECTION: CL-REDIS connection object used as REDIS:*CONNECTION*."))
+
+(defmacro redis-store--with-connection ((store) &body body)
+  `(let ((redis:*connection* (redis-store-connection ,store)))
+     ,@body))
+
+(defun redis-store--key (store key)
+  (format nil "~a~a"
+          (redis-store-key-prefix store)
+          (write-to-string key :readably t)))
+
+(defun %integer-or-nil (value)
+  (cond
+    ((null value) nil)
+    ((integerp value) value)
+    ((stringp value)
+     (handler-case (parse-integer value :junk-allowed nil)
+       (error () nil)))
+    (t nil)))
+
+(defmethod io.github.cl-sdk.wst.rate-limit.store:fetch-window ((store redis-store) key)
+  (let* ((redis-key (redis-store--key store key))
+         (reply (redis-store--with-connection (store)
+                  (redis:red-hmget redis-key "count" "start")))
+         (count-raw (and (listp reply) (first reply)))
+         (start-raw (and (listp reply) (second reply)))
+         (count (%integer-or-nil count-raw))
+         (start (%integer-or-nil start-raw)))
+    (if (and count start)
+        (values count start)
+        (values nil nil))))
+
+(defmethod io.github.cl-sdk.wst.rate-limit.store:save-window ((store redis-store) key count start-time)
+  (let* ((redis-key (redis-store--key store key))
+         (ttl (redis-store-window-seconds store)))
+    (redis-store--with-connection (store)
+      (redis:red-hmset redis-key
+                       "count" (write-to-string count)
+                       "start" (write-to-string start-time)))
+    (when (and ttl (plusp ttl))
+      (redis-store--with-connection (store)
+        (redis:red-expire redis-key ttl)))
+    t))
+
+(defmethod io.github.cl-sdk.wst.rate-limit.store:delete-window ((store redis-store) key)
+  (redis-store--with-connection (store)
+    (redis:red-del (redis-store--key store key))))

t/rate-limit-redis-store-tests.lisp

@@ -0,0 +1,81 @@
+(defpackage :io.github.cl-sdk.wst.rate-limit.redis-store.test
+  (:use #:cl))
+
+(in-package :io.github.cl-sdk.wst.rate-limit.redis-store.test)
+
+(5am:def-suite wst.rate-limit.redis-store.suite
+  :description "Tests for the wst.rate-limit.redis-store package.")
+
+(5am:in-suite wst.rate-limit.redis-store.suite)
+
+(defun ensure-rate-limit-entry (records key)
+  (or (gethash key records)
+      (setf (gethash key records) (make-hash-table :test #'equal))))
+
+(defmacro with-mocked-rate-limit-redis ((records expiries) &body body)
+  `(let* ((hmget-original (symbol-function 'redis:red-hmget))
+          (hmset-original (symbol-function 'redis:red-hmset))
+          (expire-original (symbol-function 'redis:red-expire))
+          (del-original (symbol-function 'redis:red-del)))
+     (unwind-protect
+          (progn
+            (setf (symbol-function 'redis:red-hmget)
+                  (lambda (key field &rest fields)
+                    (let* ((entry (gethash key ,records))
+                           (wanted-fields (cons field fields)))
+
+                      (mapcar (lambda (field-name)
+                                (and entry (gethash field-name entry)))
+                              wanted-fields)))
+                  (symbol-function 'redis:red-hmset)
+                  (lambda (key &rest fields-and-values)
+                    (let ((entry (ensure-rate-limit-entry ,records key)))
+                      (loop for (field value) on fields-and-values by #'cddr
+                            do (setf (gethash field entry) value)))
+                    "OK")
+                  (symbol-function 'redis:red-expire)
+                  (lambda (key ttl)
+                    (setf (gethash key ,expiries) ttl)
+                    t)
+                  (symbol-function 'redis:red-del)
+                  (lambda (key &rest keys)
+                    (let ((removed 0))
+                      (dolist (k (cons key keys) removed)
+                        (when (gethash k ,records)
+                          (incf removed))
+                        (remhash k ,records)
+                        (remhash k ,expiries)))))
+            ,@body)
+       (setf (symbol-function 'redis:red-hmget) hmget-original
+             (symbol-function 'redis:red-hmset) hmset-original
+             (symbol-function 'redis:red-expire) expire-original
+             (symbol-function 'redis:red-del) del-original))))
+
+(5am:def-test redis-rate-limit-store-roundtrip ()
+  (let ((records (make-hash-table :test #'equal))
+        (expiries (make-hash-table :test #'equal)))
+    (with-mocked-rate-limit-redis (records expiries)
+      (let ((store (make-instance 'io.github.cl-sdk.wst.rate-limit.redis-store:redis-store)))
+        (multiple-value-bind (count start)
+            (io.github.cl-sdk.wst.rate-limit.store:fetch-window store :client-a)
+          (5am:is-false count)
+          (5am:is-false start))
+        (io.github.cl-sdk.wst.rate-limit.store:save-window store :client-a 3 1000)
+        (multiple-value-bind (count start)
+            (io.github.cl-sdk.wst.rate-limit.store:fetch-window store :client-a)
+          (5am:is (= 3 count))
+          (5am:is (= 1000 start)))
+        (io.github.cl-sdk.wst.rate-limit.store:delete-window store :client-a)
+        (multiple-value-bind (count start)
+            (io.github.cl-sdk.wst.rate-limit.store:fetch-window store :client-a)
+          (5am:is-false count)
+          (5am:is-false start))))))
+
+(5am:def-test redis-rate-limit-store-applies-expiry-when-configured ()
+  (let ((records (make-hash-table :test #'equal))
+        (expiries (make-hash-table :test #'equal)))
+    (with-mocked-rate-limit-redis (records expiries)
+      (let ((store (make-instance 'io.github.cl-sdk.wst.rate-limit.redis-store:redis-store
+                                  :window-seconds 42)))
+        (io.github.cl-sdk.wst.rate-limit.store:save-window store :client-b 1 2000)
+        (5am:is (= 42 (gethash "wst:rate-limit::CLIENT-B" expiries)))))))