Merge pull request #11 from fukamachi/efficient-session

Send Set-Cookie header only when it's necessary

src/middleware/session.lisp

@@ -30,7 +30,9 @@
         (setf (getf env :lack.session)
               (or session (make-hash-table :test 'equal)))
         (setf (getf env :lack.session.options)
-              (list :id sid))
+              (if session
+                  (list :id sid)
+                  (list :id sid :new-session t)))
         (finalize store state env (funcall app env)))))
   "Middleware for session management")
 

src/middleware/session/state/cookie.lisp

@@ -10,8 +10,6 @@
                 :make-response
                 :finalize-response
                 :response-set-cookies)
-  (:import-from :alexandria
-                :remove-from-plist)
   (:export :cookie-state
            :make-cookie-state
            :generate-sid
@@ -41,14 +39,20 @@
                    (funcall responder (finalize-state state sid actual-res options))))))
 
 (defmethod finalize-state ((state cookie-state) sid (res list) options)
+  ;; Don't send Set-Cookie header when it's not necessary.
+  (destructuring-bind (&key no-store new-session change-id expire &allow-other-keys)
+      options
+    (when (or no-store
+              (not (or new-session change-id expire)))
+      (return-from finalize-state res)))
+
   (let ((res (apply #'make-response res))
-        (options (append (remove-from-plist options :id)
+        (options (with-slots (path domain expires secure httponly) state
-                         (with-slots (path domain expires secure httponly) state
+                   (list :path path
-                           (list :path path
+                         :domain domain
-                                 :domain domain
+                         :secure secure
-                                 :secure secure
+                         :httponly httponly
-                                 :httponly httponly
+                         :expires (+ (get-universal-time) expires)))))
-                                 :expires (+ (get-universal-time) expires))))))
     (setf (getf (response-set-cookies res) :|lack.session|)
           `(:value ,sid ,@options))
     (finalize-response res)))

t/middleware/session.lisp

@@ -6,7 +6,7 @@
         :lack.test))
 (in-package :t.lack.middleware.session)
 
-(plan 3)
+(plan 4)
 
 (ok (lack.session.state:make-state)
     "Base class of session state")
@@ -69,4 +69,38 @@
                  (is status 200)
                  (is body '("Hello, you've been here for 2th times!")))))))
 
+(subtest "Set-Cookie header"
+  (let ((app (builder
+              :session
+              (lambda (env)
+                (when (string= (getf env :path-info) "/expire")
+                  (setf (getf (getf env :lack.session.options) :expire) t))
+                '(200 () ("hi")))))
+        session)
+    ;; 1st
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/" :cookies '(("lack.session" . nil))))
+      (is status 200 "status")
+      (ok (getf headers :set-cookie)
+          "Set-Cookie header exists")
+      (setf session
+            (ppcre:scan-to-strings "(?<=lack.session=)[^;]+" (getf headers :set-cookie "")))
+      (is-type session 'string
+               "Set-Cookie header value is valid")
+      (is body '("hi") "body"))
+    ;; 2nd
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/" :cookies `(("lack.session" . ,session))))
+      (is status 200 "status")
+      (is (getf headers :set-cookie) nil
+          "Set-Cookie header doesn't exist")
+      (is body '("hi") "body"))
+    ;; invalid lack.session
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/" :cookies '(("lack.session" . "<invalid session here>"))))
+      (is status 200 "status")
+      (ok (getf headers :set-cookie)
+          "Set-Cookie header exists")
+      (is body '("hi") "body"))))
+
 (finalize)