summaryrefslogtreecommitdiff
path: root/guix/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-08-29 16:01:32 +0200
committerLudovic Courtès <ludo@gnu.org>2019-09-02 15:25:01 +0200
commit9323ab550f3bcb75fcaefbb20847595974702d5b (patch)
treecbe344ca4cc0db1da258e89ba017767084a5126a /guix/tests
parentd34e9114e679666dfbf7caf577117010eca20520 (diff)
tests: 'with-http-server' accepts multiple responses.
* guix/tests/http.scm (call-with-http-server): Replace 'code' and 'data' parameters with 'responses+data'. Compute RESPONSES as a function of that. Remove #:headers parameter. [http-write]: Quit only when RESPONSES is empty. [server-body]: Get the response and data from RESPONSES, and set it to point to the rest. (with-http-server): Adjust accordingly. * tests/derivations.scm ("'download' built-in builder") ("'download' built-in builder, invalid hash") ("'download' built-in builder, not found") ("'download' built-in builder, check mode"): Adjust to new 'with-http-server' interface. * tests/lint.scm ("home-page: 200") ("home-page: 200 but short length") ("home-page: 404", "home-page: 301, invalid"): ("home-page: 301 -> 200", "home-page: 301 -> 404") ("source: 200", "source: 200 but short length") ("source: 404", "source: 404 and 200") ("source: 301 -> 200", "source: 301 -> 404"): ("github-url", github-url): Likewise. * tests/swh.scm (with-json-result) ("lookup-origin, not found"): Likewise.
Diffstat (limited to 'guix/tests')
-rw-r--r--guix/tests/http.scm39
1 files changed, 24 insertions, 15 deletions
diff --git a/guix/tests/http.scm b/guix/tests/http.scm
index a56d6f213d..05ce39bca2 100644
--- a/guix/tests/http.scm
+++ b/guix/tests/http.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -22,6 +22,7 @@
#:use-module (web server http)
#:use-module (web response)
#:use-module (srfi srfi-39)
+ #:use-module (ice-9 match)
#:export (with-http-server
call-with-http-server
%http-server-port
@@ -69,10 +70,20 @@ needed."
(string-append "http://localhost:" (number->string (%http-server-port))
"/foo/bar"))
-(define* (call-with-http-server code data thunk
- #:key (headers '()))
- "Call THUNK with an HTTP server running and returning CODE and DATA (a
-string) on HTTP requests."
+(define* (call-with-http-server responses+data thunk)
+ "Call THUNK with an HTTP server running and returning RESPONSES+DATA on HTTP
+requests. Each elements of RESPONSES+DATA must be a tuple containing a
+response and a string, or an HTTP response code and a string."
+ (define responses
+ (map (match-lambda
+ (((? response? response) data)
+ (list response data))
+ (((? integer? code) data)
+ (list (build-response #:code code
+ #:reason-phrase "Such is life")
+ data)))
+ responses+data))
+
(define (http-write server client response body)
"Write RESPONSE."
(let* ((response (write-response response client))
@@ -82,7 +93,8 @@ string) on HTTP requests."
(else
(write-response-body response body)))
(close-port port)
- (quit #t) ;exit the server thread
+ (when (null? responses)
+ (quit #t)) ;exit the server thread
(values)))
;; Mutex and condition variable to synchronize with the HTTP server.
@@ -105,10 +117,10 @@ string) on HTTP requests."
(define (server-body)
(define (handle request body)
- (values (build-response #:code code
- #:reason-phrase "Such is life"
- #:headers headers)
- data))
+ (match responses
+ (((response data) rest ...)
+ (set! responses rest)
+ (values response data))))
(let ((socket (open-http-server-socket)))
(catch 'quit
@@ -126,10 +138,7 @@ string) on HTTP requests."
(define-syntax with-http-server
(syntax-rules ()
- ((_ (code headers) data body ...)
- (call-with-http-server code data (lambda () body ...)
- #:headers headers))
- ((_ code data body ...)
- (call-with-http-server code data (lambda () body ...)))))
+ ((_ responses+data body ...)
+ (call-with-http-server responses+data (lambda () body ...)))))
;;; http.scm ends here