Add trailing-slash middlewares

lack-mw-test.asd

@@ -1,5 +1,6 @@
 (defsystem "lack-mw-test"
   :class :package-inferred-system
   :pathname "tests"
-  :depends-on ("rove")
+  :depends-on ("rove"
+               "lack-mw-test/trailing-slash")
   :perform (test-op (o c) (symbol-call :rove :run c :style :dot)))

qlfile

@@ -1,5 +1,4 @@
-github fukamachi/lack
+github lack fukamachi/lack
-github fukamachi/quri
+github quri fukamachi/quri
-
+github rove fukamachi/rove
-github fukamachi/clack
+github ningle fukamachi/ningle
-github fukamachi/rove

qlfile.lock

@@ -10,11 +10,11 @@
  (:class qlot/source/github:source-github
   :initargs (:repos "fukamachi/quri" :ref nil :branch nil :tag nil)
   :version "github-45e0ff7f15a96ae9aef02b977375c6984d57a608"))
-("clack" .
- (:class qlot/source/github:source-github
-  :initargs (:repos "fukamachi/clack" :ref nil :branch nil :tag nil)
-  :version "github-935be5b7c862225556a312ed5ed5521a4afd98ae"))
 ("rove" .
  (:class qlot/source/github:source-github
   :initargs (:repos "fukamachi/rove" :ref nil :branch nil :tag nil)
   :version "github-cacea7331c10fe9d8398d104b2dfd579bf7ea353"))
+("ningle" .
+ (:class qlot/source/github:source-github
+  :initargs (:repos "fukamachi/ningle" :ref nil :branch nil :tag nil)
+  :version "github-ae0c79bbd7c71633268fe3130ed4f12ca4be2f9a"))

src/main.lisp

@@ -1,4 +1,5 @@
 (uiop:define-package :lack-mw
   (:nicknames #:lack-mw/main)
-  (:use #:cl))
+  (:use #:cl)
+  (:use-reexport #:lack-mw/trailing-slash))
 (in-package :lack-mw)

src/trailing-slash.lisp

@@ -0,0 +1,42 @@
+(defpackage #:lack-mw/trailing-slash
+  (:use #:cl)
+  (:import-from #:quri)
+  (:export #:*trim-trailing-slash*
+           #:*append-trailing-slash*))
+(in-package #:lack-mw/trailing-slash)
+
+(defun last-string (str)
+  (subseq str (- (length str) 1)))
+
+(defparameter *trim-trailing-slash*
+  (lambda (app)
+    (lambda (env)
+      (let* ((req-uri (quri:uri (getf env :request-uri)))
+             (req-path (quri: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 (quri:copy-uri req-uri
+                                          :path (string-right-trim "/" req-path))))
+              `(301 (:location ,(quri:render-uri red-uri)) ()))
+            response)))))
+
+(defparameter *append-trailing-slash*
+  (lambda (app)
+    (lambda (env)
+      (let* ((req-uri (quri:uri (getf env :request-uri)))
+             (req-path (quri: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= (last-string req-path) "/")))
+            (let ((red-uri (quri:copy-uri req-uri
+                                          :path (concatenate 'string req-path "/"))))
+              `(301 (:location ,(quri:render-uri red-uri)) ()))
+            response)))))

tests/trailing-slash.lisp

@@ -0,0 +1,93 @@
+(defpackage #:lack-mw-test/trailing-slash
+  (:use #:cl
+        #:rove)
+  (:import-from #:lack)
+  (:import-from #:lack/test
+                #:testing-app
+                #:request)
+  (:import-from #:ningle)
+  (:import-from #:lack-mw/trailing-slash
+                #:*trim-trailing-slash*
+                #:*append-trailing-slash*))
+(in-package #:lack-mw-test/trailing-slash)
+
+(defparameter *app-without-trailing-slash*
+  (lack:builder
+   *trim-trailing-slash*
+   (let ((raw-app (make-instance 'ningle:app)))
+     (setf (ningle:route raw-app "/") "ok")
+     (setf (ningle:route raw-app "/without/trailing/slash") "ok")
+     raw-app)))
+
+(defparameter *app-with-trailing-slash*
+  (lack:builder
+   *append-trailing-slash*
+   (let ((raw-app (make-instance 'ningle:app)))
+     (setf (ningle:route raw-app "/") "ok")
+     (setf (ningle:route raw-app "/something.file") "ok")
+     (setf (ningle:route raw-app "/with/trailing/slash/") "ok")
+     raw-app)))
+
+(deftest trailing-slash
+  (testing "trim"
+    (testing-app *app-without-trailing-slash*
+      (multiple-value-bind (body status headers)
+          (request "/")
+        (declare (ignore headers))
+        (ok (not (null body)))
+        (ok (eql status 200)))
+      
+      (multiple-value-bind (body status headers)
+          (request "/without/trailing/slash")
+        (declare (ignore headers))
+        (ok (not (null body)))
+        (ok (eql status 200)))
+      
+      (multiple-value-bind (body status headers)
+          (request "/without/trailing/slash/" :max-redirects 0)
+        (ok (string= body ""))
+        (ok (eql status 301))
+        (ok (string= (gethash "location" headers)
+                     "/without/trailing/slash")))
+      
+      (multiple-value-bind (body status headers)
+          (request "/without/trailing/slash/?param=foo" :max-redirects 0)
+        (ok (string= body ""))
+        (ok (eql status 301))
+        (ok (string= (gethash "location" headers)
+                     "/without/trailing/slash?param=foo")))))
+  
+  (testing "append"
+    (testing-app *app-with-trailing-slash*
+      (multiple-value-bind (body status headers)
+          (request "/")
+        (declare (ignore headers))
+
+        (ok (not (null body)))
+        (ok (eql status 200)))
+      
+      (multiple-value-bind (body status headers)
+          (request "/something.file")
+        (declare (ignore headers))
+        (ok (not (null body)))
+        (ok (eql status 200)))
+
+      (multiple-value-bind (body status headers)
+          (request "/with/trailing/slash/")
+        (declare (ignore headers))
+        (ok (not (null body)))
+        (ok (eql status 200)))
+      
+      (multiple-value-bind (body status headers)
+          (request "/with/trailing/slash" :max-redirects 0)
+        (ok (string= body ""))
+        (ok (eql status 301))
+        (ok (string= (gethash "location" headers)
+                     "/with/trailing/slash/")))
+
+      (multiple-value-bind (body status headers)
+          (request "/with/trailing/slash?param=foo" :max-redirects 0)
+        (ok (string= body ""))
+        (ok (eql status 301))
+        (ok (string= (gethash "location" headers)
+                     "/with/trailing/slash/?param=foo"))))))