Modify path normalizer middleware as trim-trailing-slash

qlfile

@@ -7,3 +7,4 @@ ql cl-ppcre
 ql trivial-backtrace
 ql trivia
 ql cl-str
+ql quri

qlfile.lock

@@ -38,3 +38,7 @@
  (:class qlot/source/ql:source-ql
   :initargs (:%version :latest)
   :version "ql-2024-10-12"))
+("quri" .
+ (:class qlot/source/ql:source-ql
+  :initargs (:%version :latest)
+  :version "ql-2024-10-12"))

src/app.lisp

@@ -13,5 +13,5 @@
 
 (fbr:assign-routes *app* :system "hp" :directory "src/routes")
 (jg:install-middleware *app* mw:*recoverer*)
-(jg:install-middleware *app* mw:*path-normalizer*)
+(jg:install-middleware *app* mw:*trim-trailing-slash*)
 (jg:install-middleware *app* mw:*public-server*)

src/middlewares/path-normalizer.lisp

@@ -1,19 +0,0 @@
-(defpackage #:hp/middlewares/path-normalizer
-  (:use #:cl)
-  (:local-nicknames (#:re #:cl-ppcre))
-  (:export #:*path-normalizer*))
-(in-package #:hp/middlewares/path-normalizer)
-
-(defun has-trailing-slash-p (path)
-  (and (not (string= path "/")) (re:scan "\/$" path)))
-
-(defun remove-trailing-slash (path)
-  (re:regex-replace "\/$" path ""))
-
-(defparameter *path-normalizer*
-  (lambda (app)
-    (lambda (env)
-      (let ((path (getf env :request-uri)))
-        (if (has-trailing-slash-p path)
-            `(308 (:location ,(remove-trailing-slash path)))
-            (funcall app env))))))

src/middlewares/trailing-slash.lisp

@@ -0,0 +1,25 @@
+(defpackage #:hp/middlewares/trailing-slash
+  (:use #:cl)
+  (:local-nicknames (#:qu #:quri))
+  (:export #:*trim-trailing-slash*))
+(in-package #:hp/middlewares/trailing-slash)
+
+(defun last-string (str)
+  (subseq str (- (length str) 1)))
+
+(defparameter *trim-trailing-slash*
+  (lambda (app)
+    (lambda (env)
+      (let* ((req-uri (qu:uri (getf env :request-uri)))
+             (req-path (qu:uri-path req-uri))
+             (req-method (getf env :request-method))
+             (response (funcall app env))
+             (res-status (first response)))
+        (if (and (= res-status 404)
+                 (eq req-method :get)
+                 (not (string= req-path "/"))
+                 (string= (last-string req-path) "/"))
+            (let ((red-uri (qu:copy-uri req-uri
+                                        :path (string-right-trim "/" req-path))))
+              `(301 (:location ,(qu:render-uri red-uri))))
+            response)))))