mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-22 03:30:22 +02:00
(web response) and (web request): bodies are bytevectors
* module/web/request.scm (read-request-body, write-request-body): Rename from read-request-body/bytevector and write-request-body/bytevector. Remove the /latin-1 variants, as they were unused and a bad idea. * module/web/response.scm (read-response-body, write-response-body): Likewise. * module/web/server/http.scm (http-read, http-write): Adapt to request/response change. * test-suite/tests/web-request.test: * test-suite/tests/web-response.test: Update tests.
This commit is contained in:
parent
ff8339db69
commit
3475fbb572
5 changed files with 22 additions and 104 deletions
|
@ -51,11 +51,8 @@ Accept-Language: en-gb, en;q=0.9\r
|
|||
|
||||
(pass-if (equal? (request-uri r) (build-uri 'http #:path "/qux")))
|
||||
|
||||
(pass-if (equal? (read-request-body/latin-1 r) #f))
|
||||
;; Since it's #f, should be an idempotent read, so we can try
|
||||
;; bytevectors too
|
||||
(pass-if (equal? (read-request-body/bytevector r) #f))
|
||||
|
||||
(pass-if (equal? (read-request-body r) #f))
|
||||
|
||||
(pass-if "checking all headers"
|
||||
(equal?
|
||||
(request-headers r)
|
||||
|
|
|
@ -20,6 +20,7 @@
|
|||
(define-module (test-suite web-response)
|
||||
#:use-module (web uri)
|
||||
#:use-module (web response)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (srfi srfi-19)
|
||||
#:use-module (test-suite lib))
|
||||
|
||||
|
@ -53,9 +54,9 @@ abcdefghijklmnopqrstuvwxyz0123456789")
|
|||
(set! r (read-response (open-input-string example-1)))
|
||||
(response? r)))
|
||||
|
||||
(pass-if "read-response-body/latin-1"
|
||||
(pass-if "read-response-body"
|
||||
(begin
|
||||
(set! body (read-response-body/latin-1 r))
|
||||
(set! body (read-response-body r))
|
||||
#t))
|
||||
|
||||
(pass-if (equal? (response-version r) '(1 . 1)))
|
||||
|
@ -64,7 +65,9 @@ abcdefghijklmnopqrstuvwxyz0123456789")
|
|||
|
||||
(pass-if (equal? (response-reason-phrase r) "OK"))
|
||||
|
||||
(pass-if (equal? body "abcdefghijklmnopqrstuvwxyz0123456789"))
|
||||
(pass-if (equal? body
|
||||
(string->utf8
|
||||
"abcdefghijklmnopqrstuvwxyz0123456789")))
|
||||
|
||||
(pass-if "checking all headers"
|
||||
(equal?
|
||||
|
@ -88,10 +91,10 @@ abcdefghijklmnopqrstuvwxyz0123456789")
|
|||
(with-output-to-string
|
||||
(lambda ()
|
||||
(let ((r (write-response r (current-output-port))))
|
||||
(write-response-body/latin-1 r body))))
|
||||
(write-response-body r body))))
|
||||
(lambda ()
|
||||
(let ((r (read-response (current-input-port))))
|
||||
(values r (read-response-body/latin-1 r))))))
|
||||
(values r (read-response-body r))))))
|
||||
(lambda (r* body*)
|
||||
(responses-equal? r body r* body*))))
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue