blob: 8f9b604042536bfc21becfc47ccb54bb21aab89f (
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
;;;; lazybones-hunchentoot.lisp -- hunchentoot backend for lazybones
(defpackage #:lazybones.backend/hunchentoot
(:use #:cl #:lazybones.backend)
(:local-nicknames (#:h #:hunchentoot)
(#:lzb #:lazybones)
(#:a #:alexandria)))
(in-package :lazybones.backend/hunchentoot)
;;; HTTP REQUEST READERS
(defun request-path (&optional (request *request* ))
"Returns the PATH part of the REQUEST URL.
See Also: https://en.wikipedia.org/wiki/URL#Syntax."
(h:script-name request))
(defun request-host (&optional (request *request*))
"Returns the HOST part of the REQUEST URL.
See Also: https://en.wikipedia.org/wiki/URL#Syntax"
(h:host request))
(defun request-url (&optional (request *request*))
"Returns the full url of REQUST"
(h:request-uri* request))
(defun request-port (&optional (request *request*))
"The port associated with REQUEST."
(h:local-port* request))
(defun request-query-string (&optional (request *request*))
"Returns the full query string of the URL associated with REQUEST
See Also: https://en.wikipedia.org/wiki/URL#Syntax"
(h:query-string request))
(defun request-parameter (name &optional (request *request*))
"Returns the the value of the query parameter named NAME, or NIL
if there there is none."
(h:get-parameter name request))
(defun request-parameters (&optional (request *request*))
"Returns an alist of parameters associated with REQUEST. Each
member of the list looks like (NAME . VALUE) where both are strings."
(h:get-parameters request))
(defun request-headers (&optional (request *request*))
"Returns an alist of headers associated with REQUEST. Each member of
the list looks like (HEADER-NAME . VALUE) where HEADER-NAME is a
keyword or a string and VALUE is a string."
(h:headers-in request))
(defun request-header (header-name &optional (request *request*))
"Returns the string value of the REQUEST header named HEADER-NAME.
HEADER-NAME can be a keyword or a string."
(h:header-in header-name request))
(defun request-cookie (name &optional (request *request*))
"Returns the cookie with NAME sent with the REQUEST"
(h:cookie-in name request))
(defun request-method (&optional (request *request*))
"Returns a keyword representing the http method of the request."
(h:request-method request))
(defparameter +hunchentoot-pre-decoded-content-types+
'("multipart/form-data" "application/x-www-form-urlencoded"))
(defun pre-decoded-body-p (request)
(member (request-header :content-type request)
+hunchentoot-pre-decoded-content-types+
:test #'string-equal))
(defparameter +hunchentoot-methods-with-body+
'(:post :put :patch))
(defun request-body (&key (request *request*) (want-stream-p nil))
"Returns the decoded request body. The value returned depends upon
the value of the Content-Type request header."
(when (member (request-method request) +hunchentoot-methods-with-body+)
(let ((pre-decoded-body-p
(pre-decoded-body-p request))
(content-type
(request-header :content-type request)))
(cond
;; try to get a stream on request
(want-stream-p
;; can't do it if the body is already decoded - return nil so
;; that request-body can be called again
(unless pre-decoded-body-p
(h:raw-post-data :request request :want-stream t)))
(pre-decoded-body-p
(format-as-lazybones-document
(h:post-parameters request)))
((string-equal "application/json" content-type)
(jonathan:parse
(h:raw-post-data :request request :external-format :utf8 ))) ; TODO don't hardcode the format
(t
;; default case is to return a bytevector
(h:raw-post-data :request request :force-binary t))))))
(defun format-as-lazybones-document (post-parameters)
"internal function. Formats all the post parmaeters (see docstring
on hunchentoot:post-parameters) into a plist with keyword keys, as
is the convention for lazybones."
(loop for (k . value) in post-parameters
collect (alexandria:make-keyword k)
collect value))
;;; HTTP RESPONSE ACCESSORS
(defun response-code (&optional (response *response*))
"Access the return code of the resposne. Return code should be an integer."
(h:return-code response))
(defun (setf response-code) (code &optional (response *response*))
(setf (h:return-code response) code))
(defun resonse-header (name &optional (response *response*))
"Access the response header that has NAME, which can be a keyword (recommended) or a string."
(h:header-out name response))
(defun (setf response-header) (value name &optional (response *response*))
(setf (h:header-out name response) value))
(defun response-cookie (name &optional (response *response*))
"Access the cookie with NAME in the response object."
(h:cookie-out name response))
(defun (setf response-cookie) (value name &optional (response *response*))
(a:if-let (extant-cookie (assoc name (h:cookies-out response) :test #'string=))
(setf (cdr extant-cookie) value)
(cadar (setf (h:cookies-out response)
(cons (cons name value) (h:cookies-out response))))))
(defun http-respond (code content)
(setf (response-code) code
(response-header :content-type) (or (response-header :content-type content-type)
(when (pathnamep content)
(h:mime-type content))
(default-content-type *app*)
(error "Content Type Not Set")))
(if (pathnamep content)
(h:handle-static-file content)
content))
;;; Hunchentoot Acceptor Subclass
(defclass lazybones-acceptor (h:acceptor)
((installed-apps
:accessor acceptor-apps
:initform nil
:documentation "Instances of LAZYBONES:APP installed to this
acceptor. APPs are, among other things, collections of ENDPOINT
instances. The acceptor instance uses them to dispatch handlers
on requests."))
(:default-initargs
:address "0.0.0.0"))
(defmethod h:acceptor-dispatch-request ((acceptor lazybones-acceptor) request)
(loop for app in (acceptor-apps acceptor)
for (endpoint . args) = (lzb:find-endpoint app request)
when endpoint
return (lzb:run-endpoint endpoint args request h:*reply* app)
;; if no endpoint was found, call next method.
finally (call-next-method)))
|
