blob: a822979e34d8fe3a9c8bd21fc53714795876030e (
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
|
(define-module (ldp response)
#:use-module (ldp path)
#:use-module (ldp resource)
#:use-module (web response))
(define-public (respond-not-found)
(values (build-response
#:code 404
#:reason-phrase "Not Found")
#f))
(define-public (respond-bad-request)
(values (build-response
#:code 400
#:reason-phrase "Bad Request")
#f))
(define-public (respond-not-modified)
(values (build-response
#:code 304
#:reason-phrase "Not Modified")
#f))
(define-public (respond-precondition-failed)
(values (build-response
#:code 412
#:reason-phrase "Precondition Failed")
#f))
(define-public (respond-conflict)
(values (build-response
#:code 409
#:reason-phrase "Conflict")
#f))
(define-public (respond-method-not-allowed)
(values (build-response
#:code 405
#:reason-phrase "Method Not Allowed")
#f))
(define-public (respond-to-error key . args)
(case key
((not-found)
(respond-not-found))
((bad-request)
(respond-bad-request))
((not-modified)
(respond-not-modified))
((precondition-failed)
(respond-precondition-failed))
((conflict cannot-delete-the-root)
(respond-conflict))
((method-not-allowed cannot-add-resources-in-non-container)
(respond-method-not-allowed))
(else
(apply throw key args))))
(define-public (respond-to-post resource)
(values (build-response
#:code 201
#:reason-phrase "Created"
#:headers `((location . ,(path->uri (resource-path resource)))))
#f))
(define-public (respond-to-put)
(values (build-response)
#f))
(define-public (respond-to-delete)
(values (build-response)
#f))
(define-public (respond-to-get resource data)
(values (build-response
#:headers `((content-type . (,(resource-content-type resource)))
(etag . ,(resource-etag resource))
(allow HEAD GET POST PUT DELETE OPTIONS)))
data))
(define-public (respond-to-head resource)
(values (build-response
#:headers `((content-type . (,(resource-content-type resource)))
(etag . ,(resource-etag resource))
(allow HEAD GET POST PUT DELETE OPTIONS)))
#f))
(define-public (respond-to-options resource)
(let ((allow
(cond ((is-root? (resource-path resource))
'(HEAD GET POST PUT OPTIONS))
((container? resource)
'(HEAD GET POST PUT DELETE OPTIONS))
(else
'(HEAD GET PUT DELETE OPTIONS)))))
(values (build-response
#:code 204
#:reason-phrase "No Content"
#:headers `((content-type . (,(resource-content-type resource)))
(etag . ,(resource-etag resource))
(allow . ,allow)))
#f)))
|
