aboutsummaryrefslogtreecommitdiff
path: root/lazybones-hunchentoot.lisp
blob: 1e62b859c77a2d02d2d441699743b83012a350d0 (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
;;;; 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-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))

;;; 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)))