diff --git a/module/web/request.scm b/module/web/request.scm index aa807d92a..91cc59da4 100644 --- a/module/web/request.scm +++ b/module/web/request.scm @@ -146,7 +146,7 @@ (if (not (null? 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 '()) (validate-headers? #t)) "Construct an HTTP request object. If @var{validate-headers?} is true, diff --git a/module/web/response.scm b/module/web/response.scm index c87f881a0..2cabd4f85 100644 --- a/module/web/response.scm +++ b/module/web/response.scm @@ -33,7 +33,6 @@ response-port read-response build-response - extend-response adapt-response-version write-response @@ -123,20 +122,6 @@ the headers are each run through their respective validators." (validate-headers headers)))) (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* '((100 . "Continue") (101 . "Switching Protocols") @@ -190,8 +175,7 @@ reason phrase for the response's code." (code->reason-phrase (response-code response)))) (define (read-response port) - "Read an HTTP response from @var{port}, optionally attaching the given -metadata, @var{meta}. + "Read an HTTP response from @var{port}. 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 diff --git a/module/web/server.scm b/module/web/server.scm index 02d01b088..4715cae69 100644 --- a/module/web/server.scm +++ b/module/web/server.scm @@ -187,6 +187,17 @@ values." (lambda (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 (define (sanitize-response request response body) "\"Sanitize\" the given response and body, making them appropriate for