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.

diff --git a/module/web/request.scm b/module/web/request.scm
index aa807d9..91cc59d 100644 (file)
--- 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 c87f881..2cabd4f 100644 (file)
--- 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 02d01b0..4715cae 100644 (file)
--- 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