Test without HTTP requests.

2025-03-04 08:51:41 -05:00 · 2015-03-22 13:44:36 +09:00 · 2015-03-22 13:44:36 +09:00 · ec22fa208f
commit ec22fa208f
parent 8b38515ebf
11 changed files with 275 additions and 234 deletions
--- a/.travis.yml
+++ b/.travis.yml
@ -10,10 +10,6 @@ install:
  - curl https://raw.githubusercontent.com/luismbo/cl-travis/master/install.sh | bash

 before_script:
-  - git clone https://github.com/fukamachi/fast-http ~/lisp/fast-http
-  - git clone https://github.com/fukamachi/quri ~/lisp/quri
-  - git clone https://github.com/fukamachi/cl-cookie ~/lisp/cl-cookie
-  - git clone https://github.com/fukamachi/dexador ~/lisp/dexador
  - git clone https://github.com/fukamachi/http-body ~/lisp/http-body
  - git clone https://github.com/fukamachi/cl-coveralls ~/lisp/cl-coveralls

--- a/lack-test.asd
+++ b/lack-test.asd
@ -8,6 +8,6 @@
  :license "LLGPL"
  :depends-on (:lack
               :prove
-               :bordeaux-threads
-               :usocket)
+               :quri
+               :flexi-streams)
  :components ((:file "src/test")))
--- a/src/test.lisp
+++ b/src/test.lisp
@ -1,60 +1,64 @@
 (in-package :cl-user)
 (defpackage lack.test
  (:use :cl)
-  (:import-from :lack
-                :lackup
-                :stop)
-  (:import-from :prove
-                :subtest)
-  (:import-from :bordeaux-threads
-                :thread-alive-p
-                :destroy-thread)
-  (:import-from :usocket
-                :socket-listen
-                :socket-close
-                :address-in-use-error)
-  (:export :subtest-app
-           :localhost
-           :*lack-test-handler*
-           :*lack-test-port*))
+  (:import-from :quri
+                :uri
+                :uri-path
+                :uri-query
+                :render-uri
+                :url-encode-params)
+  (:import-from :flexi-streams
+                :make-in-memory-input-stream
+                :string-to-octets)
+  (:export :generate-env
+           :parse-lack-session))
 (in-package :lack.test)

