Skip to content

Commit

Permalink
test responders.
Browse files Browse the repository at this point in the history
  • Loading branch information
@diasbruno
diasbruno committed Aug 11, 2024
1 parent dcbfbcc commit 72214fa
Show file tree
Hide file tree
Showing 3 changed files with 104 additions and 39 deletions.
48 changes: 22 additions & 26 deletions routing/package.lisp
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
(defpackage #:wst.routing
(:use #:cl)
(:import-from #:cl-hash-util
#:hash-create
#:hash
#:with-keys)
(:import-from #:alexandria
Expand All @@ -15,49 +16,44 @@
(:import-from #:uiop
#:read-file-string)
(:export
#:any-route-handler
#:route
#:matcher
#:request-json-content
#:request-content-stream
#:add-route
#:remove-route
#:request
#:response
#:dispatch-route
#:dispatch-route-by-name
#:response
#:not-found-response
#:internal-server-error-response
#:route
#:find-route-by-name
#:remove-route
#:add-route
#:condition-handler
#:change-static-path
#:route-static
#:any-route-handler
#:ok-response
#:internal-server-error-response
#:not-found-response
#:forbidden-response
#:unauthorized-response
#:bad-request-response
#:redirect-see-other-response
#:make-request
#:make-response
#:request-data
#:request-uri
#:request-method
#:request-headers
#:request-content
#:request-data
#:request-content-type
#:response-status
#:response-headers
#:response-content
#:response-data
#:make-request
#:make-response
#:success-response
#:unauthorized
#:write-response
#:bad-request
#:request
#:redirect-see-other
#:request-content-type
#:request-content-length
#:find-route-by-name
#:forbidden-response))
#:request-content-length))

(in-package :wst.routing)

(defstruct request
"Request object."
(uri "" :type string)
(method :GET :type symbol)
(headers (cl-hash-util:hash-create nil) :type hash-table)
(headers (hash-create nil) :type hash-table)
(content-type nil :type (or string null))
(content-length 0 :type integer)
content
Expand Down
23 changes: 12 additions & 11 deletions routing/responses.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,29 +3,30 @@
(defun write-response (response
&key
content
(status 200)
status
headers
(content-type "text/html" content-type-boundp))
(content-type "text/html"))
(setf (response-status response) status
(response-headers response) (append (response-headers response)
(list :content-type content-type)
headers)
(response-content response) content)
response)

(defgeneric success-response (ty response &key headers content)
(defun default-internal-server-error-resounse (response)
(write-response response :status 500 :content "internal server error"))

(defgeneric ok-response (ty response &key headers content)
(:documentation "Build a response for a type TY (:json, :html, t = html).
CONTENT is any object that is serialized accourding to the type.")
(:method ((ty t) response &key headers content)
(write-response response :status 200 :headers headers :content content)))

(defun default-internal-server-error-resounse (response)
(write-response response :status 500 :content "internal server error"))

(defgeneric internal-server-error-response (ty response &key)
(defgeneric internal-server-error-response (ty response &key headers)
(:documentation "Build a response for a type TY (:json, :html, t = html).
CONTENT is any object that is serialized accourding to the type.")
(:method ((ty t) response &key)
(:method ((ty t) response &key headers)
(declare (ignorable headers))
(default-internal-server-error-resounse response)))

(defgeneric not-found-response (ty response &key)
Expand All @@ -40,19 +41,19 @@
(:method ((ty t) response &key content)
(write-response response :status 403 :content (or content "Forbidden"))))

(defgeneric unauthorized (ty response &key)
(defgeneric unauthorized-response (ty response &key)
(:documentation "Build a response for a type TY (:json, :html, t = html).
CONTENT is any object that is serialized accourding to the type.")
(:method ((ty t) response &key)
(write-response response :status 401 :content "unauthorized")))

(defgeneric bad-request (ty response &key)
(defgeneric bad-request-response (ty response &key)
(:documentation "Build a response for a type TY (:json, :html, t = html).
CONTENT is any object that is serialized accourding to the type.")
(:method ((ty t) response &key)
(write-response response :status 400 :content "bad request")))

(defgeneric redirect-see-other (ty response location &key)
(defgeneric redirect-see-other-response (ty response location &key)
(:documentation "Build a response for a type TY (:json, :html, t = html).
CONTENT is any object that is serialized accourding to the type.")
(:method ((ty t) response location &key)
Expand Down
72 changes: 70 additions & 2 deletions routing/test.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,10 +3,12 @@
(:import-from #:cl-hash-util
#:hash-create)
(:import-from #:wst.routing
#:response-headers
#:write-response
#:ok-response
#:dispatch-route-by-name
#:response-data
#:response-content
#:success-response
#:make-request
#:add-route
#:remove-route
Expand All @@ -20,7 +22,7 @@

(route test-route :GET "/testing-route" (request response)
(declare (ignorable request))
(success-response t response :content "ok"))
(ok-response t response :content "ok"))

(5am:def-test route-was-compiled ()
(5am:is-true (fboundp 'test-route)))
Expand Down Expand Up @@ -250,3 +252,69 @@
:method :POST))
(5am:is (= count 0))
(setf wst.routing::*any-route-handler* nil)))

(5am:def-test respond-with-internal-server-error ()
(wst.routing:any-route-handler :GET (lambda (request response)
(declare (ignorable request))
(wst.routing:internal-server-error-response t response)
response))
(5am:is (= 500 (wst.routing:response-status
(dispatch-route-by-name 'a (wst.routing:make-request :uri "/" :method :GET)))))
(setf wst.routing::*any-route-handler* nil))

(5am:def-test respond-with-unauthorized ()
(wst.routing:any-route-handler :GET (lambda (request response)
(declare (ignorable request))
(wst.routing:unauthorized-response t response)
response))
(5am:is (= 401 (wst.routing:response-status
(dispatch-route-by-name 'a (wst.routing:make-request :uri "/" :method :GET)))))
(setf wst.routing::*any-route-handler* nil))

(5am:def-test respond-with-forbidden ()
(wst.routing:any-route-handler :GET (lambda (request response)
(declare (ignorable request))
(wst.routing:forbidden-response t response)
response))
(5am:is (= 403 (wst.routing:response-status
(dispatch-route-by-name 'a (wst.routing:make-request :uri "/" :method :GET)))))
(setf wst.routing::*any-route-handler* nil))

(5am:def-test respond-with-bad-request ()
(wst.routing:any-route-handler :GET (lambda (request response)
(declare (ignorable request))
(wst.routing:bad-request-response t response)
response))
(5am:is (= 400 (wst.routing:response-status
(dispatch-route-by-name 'a (wst.routing:make-request :uri "/" :method :GET)))))
(setf wst.routing::*any-route-handler* nil))

(5am:def-test respond-with-redirect-see-other ()
(wst.routing:any-route-handler :GET (lambda (request response)
(declare (ignorable request))
(wst.routing:redirect-see-other-response t response "/redirect")
response))
(let ((rs (dispatch-route-by-name 'a (wst.routing:make-request :uri "/" :method :GET))))
(5am:is (= 303 (wst.routing:response-status rs)))
(5am:is (string-equal (getf (wst.routing:response-headers rs) :location)
"/redirect"))
(setf wst.routing::*any-route-handler* nil)))

(defmethod wst.routing:ok-response ((ty (eql :sexp)) response &key headers content)
(declare (ignorable headers))
(write-response response :status 200
:content-type "application/s-expression"
:headers headers
:content (format nil "~a" content)))

(5am:def-test respond-with-custom-responder ()
(wst.routing:any-route-handler :GET (lambda (request response)
(declare (ignorable request))
(ok-response :sexp response :content (list 1 2 3))
response))
(let ((rs (dispatch-route-by-name 'a (wst.routing:make-request :uri "/" :method :GET))))
(5am:is (= 200 (wst.routing:response-status rs)))
(5am:is (string-equal (getf (response-headers rs) :content-type)
"application/s-expression"))
(5am:is (equal (response-content rs) "(1 2 3)"))
(setf wst.routing::*any-route-handler* nil)))

0 comments on commit 72214fa

Please sign in to comment.