/
http.scm
74 lines (61 loc) · 2.94 KB
/
http.scm
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
(use srfi-13)
(declare (unit http))
(declare (uses http-intern))
(declare (uses services))
;; encapsulates a http binding
(define-record
http-binding
method
route
content-type
service
parse-request-procedure
format-response-procedure)
;; use the application's http bindings
(declare (uses delete-customer-service-http-binding))
(declare (uses get-customer-service-http-binding))
(declare (uses get-customers-service-http-binding))
(declare (uses new-customer-service-http-binding))
(declare (uses update-customer-service-http-binding))
;; makes the application's http bindings
(define (make-http-bindings)
(list
(make-delete-customer-service-http-binding)
(make-get-customer-service-http-binding)
(make-get-customers-service-http-binding)
(make-new-customer-service-http-binding)
(make-update-customer-service-http-binding)))
;; handles a http request
(define (http-handle-request fastcgi-request*)
;; get the environment pointers
(let ((fastcgi-environment* (fastcgi-request-environment fastcgi-request*))
(fastcgi-input-stream* (fastcgi-request-input-stream fastcgi-request*))
(fastcgi-output-stream* (fastcgi-request-output-stream fastcgi-request*)))
;; search a http binding match
;; for the method and route
(let* ((method (http-request-method fastcgi-environment*))
(route (http-request-route fastcgi-environment*))
(http-binding-match (search-http-binding-match method route)))
(if (not http-binding-match)
(http-send-404-not-found fastcgi-output-stream*)
;; try to parse the request
(let* ((route-captures (http-binding-match-route-captures http-binding-match))
(parse-request-procedure (http-binding-match-parse-request-procedure http-binding-match))
(request-body (http-read-fastcgi-stream fastcgi-input-stream*))
(request (parse-request-procedure route-captures request-body)))
(if (not request)
(http-send-400-bad-request fastcgi-output-stream*)
;; invoke the service
(let ((service (http-binding-match-service http-binding-match)))
(invoke-service service request
;; send the response
(lambda (response)
(let* ((content-type (http-binding-match-content-type http-binding-match))
(format-response-procedure (http-binding-match-format-response-procedure http-binding-match))
(response-body (format-response-procedure response)))
(if (is-empty-json-object-string? response-body)
(http-send-204-no-content fastcgi-output-stream*)
(http-send-200-ok content-type response-body fastcgi-output-stream*))))
;; send the validation errors
(lambda (validation-errors)
(http-send-422-unprocessable-entity validation-errors fastcgi-output-stream*))))))))))