-(defvar *lack-test-handler* :hunchentoot)
-(defvar *lack-test-port* 4242)
+(defun generate-env (uri &key (method :get) content headers cookies)
+  (when content
+    (let ((content-type (or (cdr (assoc "content-type" headers :test #'string-equal))
+                            (if (find-if #'pathnamep content :key #'cdr)
+                                "multipart/form-data"
+                                "application/x-www-form-urlencoded"))))
+      (if (assoc "content-type" headers :test #'string-equal)
+          (setf (cdr (assoc "content-type" headers :test #'string-equal))
+                content-type)
+          (setf headers (append headers `(("content-type" . ,content-type)))))))
+  (when cookies
+    (setf headers
+          (append headers
+                  `(("cookie" . ,(with-output-to-string (s)
+                                   (format s "~A=~A" (caar cookies) (cdar cookies))
+                                   (loop for (k . v) in (cdr cookies)
+                                         do (format s "; ~A=~A" k v))))))))
+  (when content
+    (setf content (flex:string-to-octets
+                   (quri:url-encode-params content))))
+  (let ((uri (quri:uri uri)))
+    (list :request-method method
+          :request-uri (quri:render-uri uri)
+          :script-name ""
+          :path-info (quri:uri-path uri)
+          :query-string (or (quri:uri-query uri) "")
+          :server-name "localhost"
+          :server-port 80
+          :server-protocol :http/1.1
+          :remote-addr "127.0.0.1"
+          :remote-port 12345
+          :content-type (cdr (assoc "content-type" headers :test #'string-equal))
+          :content-length (and content
+                               (length content))
+          :headers (loop with hash = (make-hash-table :test 'equal)
+                         for (k . v) in headers
+                         do (setf (gethash k hash) v)
+                         finally (return hash))
+          :raw-body (and content
+                         (flex:make-in-memory-input-stream content)))))

-(defvar *enable-debug-p* t)
-
-(defun port-available-p (port)
-  (let (socket)
-    (unwind-protect
-         (handler-case (setq socket (usocket:socket-listen "127.0.0.1" port :reuse-address t))
-           (usocket:address-in-use-error () nil))
-      (when socket
-        (usocket:socket-close socket)
-        t))))
-
-(defun localhost (&optional (path "/"))
-  (format nil "http://localhost:~D~A"
-          *lack-test-port* path))
-
-(defun %subtest-app (desc app client)
-  (loop repeat 5
-        until (port-available-p *lack-test-port*)
-        do (sleep 0.1)
-        finally
-        (unless (port-available-p *lack-test-port*)
-          (error "Port ~D is already in use." *lack-test-port*)))
-  (let ((acceptor (lackup app
-                          :server *lack-test-handler*
-                          :use-thread t
-                          :silent t
-                          :port *lack-test-port*
-                          :debug *enable-debug-p*)))
-    (subtest desc
-      (sleep 0.5)
-      (unwind-protect
-           (funcall client)
-        (stop acceptor)))))
-
-(defmacro subtest-app (desc app &body client)
-  `(%subtest-app ,desc ,app (lambda () ,@client)))
+(defun parse-lack-session (headers)
+  (let ((set-cookie (getf headers :set-cookie)))
+    (when set-cookie
+      (when (string= set-cookie "lack.session=" :end1 #.(length "lack.session="))
+        (subseq set-cookie
+                #.(length "lack.session=")
+                (position #\; set-cookie))))))
--- a/t-lack-middleware-auth-basic.asd
+++ b/t-lack-middleware-auth-basic.asd
@ -10,8 +10,8 @@
               :lack-test
               :lack-middleware-auth-basic
               :prove
-               :dexador
-               :cl-base64)
+               :cl-base64
+               :alexandria)
  :components
  ((:test-file "t/middleware/auth/basic"))

--- a/t-lack-middleware-csrf.asd
+++ b/t-lack-middleware-csrf.asd
@ -7,13 +7,11 @@
  :author "Eitaro Fukamachi"
  :license "LLGPL"
  :depends-on (:lack
-               :lack-request
               :lack-test
+               :lack-request
               :lack-middleware-csrf
               :prove
-               :cl-ppcre
-               :dexador
-               :cl-cookie)
+               :cl-ppcre)
  :components
  ((:test-file "t/middleware/csrf"))

--- a/t-lack-middleware-session.asd
+++ b/t-lack-middleware-session.asd
@ -8,9 +8,7 @@
  :license "LLGPL"
  :depends-on (:lack
               :lack-test
-               :prove
-               :dexador
-               :cl-cookie)
+               :prove)
  :components ((:test-file "t/middleware/session"))

  :defsystem-depends-on (:prove-asdf)
--- a/t-lack-middleware-static.asd
+++ b/t-lack-middleware-static.asd
@ -8,8 +8,7 @@
  :license "LLGPL"
  :depends-on (:lack
               :lack-test
-               :prove
-               :dexador)
+               :prove)
  :components ((:test-file "t/middleware/static"))

  :defsystem-depends-on (:prove-asdf)
--- a/t/middleware/auth/basic.lisp
+++ b/t/middleware/auth/basic.lisp
@ -9,40 +9,61 @@

 (plan 2)

-(subtest-app "lack-middleware-auth-basic"
-    (builder
-     (:auth-basic :authenticator (lambda (user pass)
-                                   (and (string= user "hoge")
-                                        (string= pass "fuga"))))
-     (lambda (env)
-       `(200 () (,(format nil "Hello, ~A" (getf env :remote-user))))))
-  (multiple-value-bind (body status headers)
-      (dex:get (localhost))
-    (is status 401)
-    (is body "Authorization required")
-    (is (gethash "www-authenticate" headers)
-        "Basic realm=restricted area"))
-  (is (dex:get (localhost)
-               :headers `(("Authorization" . ,(format nil "Basic ~A"
-                                                      (string-to-base64-string "wrong:auth")))))
-      "Authorization required")
-  (is (dex:get (localhost)
-               :headers `(("Authorization" . ,(format nil "Basic ~A"
-                                                      (string-to-base64-string "hoge:fuga")))))
-      "Hello, hoge"))
+(subtest "lack-middleware-auth-basic"
+  (let ((app
+          (builder
+           (:auth-basic :authenticator (lambda (user pass)
+                                         (and (string= user "hoge")
+                                              (string= pass "fuga"))))
+           (lambda (env)
+             `(200 () (,(format nil "Hello, ~A" (getf env :remote-user))))))))
+    (generate-env "/")
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"))
+      (is status 401)
+      (is body '("Authorization required"))
+      (is (getf headers :www-authenticate) "Basic realm=restricted area"))

-(subtest-app "Use :remote-user"
-    (builder
-     (:auth-basic :authenticator (lambda (user pass)
-                                   (when (and (string= user "nitro_idiot")
-                                              (string= pass "password"))
-                                     (values t "Eitaro Fukamachi"))))
-     (lambda (env)
-       `(200 () (,(format nil "Hello, ~A" (getf env :remote-user))))))
-  (is (dex:get (localhost)) "Authorization required")
-  (is (dex:get (localhost)
-               :headers `(("Authorization" . ,(format nil "Basic ~A"
-                                                      (string-to-base64-string "nitro_idiot:password")))))
-      "Hello, Eitaro Fukamachi"))
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"
+                                   :headers
+                                   `(("authorization" . ,(format nil "Basic ~A"
+                                                                 (string-to-base64-string "wrong:auth"))))) )
+      (is status 401)
+      (is body '("Authorization required"))
+      (is (getf headers :www-authenticate) "Basic realm=restricted area"))
+
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"
+                                   :headers
+                                   `(("authorization" . ,(format nil "Basic ~A"
+                                                                 (string-to-base64-string "hoge:fuga"))))))
+      (declare (ignore headers))
+      (is status 200)
+      (is body '("Hello, hoge")))))
+
+(subtest "Use :remote-user"
+  (let ((app
+          (builder
+           (:auth-basic :authenticator (lambda (user pass)
+                                         (when (and (string= user "nitro_idiot")
+                                                    (string= pass "password"))
+                                           (values t "Eitaro Fukamachi"))))
+           (lambda (env)
+             `(200 () (,(format nil "Hello, ~A" (getf env :remote-user))))))))
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"))
+      (is status 401)
+      (is body '("Authorization required"))
+      (is (getf headers :www-authenticate) "Basic realm=restricted area"))
+
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"
+                                   :headers
+                                   `(("authorization" . ,(format nil "Basic ~A"
+                                                                 (string-to-base64-string "nitro_idiot:password"))))))
+      (declare (ignore headers))
+      (is status 200)
+      (is body '("Hello, Eitaro Fukamachi")))))

 (finalize)
--- a/t/middleware/csrf.lisp
+++ b/t/middleware/csrf.lisp
@ -3,10 +3,9 @@
  (:use :cl
        :prove
        :lack
-        :lack.request
        :lack.test
-        :lack.middleware.csrf
-        :cl-cookie))
+        :lack.request
+        :lack.middleware.csrf))
 (in-package :t.lack.middleware.csrf)

 (plan 2)
@ -35,89 +34,114 @@
                 "name=\"_csrf_token\" value=\"(.+?)\"" body))))
    (and match (elt match 0))))

-(subtest-app "CSRF middleware"
-    (builder
-     :session
-     :csrf
-     #'(lambda (env)
-         (let ((req (make-request env)))
-           `(200
-             (:content-type "text/html")
-             (,(if (and (eq :post (request-method req))
-                        (assoc "name" (request-body-parameters req) :test #'string=))
-                   (cdr (assoc "name" (request-body-parameters req) :test #'string=))
-                   (html-form env)))))))
-  (let (csrf-token
-        (cookie-jar (make-instance 'cookie-jar)))
+(subtest "CSRF middleware"
+  (let ((app
+          (builder
+           :session
+           :csrf
+           #'(lambda (env)
+               (let ((req (make-request env)))
+                 `(200
+                   (:content-type "text/html")
+                   (,(if (and (eq :post (request-method req))
+                              (assoc "name" (request-body-parameters req) :test #'string=))
+                         (cdr (assoc "name" (request-body-parameters req) :test #'string=))
+                         (html-form env))))))))
+        csrf-token
+        session)
    (diag "first POST request")
-    (is (nth-value 1 (dex:post "http://localhost:4242/"
-                               :cookie-jar cookie-jar))
-        400)
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/" :method :post))
+      (is status 400)
+      (is body '("Bad Request: invalid CSRF token"))
+      (like (getf headers :set-cookie)
+            "^lack.session=.+; path=/; expires=")
+
+      (setf session (parse-lack-session headers)))
+
    (diag "first GET request")
-    (multiple-value-bind (body status headers)
-        (dex:get "http://localhost:4242/"
-                 :cookie-jar cookie-jar)
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"
+                                   :headers
+                                   `(("cookie" . ,(format nil "lack.session=~A" session)))))
      (is status 200 "Status is 200")
-      (is (gethash "content-type" headers) "text/html; charset=utf-8" "Content-Type is text/html")
-      (setf csrf-token (parse-csrf-token body))
+      (like (getf headers :content-type) "^text/html" "Content-Type is text/html")
+      (setf csrf-token (parse-csrf-token (car body)))
      (ok csrf-token "can get CSRF token")
      (is-type csrf-token 'string "CSRF token is string")
      (is (length csrf-token) 40 "CSRF token is 40 chars"))
-    (diag "bad POST request (no token)")
-    (multiple-value-bind (body status headers)
-        (dex:post "http://localhost:4242/"
-                  :cookie-jar cookie-jar)
-      (is status 400 "Status is 400")
-      (is (gethash "content-type" headers) "text/plain; charset=utf-8" "Content-Type is text/plain")
-      (is body "Bad Request: invalid CSRF token" "Body is 'forbidden'"))
-    (diag "bad POST request (wrong token)")
-    (is (nth-value
-         1
-         (dex:post "http://localhost:4242/"
-                   :content '(("name" . "Eitaro Fukamachi")
-                              ("_csrf_token" . "wrongtokeniknow"))
-                   :cookie-jar cookie-jar))
-        400)
-    (diag "valid POST request")
-    (multiple-value-bind (body status headers)
-        (dex:post "http://localhost:4242/"
-                  :content `(("name" . "Eitaro Fukamachi")
-                             ("_csrf_token" . ,csrf-token))
-                  :cookie-jar cookie-jar)
-      (is status 200 "Status is 200")
-      (is (gethash "content-type" headers) "text/html; charset=utf-8" "Content-Type is text/html")
-      (is body "Eitaro Fukamachi" "can read body-parameter"))))

-(subtest-app "enable one-time token"
-    (builder
-     :session
-     (:csrf :one-time t)
-     #'(lambda (env)
-         (let ((req (make-request env)))
-           `(200
-             (:content-type "text/html")
-             (,(if (and (eq :post (request-method req))
-                        (assoc "name" (request-body-parameters req) :test #'string=))
-                   (cdr (assoc "name" (request-body-parameters req) :test #'string=))
-                   (html-form env)))))))
-  (let (csrf-token
-        (cookie-jar (make-instance 'cookie-jar)))
-    (setf csrf-token
-          (parse-csrf-token
-           (dex:get "http://localhost:4242/"
-                    :cookie-jar cookie-jar)))
-    (dex:post "http://localhost:4242/"
-              :content `(("name" . "Eitaro Fukamachi")
-                         ("_csrf_token" . ,csrf-token))
-              :cookie-jar cookie-jar)
-    (diag "bad POST request with before token")
-    (multiple-value-bind (body status headers)
-        (dex:post "http://localhost:4242/"
-                  :content `(("name" . "Eitaro Fukamachi")
-                             ("_csrf_token" . ,csrf-token))
-                  :cookie-jar cookie-jar)
-      (declare (ignore body))
+    (diag "bad POST request (no token)")
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"
+                                   :method :post
+                                   :headers
+                                   `(("cookie" . ,(format nil "lack.session=~A" session)))))
      (is status 400 "Status is 400")
-      (is (gethash "content-type" headers) "text/plain; charset=utf-8" "Content-Type is text/plain"))))
+      (like (getf headers :content-type) "^text/plain" "Content-Type is text/plain")
+      (is body '("Bad Request: invalid CSRF token") "Body is 'forbidden'"))
+
+    (diag "bad POST request (wrong token)")
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"
+                                   :method :post
+                                   :headers
+                                   `(("cookie" . ,(format nil "lack.session=~A" session)))))
+      (is status 400 "Status is 400")
+      (like (getf headers :content-type) "^text/plain" "Content-Type is text/plain")
+      (is body '("Bad Request: invalid CSRF token") "Body is 'forbidden'"))
+
+    (diag "valid POST request")
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"
+                                   :method :post
+                                   :cookies `(("lack.session" . ,session))
+                                   :content
+                                   `(("name" . "Eitaro Fukamachi")
+                                     ("_csrf_token" . ,csrf-token))))
+      (is status 200 "Status is 200")
+      (like (getf headers :content-type) "^text/html" "Content-Type is text/html")
+      (is body '("Eitaro Fukamachi") "can read body-parameter"))))
+
+(subtest "enable one-time token"
+  (let (csrf-token
+        session
+        (app
+          (builder
+           :session
+           (:csrf :one-time t)
+           #'(lambda (env)
+               (let ((req (make-request env)))
+                 `(200
+                   (:content-type "text/html")
+                   (,(if (and (eq :post (request-method req))
+                              (assoc "name" (request-body-parameters req) :test #'string=))
+                         (cdr (assoc "name" (request-body-parameters req) :test #'string=))
+                         (html-form env)))))))))
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"))
+      (declare (ignore status))
+      (setf csrf-token (parse-csrf-token (car body)))
+      (setf session (parse-lack-session headers)))
+
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"
+                                   :method :post
+                                   :content `(("name" . "Eitaro Fukamachi")
+                                              ("_csrf_token" . ,csrf-token))
+                                   :cookies `(("lack.session" . ,session))))
+      (declare (ignore headers body))
+      (is status 200))
+
+    (diag "send a request with an expired token")
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"
+                                   :method :post
+                                   :content `(("name" . "Eitaro Fukamachi")
+                                              ("_csrf_token" . ,csrf-token))
+                                   :cookies `(("lack.session" . ,session))))
+      (is status 400)
+      (is (getf headers :content-type) "text/plain")
+      (is body '("Bad Request: invalid CSRF token")))))

 (finalize)
--- a/t/middleware/session.lisp
+++ b/t/middleware/session.lisp
@ -3,35 +3,35 @@
  (:use :cl
        :prove
        :lack
-        :lack.test
-        :cl-cookie))
+        :lack.test))
 (in-package :t.lack.middleware.session)

-(plan nil)
+(plan 1)

-#+thread-support
-(subtest-app "session middleware"
-    (builder
-     :session
-     (lambda (env)
-       (unless (gethash :counter (getf env :lack.session))
-         (setf (gethash :counter (getf env :lack.session)) 0))
-       `(200
-         (:content-type "text/plain")
-         (,(format nil "Hello, you've been here for ~Ath times!"
-                   (incf (gethash :counter (getf env :lack.session))))))))
-  (let ((cookie-jar (make-cookie-jar)))
-    (multiple-value-bind (body status)
-        (dex:get (localhost) :cookie-jar cookie-jar :verbose t)
-      (diag "1st request")
+(subtest "session middleware"
+  (let ((app
+          (builder
+           :session
+           (lambda (env)
+             (unless (gethash :counter (getf env :lack.session))
+               (setf (gethash :counter (getf env :lack.session)) 0))
+             `(200
+               (:content-type "text/plain")
+               (,(format nil "Hello, you've been here for ~Ath times!"
+                         (incf (gethash :counter (getf env :lack.session))))))))))
+    (diag "1st request")
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"))
      (is status 200)
-      (is body "Hello, you've been here for 1th times!"))
-    (multiple-value-bind (body status)
-        (dex:get (localhost) :cookie-jar cookie-jar :verbose t)
-      (diag "2nd request")
+      (setf session (parse-lack-session headers))
+      (ok session)
+      (is body '("Hello, you've been here for 1th times!")))
+
+    (diag "2nd request")
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/" :cookies `(("lack.session" . ,session))))
+      (declare (ignore headers))
      (is status 200)
-      (is body "Hello, you've been here for 2th times!"))))
-#-thread-support
-(skip 4 "because your lisp doesn't support threads")
+      (is body '("Hello, you've been here for 2th times!")))))

 (finalize)
--- a/t/middleware/static.lisp
+++ b/t/middleware/static.lisp
@ -6,31 +6,32 @@
        :lack.test))
 (in-package :t.lack.middleware.static)

-(plan nil)
+(plan 1)

-#+thread-support
-(subtest-app "static middleware"
-    (builder
-     (:static :path "/public/"
-              :root (asdf:system-relative-pathname :lack #P"data/"))
-     (lambda (env)
-       (declare (ignore env))
-       `(200 (:content-type "text/plain") ("Happy Valentine!"))))
-  (multiple-value-bind (body status headers)
-      (dex:get (localhost "/public/jellyfish.jpg"))
-    (is status 200)
-    (is (gethash "content-type" headers) "image/jpeg")
-    (is (length body) 139616))
-  (multiple-value-bind (body status)
-      (dex:get (localhost "/public/hoge.png"))
-    (is status 404)
-    (is body "Not Found"))
-  (multiple-value-bind (body status headers)
-      (dex:get (localhost "/"))
-    (is status 200)
-    (ok (string= (gethash "content-type" headers) "text/plain" :end1 10))
-    (is body "Happy Valentine!")))
-#-thread-support
-(skip 1 "because your lisp doesn't support threads")
+(subtest "static middleware"
+  (let ((app
+          (builder
+           (:static :path "/public/"
+                    :root (asdf:system-relative-pathname :lack #P"data/"))
+           (lambda (env)
+             (declare (ignore env))
+             `(200 (:content-type "text/plain") ("Happy Valentine!"))))))
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/public/jellyfish.jpg"))
+      (is status 200)
+      (is (getf headers :content-type) "image/jpeg")
+      (is body (asdf:system-relative-pathname :lack #P"data/jellyfish.jpg")))
+
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/public/hoge.png"))
+      (declare (ignore headers))
+      (is status 404)
+      (is body '("Not Found")))
+
+    (destructuring-bind (status headers body)
+        (funcall app (generate-env "/"))
+      (is status 200)
+      (is (getf headers :content-type) "text/plain")
+      (is body '("Happy Valentine!")))))

 (finalize)