diff --git a/qlfile b/qlfile index 71bd4bd..04a33b8 100644 --- a/qlfile +++ b/qlfile @@ -7,3 +7,4 @@ ql cl-ppcre ql trivial-backtrace ql trivia ql cl-str +ql quri diff --git a/qlfile.lock b/qlfile.lock index ffd9fe8..eb92043 100644 --- a/qlfile.lock +++ b/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")) diff --git a/src/app.lisp b/src/app.lisp index cebe764..5944a1c 100644 --- a/src/app.lisp +++ b/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*) diff --git a/src/middlewares/path-normalizer.lisp b/src/middlewares/path-normalizer.lisp deleted file mode 100644 index 679dd8f..0000000 --- a/src/middlewares/path-normalizer.lisp +++ /dev/null @@ -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)))))) diff --git a/src/middlewares/trailing-slash.lisp b/src/middlewares/trailing-slash.lisp new file mode 100644 index 0000000..902a953 --- /dev/null +++ b/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)))))