summaryrefslogtreecommitdiff
path: root/module/web/client.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/web/client.scm')
-rw-r--r--module/web/client.scm32
1 files changed, 17 insertions, 15 deletions
diff --git a/module/web/client.scm b/module/web/client.scm
index 24132c674..3f6c45bfe 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -41,6 +41,8 @@
#:use-module (web uri)
#:use-module (web http)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
#:export (current-http-proxy
open-socket-for-uri
http-get
@@ -103,11 +105,9 @@
(loop (cdr addresses))))))))
(define (extend-request r k v . additional)
- (let ((r (build-request (request-uri r) #:version (request-version r)
- #:headers
- (assoc-set! (copy-tree (request-headers r))
- k v)
- #:port (request-port r))))
+ (let ((r (set-field r (request-headers)
+ (assoc-set! (copy-tree (request-headers r))
+ k v))))
(if (null? additional)
r
(apply extend-request r additional))))
@@ -136,6 +136,9 @@ as is the case by default with a request returned by `build-request'."
((not body)
(let ((length (request-content-length request)))
(if length
+ ;; FIXME make this stricter: content-length header should be
+ ;; prohibited if there's no body, even if the content-length
+ ;; is 0.
(unless (zero? length)
(error "content-length, but no body"))
(when (assq 'transfer-encoding (request-headers request))
@@ -171,7 +174,6 @@ as is the case by default with a request returned by `build-request'."
(rlen (if (= rlen blen)
request
(error "bad content-length" rlen blen)))
- ((zero? blen) request)
(else (extend-request request 'content-length blen))))
body))))
@@ -204,7 +206,7 @@ as is the case by default with a request returned by `build-request'."
(define* (request uri #:key
(body #f)
(port (open-socket-for-uri uri))
- (method "GET")
+ (method 'GET)
(version '(1 . 1))
(keep-alive? #f)
(headers '())
@@ -227,7 +229,7 @@ as is the case by default with a request returned by `build-request'."
(force-output (request-port request))
(let ((response (read-response port)))
(cond
- ((equal? (request-method request) "HEAD")
+ ((eq? (request-method request) 'HEAD)
(unless keep-alive?
(close-port port))
(values response #f))
@@ -282,7 +284,7 @@ true)."
(issue-deprecation-warning
"The #:extra-headers argument to http-get has been renamed to #:headers. "
"Please update your code."))
- (request uri #:method "GET" #:body body
+ (request uri #:method 'GET #:body body
#:port port #:version version #:keep-alive? keep-alive?
#:headers headers #:decode-body? decode-body?
#:streaming? streaming?))
@@ -319,7 +321,7 @@ true)."
#:streaming? streaming?)))
(define-http-verb http-head
- "HEAD"
+ 'HEAD
"Fetch message headers for the given URI using the HTTP \"HEAD\"
method.
@@ -332,7 +334,7 @@ requests do not have a body. The second value is only returned so that
other procedures can treat all of the http-foo verbs identically.")
(define-http-verb http-post
- "POST"
+ 'POST
"Post data to the given URI using the HTTP \"POST\" method.
This function is similar to ‘http-get’, except it uses the \"POST\"
@@ -342,7 +344,7 @@ arguments that are accepted by this function.
Returns two values: the resulting response, and the response body.")
(define-http-verb http-put
- "PUT"
+ 'PUT
"Put data at the given URI using the HTTP \"PUT\" method.
This function is similar to ‘http-get’, except it uses the \"PUT\"
@@ -352,7 +354,7 @@ arguments that are accepted by this function.
Returns two values: the resulting response, and the response body.")
(define-http-verb http-delete
- "DELETE"
+ 'DELETE
"Delete data at the given URI using the HTTP \"DELETE\" method.
This function is similar to ‘http-get’, except it uses the \"DELETE\"
@@ -362,7 +364,7 @@ arguments that are accepted by this function.
Returns two values: the resulting response, and the response body.")
(define-http-verb http-trace
- "TRACE"
+ 'TRACE
"Send an HTTP \"TRACE\" request.
This function is similar to ‘http-get’, except it uses the \"TRACE\"
@@ -372,7 +374,7 @@ arguments that are accepted by this function.
Returns two values: the resulting response, and the response body.")
(define-http-verb http-options
- "OPTIONS"
+ 'OPTIONS
"Query characteristics of an HTTP resource using the HTTP \"OPTIONS\"
method.