mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-12 14:50:19 +02:00
request and response cleanups
* module/web/request.scm (build-request): Make URI a positional argument. * module/web/response.scm: Remove extend-response. (read-response): Fix a docstring. * module/web/server.scm (extend-response): Include extend-response here, but not exported.
This commit is contained in:
parent
3475fbb572
commit
f944ee8f23
3 changed files with 13 additions and 18 deletions
|
@ -146,7 +146,7 @@
|
||||||
(if (not (null? headers))
|
(if (not (null? headers))
|
||||||
(bad-request "Headers not a list: ~a" headers))))
|
(bad-request "Headers not a list: ~a" headers))))
|
||||||
|
|
||||||
(define* (build-request #:key (method 'GET) uri (version '(1 . 1))
|
(define* (build-request uri #:key (method 'GET) (version '(1 . 1))
|
||||||
(headers '()) port (meta '())
|
(headers '()) port (meta '())
|
||||||
(validate-headers? #t))
|
(validate-headers? #t))
|
||||||
"Construct an HTTP request object. If @var{validate-headers?} is true,
|
"Construct an HTTP request object. If @var{validate-headers?} is true,
|
||||||
|
|
|
@ -33,7 +33,6 @@
|
||||||
response-port
|
response-port
|
||||||
read-response
|
read-response
|
||||||
build-response
|
build-response
|
||||||
extend-response
|
|
||||||
adapt-response-version
|
adapt-response-version
|
||||||
write-response
|
write-response
|
||||||
|
|
||||||
|
@ -123,20 +122,6 @@ the headers are each run through their respective validators."
|
||||||
(validate-headers headers))))
|
(validate-headers headers))))
|
||||||
(make-response version code reason-phrase headers port))
|
(make-response version code reason-phrase headers port))
|
||||||
|
|
||||||
(define (extend-response r k v . additional)
|
|
||||||
"Extend an HTTP response by setting additional HTTP headers @var{k},
|
|
||||||
@var{v}. Returns a new HTTP response."
|
|
||||||
(let ((r (build-response #:version (response-version r)
|
|
||||||
#:code (response-code r)
|
|
||||||
#:reason-phrase (%response-reason-phrase r)
|
|
||||||
#:headers
|
|
||||||
(assoc-set! (copy-tree (response-headers r))
|
|
||||||
k v)
|
|
||||||
#:port (response-port r))))
|
|
||||||
(if (null? additional)
|
|
||||||
r
|
|
||||||
(apply extend-response r additional))))
|
|
||||||
|
|
||||||
(define *reason-phrases*
|
(define *reason-phrases*
|
||||||
'((100 . "Continue")
|
'((100 . "Continue")
|
||||||
(101 . "Switching Protocols")
|
(101 . "Switching Protocols")
|
||||||
|
@ -190,8 +175,7 @@ reason phrase for the response's code."
|
||||||
(code->reason-phrase (response-code response))))
|
(code->reason-phrase (response-code response))))
|
||||||
|
|
||||||
(define (read-response port)
|
(define (read-response port)
|
||||||
"Read an HTTP response from @var{port}, optionally attaching the given
|
"Read an HTTP response from @var{port}.
|
||||||
metadata, @var{meta}.
|
|
||||||
|
|
||||||
As a side effect, sets the encoding on @var{port} to
|
As a side effect, sets the encoding on @var{port} to
|
||||||
ISO-8859-1 (latin-1), so that reading one character reads one byte. See
|
ISO-8859-1 (latin-1), so that reading one character reads one byte. See
|
||||||
|
|
|
@ -187,6 +187,17 @@ values."
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
(display str port)))))
|
(display str port)))))
|
||||||
|
|
||||||
|
(define (extend-response r k v . additional)
|
||||||
|
(let ((r (build-response #:version (response-version r)
|
||||||
|
#:code (response-code r)
|
||||||
|
#:headers
|
||||||
|
(assoc-set! (copy-tree (response-headers r))
|
||||||
|
k v)
|
||||||
|
#:port (response-port r))))
|
||||||
|
(if (null? additional)
|
||||||
|
r
|
||||||
|
(apply extend-response r additional))))
|
||||||
|
|
||||||
;; -> response body
|
;; -> response body
|
||||||
(define (sanitize-response request response body)
|
(define (sanitize-response request response body)
|
||||||
"\"Sanitize\" the given response and body, making them appropriate for
|
"\"Sanitize\" the given response and body, making them appropriate for
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue