blob: be50fc8b84c4f089d588de9e952ad308e3c2b335 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
(asdf:load-system "lazybones-hunchentoot")
(defpackage #:lazybones-test
(:use #:cl)
(:local-nicknames (#:lzb #:lazybones))
(:import-from #:lazybones
#:defendpoint*
#:http-ok
#:http-err))
(in-package :lazybones-test)
;; first make a server and add some custom error responses
(defvar *server* (lzb:create-server :port 8888))
(defun custom-404 ()
(format nil "~a wasn't found :(" (lzb:request-path))) ; can use request functiosn
(defun custom-403 ()
"You, in particular, can't do that. :P ")
(defun custom-500 ()
"Bah. Error.")
(lzb:set-canned-response *server* 404 'custom-404 "text/plain" )
(lzb:set-canned-response *server* 403 'custom-403 "text/plain" )
(lzb:set-canned-response *server* 500 'custom-500 "text/plain")
;; PPROVISION-APP makes an app. You can supply an optional name, a symbol.
;; In lieu of a supplied name, the name of the package is used as the app's name.
(lzb:provision-app ()
:title "Lazybones Demo App"
:version "0.0.0"
:description "Just an API that defines some endpoints. These
endpoints aren't meant to accomplish anything. merely to test out
the lazybones HTTP routing framework."
:content-type "text/plain" ; default content type of server responses.
:auth 'post-authorizer) ; default authorizor for requests that need it
(defun post-authorizer ()
"Request is authorized if it contains the right TESTAPPSESSION
cookie. Obtain such a cookie by posting to the /login endpoint."
(string-equal "coolsessionbro" (lzb:request-cookie "testappsession")))
;; now we install the app to the server
(lzb:install-app *server* (lzb:app)) ; (app) is the default app for this package
;; DEFENDPOINT* is a macro to define an endpoint and install it into the
;; app whose name is the current package anme. DEFENDPOINT (without the *)
;; allows you to explictly specify the app where the endpoint is installed.
(defendpoint* :post "/login" () ()
"Dummy login endpoint for returning a session cookie. Always returns
the \"true\" and sends a set-cookie header, setting 'testappsession'
to 'coolsessionbro'."
(print (lzb:request-body)) ; dummy implementation, prints post body to stdout
(setf (lzb:response-cookie "testappsession") "coolsessionbro")
(http-ok "true"))
(defendpoint* :get "/hello/:who:" () ()
"Just says hello to WHO"
(http-ok (format nil "Hello ~a" who)))
(defendpoint* :post "/hello/:who:" () (:auth t) ; use the default authorizor for the app
"Post something to hello who"
(print (lzb:request-header :content-type))
(let ((body (lzb:request-body)))
(http-ok (format nil "Hello ~a, I got your message ~a"
who body))))
(defendpoint* :get "/search" ((name identity) (age to-int)) ()
"Echo the search parameters in a nice list."
(http-ok (format nil "Name: ~a~%age: ~a~%" name age)))
(defun crapshoot-authorizer () ()
"Randomly decides that the request is authorized"
(< 5 (random 10)))
(defendpoint* :post "/search" () (:auth 'crapshoot-authorizer) ; use custom authorizer
"Echo the search parameters in a nice list, but also has a post-body"
(http-ok
(with-output-to-string (out)
(format out "Query Was:~%~{~a is ~a~%~}~%"
(loop for (x . y) in (lzb:request-parameters)
collect x
collect y))
(terpri)
(format out "Decoded Post Body: ~s~%" (lzb:request-body)))))
(defun to-int (string)
"An Integer"
(parse-integer string))
;; route variables can accept parsers / preformatters
;; these will parse a value and supply it to the argument of the handler.
;; int eh following CATEGORY is an int
(defendpoint* :get "/search/:category to-int:" () ()
"Echo the search back, but in a specific category"
(assert (typep category 'integer)) ; just to show you.
(http-ok
(format nil "Searching in ~a with parameters:~%~{~a = ~a~%~}~%"
category
(loop for (x . y) in (lzb:request-parameters)
collect x
collect y))))
(defun person-by-id (id)
"A Person Instance"
;; The real thing might perform some database operation here. If the
;; operation failed, an error could be signalled, in which case a
;; 500 response would be sent to the client.
(list :name "Colin" :occupation "Macrologist" :id (parse-integer id)))
(defendpoint* :get "/person/:person person-by-id:" () (:content-type "application/json")
"Returns a json representation of the person."
(http-ok
(jonathan:to-json person)))
|
