[PATCH 0/9] Replace some mocking with with-http-server*, avoid hardcoding ports,

OpenSubmitted by Maxime Devos.
Details
2 participants
  • Ludovic Courtès
  • Maxime Devos
Owner
unassigned
Severity
normal
M
M
Maxime Devos wrote on 20 Jan 13:59 +0100
(address . guix-patches@gnu.org)
6b1c1d98514b2547907a81a04c1241d9b865d6fa.camel@telenet.be
X-Debbugs-CC: ludo@gnu.org

Hi,

This patch series addresses:

Ludovic Courtès schreef op zo 16-01-2022 om 23:19 [+0100]:
Toggle quote (7 lines)
> I think the whole point of having the ‘%github-api’ parameter is that
> it allows us to mock the HTTP server instead of having to override
> bindings such as ‘http-fetch’.
>
> I’d have a slight preference for doing that, similar to what is done
> in tests/cpan.scm for instance. WDYT?


by extending with-http-server to with-http-server* to allow arbitrary
request handlers and extending with-http-server to allow verifying the
URI of a request.

tests/cpan.scm has been modified to verify the URIs.
tests/import-github.scm and tests/minetest.scm have been modified to
avoid mocking.

Somewhat unrelated, tests/lint.scm, tests/cpan.scm and
tests/challenge.scm have been modified to avoid hard coding ports,
as a follow-up to commit c05ceaf2b650d090cf39a048193505cb4e6bd257:

[...]
Previously, test cases could fail if some process was listening
at a hard-coded port. This patch eliminates most of these
potential failures, by automatically assigning an unbound port. 
This should allow for building multiple guix trees in parallel
outside a build container, though this is currently untested.
[...]

After this patch series, there's to my knowledge only one instance of
hardcoded ports remaining, in tests/lint.scm ("home-page: Connection
refused").

This patch series is also available at
more-precise-http-tests, commit
f0a0303c17b5aa92493aea5a6d28183421b7cf44).

Greetings,
Maxime.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYelcpBccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7irMAPwNeTw/NNF7cXaGMZlTV+D1k3p6
xFhNYna2mBtbycMXDwEAkcl04r0yhSxeFWzFd39Wtq0MbnlmB1iBu48nwDIQoA4=
=56SL
-----END PGP SIGNATURE-----


M
M
Maxime Devos wrote on 20 Jan 14:08 +0100
[PATCH 3/9] tests/minetest: Run a HTTP server instead of mocking.
(address . 53389@debbugs.gnu.org)
20220120130849.292178-3-maximedevos@telenet.be

Unfortunately, for some unknown reason (a limitation of (guix tests http)
perhaps?), parallelism causes ECONNREFUSED in tests but not in the wild,
so 'par-map' has to be mocked for now.

* tests/minetest.scm (call-with-packages): Avoid mocking by running an
actual HTTP server.
* guix/import/minetest.scm (par-map): Allow mocking the Minetest importer's
use of par-map without impacting anything else.

Suggested-by: Ludovic Courtès <ludo@gnu.org>
---
guix/import/minetest.scm | 5 ++-
tests/minetest.scm | 82 ++++++++++++++++++++++++----------------
2 files changed, 53 insertions(+), 34 deletions(-)

Toggle diff (151 lines)
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index 3b2cdcdcac..3eab5f703f 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -19,7 +19,6 @@
 (define-module (guix import minetest)
   #:use-module (ice-9 match)
   #:use-module (ice-9 receive)
-  #:use-module (ice-9 threads)
   #:use-module (ice-9 hash-table)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-2)
@@ -69,6 +68,10 @@
 (define (delete-cr text)
   (string-delete #\cr text))
 
+;; Mocked by tests.
+(define par-map (@ (ice-9 threads) par-map))
+(set! par-map par-map)
+
 
 
 ;;;
diff --git a/tests/minetest.scm b/tests/minetest.scm
index cbb9e83889..bdd8bd0645 100644
--- a/tests/minetest.scm
+++ b/tests/minetest.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,6 +23,7 @@
   #:use-module (guix import minetest)
   #:use-module (guix import utils)
   #:use-module (guix tests)
+  #:use-module (guix tests http)
   #:use-module (guix packages)
   #:use-module (guix git-download)
   #:use-module ((gnu packages minetest)
@@ -30,6 +31,9 @@
   #:use-module ((gnu packages base)
                 #:select (hello))
   #:use-module (json)
+  #:use-module (web request)
+  #:use-module (web uri)
+  #:use-module (web client)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
@@ -152,7 +156,7 @@
   (invalidate-memoization! minetest->guix-package)
   (define (scm->json-port scm)
     (open-input-string (scm->json-string scm)))
-  (define (handle-package url requested-author requested-name . rest)
+  (define (handle-package subresource requested-author requested-name . rest)
     (define relevant-argument-list
       (any (lambda (argument-list)
              (apply (lambda* (#:key (author "Author") (name "foo")
@@ -164,14 +168,15 @@
            argument-lists))
     (when (not relevant-argument-list)
       (error "the package ~a/~a should be irrelevant, but ~a is fetched"
-             requested-author requested-name url))
-    (scm->json-port
-     (apply (match rest
-              (("") make-package-json)
-              (("dependencies" "") make-dependencies-json)
-              (("releases" "") make-releases-json)
-              (_ (error "TODO ~a" rest)))
-            relevant-argument-list)))
+             requested-author requested-name subresource))
+    (define json (apply
+                  (match rest
+                    (("") make-package-json)
+                    (("dependencies" "") make-dependencies-json)
+                    (("releases" "") make-releases-json)
+                    (_ (error "TODO ~a" rest)))
+                  relevant-argument-list))
+    (values '() (lambda (port) (scm->json json port))))
   (define (handle-mod-search sort)
     ;; Produce search results, sorted by SORT in descending order.
     (define arguments->key
@@ -191,29 +196,40 @@
              ("name" . ,name)
              ("type" . ,type))))
     (define argument-list->json (cut apply arguments->json <>))
-    (scm->json-port
-     (list->vector (filter-map argument-list->json sorted-argument-lists))))
-  (mock ((guix http-client) http-fetch
-         (lambda* (url #:key headers)
-           (unless (string-prefix? "mock://api/packages/" url)
-             (error "the URL ~a should not be used" url))
-           (define resource
-             (substring url (string-length "mock://api/packages/")))
-           (define components (string-split resource #\/))
-           (match components
-             ((author name . rest)
-              (apply handle-package url author name rest))
-             (((? (cut string-prefix? "?type=mod&q=" <>) query))
-              (handle-mod-search
-               (cond ((string-contains query "sort=score") "score")
-                     ((string-contains query "sort=downloads") "downloads")
-                     (#t (error "search query ~a has unknown sort key"
-                                query)))))
-             (_
-              (error "the URL ~a should have an author and name component"
-                     url)))))
-        (parameterize ((%contentdb-api "mock://api/"))
-          (thunk))))
+    (define json
+      (list->vector (filter-map argument-list->json sorted-argument-lists)))
+    (values '()
+            (lambda (port) (scm->json json port))))
+  (with-http-server*
+   (lambda (request _)
+     (unless (eq? 'GET (request-method request))
+       (error "wrong HTTP method"))
+     (define resource (uri-path (request-uri request)))
+     (unless (string-prefix? "/api/packages/" resource)
+       (error "the resource ~a should not be used" resource))
+     (define subresource
+       (substring resource (string-length "/api/packages/")))
+     (define components (string-split subresource #\/))
+     (match components
+       ((author name . rest)
+        (apply handle-package subresource author name rest))
+       (("")
+        (let ((query (uri-query (request-uri request))))
+          (handle-mod-search
+           (cond ((string-contains query "sort=score") "score")
+                 ((string-contains query "sort=downloads") "downloads")
+                 (#t (error "search query ~a has unknown sort key"
+                            query))))))
+       (_
+        (error "the resource ~a should have an author and name component"
+               resource))))
+   (parameterize ((%contentdb-api
+                   (format #f "http://localhost:~a/api/" (%http-server-port)))
+                  (current-http-proxy #f))
+     ;; XXX: for some unknown reason, parallelism causes ECONNREFUSED in
+     ;; tests but not in the wild.
+     (mock ((guix import minetest) par-map map)
+           (thunk)))))
 
 (define* (minetest->guix-package* #:key (author "Author") (name "foo")
                                   (sort %default-sort-key)
-- 
2.30.2
M
M
Maxime Devos wrote on 20 Jan 14:08 +0100
[PATCH 2/9] tests: Generalise %local-url.
(address . 53389@debbugs.gnu.org)
20220120130849.292178-2-maximedevos@telenet.be
* guix/tests/http.scm (%local-url): Extract most functionality to ...
(%local-url*): ... here and don't hardcode "/foo/bar".
---
guix/tests/http.scm | 9 ++++++---
1 file changed, 6 insertions(+), 3 deletions(-)

Toggle diff (32 lines)
diff --git a/guix/tests/http.scm b/guix/tests/http.scm
index c42b4b8176..2f65df4029 100644
--- a/guix/tests/http.scm
+++ b/guix/tests/http.scm
@@ -31,6 +31,7 @@
             call-with-http-server
             call-with-http-server*
             %http-server-port
+            %local-url*
             %local-url))
 
 ;;; Commentary:
@@ -64,12 +65,14 @@ actually listened at (in case %http-server-port was 0)."
                 (strerror err))
         (values #f #f)))))
 
-(define* (%local-url #:optional (port (%http-server-port)))
+(define* (%local-url* resource #:optional (port (%http-server-port)))
+  ;; The URL to the resource named RESOURCE on the current HTTP server.
   (when (= port 0)
     (error "no web server is running!"))
+  (string-append "http://localhost:" (number->string port) resource))
+(define* (%local-url #:optional (port (%http-server-port)))
   ;; URL to use for 'home-page' tests.
-  (string-append "http://localhost:" (number->string port)
-                 "/foo/bar"))
+  (%local-url* "/foo/bar" port))
 
 (define* (call-with-http-server* handle thunk #:key (keep-lingering? #false)
                                  (last-response? (const #false)))
-- 
2.30.2
M
M
Maxime Devos wrote on 20 Jan 14:08 +0100
[PATCH 6/9] tests/lint: Do not assume the next port is free.
(address . 53389@debbugs.gnu.org)
20220120130849.292178-6-maximedevos@telenet.be
This is a follow-up to commit 4aea90b1876179aab8d603a42533a6bdf97ccd3c.

* tests/lint.scm ("source: 404 and 200"): Let (guix tests http) choose the
ports to bind to.
---
tests/lint.scm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)

Toggle diff (15 lines)
diff --git a/tests/lint.scm b/tests/lint.scm
index 76c2a70b3a..00d494bd19 100644
--- a/tests/lint.scm
+++ b/tests/lint.scm
@@ -987,7 +987,7 @@
   '()
   (with-http-server `((404 ,%long-string))
     (let ((bad-url (%local-url)))
-      (parameterize ((%http-server-port (+ 1 (%http-server-port))))
+      (parameterize ((%http-server-port 0))
         (with-http-server `((200 ,%long-string))
           (let ((pkg (package
                        (inherit (dummy-package "x"))
-- 
2.30.2
M
M
Maxime Devos wrote on 20 Jan 14:08 +0100
[PATCH 5/9] tests/cpan: Do not hard code a HTTP port.
(address . 53389@debbugs.gnu.org)
20220120130849.292178-5-maximedevos@telenet.be
This is a follow-up to commit 4aea90b1876179aab8d603a42533a6bdf97ccd3c.

* tests/cpan.scm: Don't set %http-server-port.
---
tests/cpan.scm | 3 ---
1 file changed, 3 deletions(-)

Toggle diff (16 lines)
diff --git a/tests/cpan.scm b/tests/cpan.scm
index b4db9e60e4..89e6be0b4f 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -58,9 +58,6 @@
 (define test-source
   "foobar")
 
-;; Avoid collisions with other tests.
-(%http-server-port 10400)
-
 (test-begin "cpan")
 
 (test-assert "cpan->guix-package"
-- 
2.30.2
M
M
Maxime Devos wrote on 20 Jan 14:08 +0100
[PATCH 4/9] tests/import-github: Run a HTTP server instead of mocking.
(address . 53389@debbugs.gnu.org)
20220120130849.292178-4-maximedevos@telenet.be

* tests/import-github.scm (call-with-releases): Run a HTTP server instead of
mocking.

Suggested-by: Ludovic Courtès <ludo@gnu.org>
---
tests/import-github.scm | 34 ++++++++++++++++------------------
1 file changed, 16 insertions(+), 18 deletions(-)

Toggle diff (53 lines)
diff --git a/tests/import-github.scm b/tests/import-github.scm
index 979a0fc12b..f6985fac55 100644
--- a/tests/import-github.scm
+++ b/tests/import-github.scm
@@ -24,30 +24,28 @@
   #:use-module (guix http-client)
   #:use-module (guix import github)
   #:use-module (guix packages)
-  #:use-module (guix tests)
+  #:use-module (guix tests http)
   #:use-module (guix upstream)
+  #:use-module (web client)
+  #:use-module (web request)
+  #:use-module (web uri)
   #:use-module (ice-9 match))
 
 (test-begin "github")
 
 (define (call-with-releases thunk tags releases)
-  (mock ((guix http-client) http-fetch
-         (lambda* (uri #:key headers)
-           (unless (string-prefix? "mock://" uri)
-             (error "the URI ~a should not be used" uri))
-           (define components
-             (string-split (substring uri 8) #\/))
-           (pk 'stuff components headers)
-           (define (scm->json-port scm)
-             (open-input-string (scm->json-string scm)))
-           (match components
-             (("repos" "foo" "foomatics" "releases")
-              (scm->json-port releases))
-             (("repos" "foo" "foomatics" "tags")
-              (scm->json-port tags))
-             (rest (error "TODO ~a" rest)))))
-        (parameterize ((%github-api "mock://"))
-          (thunk))))
+  (with-http-server*
+   (lambda (request _)
+     (define resource (uri-path (request-uri request)))
+     (define components (string-split resource #\/))
+     (define json (match components
+                    (("" "repos" "foo" "foomatics" "releases") releases)
+                    (("" "repos" "foo" "foomatics" "tags") tags)
+                    (rest (error "TODO ~a" rest))))
+     (values '() (lambda (port) (scm->json json port))))
+   (parameterize ((%github-api (%local-url* ""))
+                  (current-http-proxy #false))
+     (thunk))))
 
 ;; Copied from tests/minetest.scm
 (define (upstream-source->sexp upstream-source)
-- 
2.30.2
M
M
Maxime Devos wrote on 20 Jan 14:08 +0100
[PATCH 1/9] tests: Support arbitrary HTTP request handlers.
(address . 53389@debbugs.gnu.org)
20220120130849.292178-1-maximedevos@telenet.be
An incompatible change to with-http-server has been made: it now
also exits when the thunk exits. This change allows implementing
with-http-server*. It also keeps threads from lingering if the
thunk doesn't access all of RESPONSES+DATA.

Usually, this change is fine, but it does not interact nicely with
monads in tests/challenge, so a variant with-http-server/lingering
preserving the old behaviour has been defined.

* guix/tests/http.scm
(call-with-http-server): Extract most functionality to ...
(call-with-http-server*): ... this new procedure. Also stop the
server thread after 'thunk' returns instead of when the last response
has been sent unless requested not to.
(with-http-server/keep-lingering): New macro.
* tests/challenge.scm (call-mismatch-test): Use the 'keep-lingering'
variant of 'with-http-server'.
---
guix/tests/http.scm | 96 +++++++++++++++++++++++++++++++--------------
tests/challenge.scm | 24 ++++++------
2 files changed, 80 insertions(+), 40 deletions(-)

Toggle diff (196 lines)
diff --git a/guix/tests/http.scm b/guix/tests/http.scm
index 8f50eaefca..c42b4b8176 100644
--- a/guix/tests/http.scm
+++ b/guix/tests/http.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,7 +26,10 @@
   #:use-module (srfi srfi-39)
   #:use-module (ice-9 match)
   #:export (with-http-server
+            with-http-server/keep-lingering
+            with-http-server*
             call-with-http-server
+            call-with-http-server*
             %http-server-port
             %local-url))
 
@@ -68,23 +71,15 @@ actually listened at (in case %http-server-port was 0)."
   (string-append "http://localhost:" (number->string port)
                  "/foo/bar"))
 
-(define* (call-with-http-server responses+data thunk)
-  "Call THUNK with an HTTP server running and returning RESPONSES+DATA on HTTP
-requests.  Each element of RESPONSES+DATA must be a tuple containing a
-response and a string, or an HTTP response code and a string.
+(define* (call-with-http-server* handle thunk #:key (keep-lingering? #false)
+                                 (last-response? (const #false)))
+  "Call THUNK with an HTTP server running and responding to HTTP requests
+with HANDLE (see (guile)Web Server).
 
 %http-server-port will be set to the port listened at
-The port listened at will be set for the dynamic extent of THUNK."
-  (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))
-
+The port listened at will be set for the dynamic extent of THUNK.
+The server will quit after THUNK returns, unless KEEP-LINGERING? is true.
+It will also quit if LAST-RESPONSE? returns true."
   (define (http-write server client response body)
     "Write RESPONSE."
     (let* ((response (write-response response client))
@@ -94,8 +89,8 @@ The port listened at will be set for the dynamic extent of THUNK."
        (else
         (write-response-body response body)))
       (close-port port)
-      (when (null? responses)
-        (quit #t))                                ;exit the server thread
+      (when (last-response?)
+        (throw 'quit))
       (values)))
 
   ;; Mutex and condition variable to synchronize with the HTTP server.
@@ -118,18 +113,15 @@ The port listened at will be set for the dynamic extent of THUNK."
     (@@ (web server http) http-close))
 
   (define (server-body)
-    (define (handle request body)
-      (match responses
-        (((response data) rest ...)
-         (set! responses rest)
-         (values response data))))
-
     (let-values (((socket port) (open-http-server-socket)))
       (set! %http-real-server-port port)
       (catch 'quit
         (lambda ()
-          (run-server handle stub-http-server
-                      `(#:socket ,socket)))
+          ;; HANDLE might want to include the port in its responses,
+          ;; so set %http-server-port here as well.
+          (parameterize ((%http-server-port port))
+            (run-server handle stub-http-server
+                        `(#:socket ,socket))))
         (lambda _
           (close-port socket)))))
 
@@ -137,12 +129,58 @@ The port listened at will be set for the dynamic extent of THUNK."
     (let ((server (make-thread server-body)))
       (wait-condition-variable %http-server-ready %http-server-lock)
       ;; Normally SERVER exits automatically once it has received a request.
-      (parameterize ((%http-server-port %http-real-server-port))
-        (thunk)))))
+      (let-values ((results
+                    (parameterize ((%http-server-port %http-real-server-port))
+                      (thunk))))
+        (unless keep-lingering?
+          ;; exit the server thread
+          (system-async-mark (lambda () (throw 'quit)) server))
+        (apply values results)))))
+
+
+(define* (call-with-http-server responses+data thunk #:key (keep-lingering? #false))
+  "Call THUNK with an HTTP server running and returning RESPONSES+DATA
+on HTTP requests.  Each element of RESPONSES+DATA must be a tuple containing a
+response and a string, or an HTTP response code and a string.
+
+The argument RESPONSES+DATA is thunked.  As such, RESPONSES+DATA can use
+%http-server-port.  %http-server-port will be set to the port listened at.
+It will be set for the dynamic extent of THUNK and RESPONSES+DATA.
+
+The server will exit after the last response.  When KEEP-LINGERING? is false,
+the server will also exit after THUNK returns."
+  (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 (handle request body)
+    (match (responses)
+      (((response data) rest ...)
+       (set! responses (const rest))
+       (values response data))))
+  (call-with-http-server* handle thunk #:keep-lingering? keep-lingering?
+                          #:last-response?
+                          (lambda () (null? (responses)))))
 
 (define-syntax with-http-server
   (syntax-rules ()
     ((_ responses+data body ...)
-     (call-with-http-server responses+data (lambda () body ...)))))
+     (call-with-http-server (lambda () responses+data) (lambda () body ...)))))
+
+(define-syntax with-http-server/keep-lingering
+  (syntax-rules ()
+    ((_ responses+data body ...)
+     (call-with-http-server (lambda () responses+data) (lambda () body ...)
+                            #:keep-lingering? #true))))
+
+(define-syntax with-http-server*
+  (syntax-rules ()
+    ((_ handle body ...)
+     (call-with-http-server* handle (lambda () body ...)))))
 
 ;;; http.scm ends here
diff --git a/tests/challenge.scm b/tests/challenge.scm
index fdd5fd238e..c9de33ed34 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -198,17 +199,18 @@ value."
                                      (lambda (port)
                                        (write-file out2 port)))))
         (parameterize ((%http-server-port 9000))
-          (with-http-server `((200 ,(make-narinfo item size1 hash1))
-                              (200 ,nar1))
-            (parameterize ((%http-server-port 9001))
-              (with-http-server `((200 ,(make-narinfo item size2 hash2))
-                                  (200 ,nar2))
-                (mlet* %store-monad ((urls -> (list (%local-url 9000)
-                                                    (%local-url 9001)))
-                                     (reports (compare-contents (list item)
-                                                                urls)))
-                  (pk 'report reports)
-                  (return (proc (car reports))))))))))))
+          (with-http-server/keep-lingering
+           `((200 ,(make-narinfo item size1 hash1))
+             (200 ,nar1))
+           (parameterize ((%http-server-port 9001))
+             (with-http-server/keep-lingering
+              `((200 ,(make-narinfo item size2 hash2))
+                (200 ,nar2))
+              (mlet* %store-monad ((urls -> (list (%local-url 9000)
+                                                  (%local-url 9001)))
+                                   (reports (compare-contents (list item)
+                                                              urls)))
+                (return (proc (car reports))))))))))))
 
 (test-assertm "differing-files"
   (call-mismatch-test

base-commit: 1bd250783d7118c3101dd2a6e090f3d6904b24a0
-- 
2.30.2
M
M
Maxime Devos wrote on 20 Jan 14:08 +0100
[PATCH 7/9] tests: Allow checking the URI of a HTTP request.
(address . 53389@debbugs.gnu.org)
20220120130849.292178-7-maximedevos@telenet.be
* guix/tests/http.scm (call-with-http-server): Thunk RESPONSES+DATA.
[maybe-uri?]: New procedure.
[sanitize-response+data]: New procedure extracted from the definition of
'responses', support triples containing a URI.
[responses]: Thunk.
[handle]: Verify the URI. Adjust for thunking.
(with-http-server): Adjust for thunking.
---
guix/tests/http.scm | 35 +++++++++++++++++++++++++----------
1 file changed, 25 insertions(+), 10 deletions(-)

Toggle diff (66 lines)
diff --git a/guix/tests/http.scm b/guix/tests/http.scm
index 2f65df4029..6af1948211 100644
--- a/guix/tests/http.scm
+++ b/guix/tests/http.scm
@@ -21,7 +21,9 @@
   #:use-module (ice-9 threads)
   #:use-module (web server)
   #:use-module (web server http)
+  #:use-module (web request)
   #:use-module (web response)
+  #:use-module (web uri)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-39)
   #:use-module (ice-9 match)
@@ -144,7 +146,10 @@ It will also quit if LAST-RESPONSE? returns true."
 (define* (call-with-http-server responses+data thunk #:key (keep-lingering? #false))
   "Call THUNK with an HTTP server running and returning RESPONSES+DATA
 on HTTP requests.  Each element of RESPONSES+DATA must be a tuple containing a
-response and a string, or an HTTP response code and a string.
+response and a string, or an HTTP response code and a string.  Alternatively,
+the elements can triples with the URI path (including the query, if any)
+as the first part of the triple.  In that case, the request URI is verified
+against the URI in RESPONSES+DATA.
 
 The argument RESPONSES+DATA is thunked.  As such, RESPONSES+DATA can use
 %http-server-port.  %http-server-port will be set to the port listened at.
@@ -152,18 +157,28 @@ It will be set for the dynamic extent of THUNK and RESPONSES+DATA.
 
 The server will exit after the last response.  When KEEP-LINGERING? is false,
 the server will also exit after THUNK returns."
+  (define (maybe-uri? object)
+    (or (string? object) (eq? object 'any)))
+  (define (sanitize-response+data response+data)
+    (match response+data
+      ((response data)
+       (sanitize-response+data (list 'any response data)))
+      (((? maybe-uri? uri) (? response? response) data)
+       (list uri response data))
+      (((? maybe-uri? uri) (? integer? code) data)
+       (list uri
+             (build-response #:code code
+                             #:reason-phrase "Such is life")
+             data))))
   (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)))
+    (map sanitize-response+data (responses+data)))
   (define (handle request body)
     (match (responses)
-      (((response data) rest ...)
+      (((uri response data) rest ...)
+       (unless (or (eq? uri 'any)
+                   (string=? uri (uri->string (request-uri request))))
+         (error "this URI should not be contacted!"
+                (request-uri request)))
        (set! responses (const rest))
        (values response data))))
   (call-with-http-server* handle thunk #:keep-lingering? keep-lingering?
-- 
2.30.2
M
M
Maxime Devos wrote on 20 Jan 14:08 +0100
[PATCH 9/9] tests/challenge: Do not hard code HTTP ports.
(address . 53389@debbugs.gnu.org)
20220120130849.292178-9-maximedevos@telenet.be
This is a follow-up to commit 4aea90b1876179aab8d603a42533a6bdf97ccd3c.

* tests/challenge.scm (call-mismatch-test): Set %http-server-port to 0 instead
of 9001. Remove the first parametrisation of %http-server-port as it was
unnecessary. Adjust calls to %local-url to use the right port number.
---
tests/challenge.scm | 14 +++++++-------
1 file changed, 7 insertions(+), 7 deletions(-)

Toggle diff (30 lines)
diff --git a/tests/challenge.scm b/tests/challenge.scm
index c9de33ed34..2807b4fa00 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -198,16 +198,16 @@ value."
                            (nar2 -> (call-with-bytevector-output-port
                                      (lambda (port)
                                        (write-file out2 port)))))
-        (parameterize ((%http-server-port 9000))
-          (with-http-server/keep-lingering
-           `((200 ,(make-narinfo item size1 hash1))
-             (200 ,nar1))
-           (parameterize ((%http-server-port 9001))
+        (with-http-server/keep-lingering
+         `((200 ,(make-narinfo item size1 hash1))
+           (200 ,nar1))
+         (let ((port1 (%http-server-port)))
+           (parameterize ((%http-server-port 0))
              (with-http-server/keep-lingering
               `((200 ,(make-narinfo item size2 hash2))
                 (200 ,nar2))
-              (mlet* %store-monad ((urls -> (list (%local-url 9000)
-                                                  (%local-url 9001)))
+              (mlet* %store-monad ((urls -> (list (%local-url port1)
+                                                  (%local-url)))
                                    (reports (compare-contents (list item)
                                                               urls)))
                 (return (proc (car reports))))))))))))
-- 
2.30.2
M
M
Maxime Devos wrote on 20 Jan 14:08 +0100
[PATCH 8/9] tests/cpan: Verify URIs.
(address . 53389@debbugs.gnu.org)
20220120130849.292178-8-maximedevos@telenet.be
This restores some functionality lost in commit
4aea90b1876179aab8d603a42533a6bdf97ccd3c.

* tests/cpan.scm (test-json): Thunk and construct the download URL with
'%local-url*'.
("cpan->guix-package"): For simplicity, don't use the HTTP server as a
proxy. Verify the contacted URLs. Adjust for thunking. Adjust for new
download URL.
---
tests/cpan.scm | 30 +++++++++++++++++-------------
1 file changed, 17 insertions(+), 13 deletions(-)

Toggle diff (79 lines)
diff --git a/tests/cpan.scm b/tests/cpan.scm
index 89e6be0b4f..e6fa965969 100644
--- a/tests/cpan.scm
+++ b/tests/cpan.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2016 Alex Sassmannshausen <alex@pompo.co>
 ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,8 +32,9 @@
 ;; Globally disable grafts because they can trigger early builds.
 (%graft? #f)
 
-(define test-json
-  "{
+(define (test-json)
+  (string-append
+   "{
   \"metadata\" : {
     \"name\" : \"Foo-Bar\",
     \"version\" : \"0.1\"
@@ -50,10 +52,10 @@
      }
   ],
   \"abstract\" : \"Fizzle Fuzz\",
-  \"download_url\" : \"http://example.com/Foo-Bar-0.1.tar.gz\",
+  \"download_url\" : \"" (%local-url* "/Foo-Bar-0.1.tar.gz") "\"
   \"author\" : \"Guix\",
   \"version\" : \"0.1\"
-}")
+}"))
 
 (define test-source
   "foobar")
@@ -62,18 +64,19 @@
 
 (test-assert "cpan->guix-package"
   ;; Replace network resources with sample data.
-  (with-http-server `((200 ,test-json)
-                      (200 ,test-source)
-                      (200 "{ \"distribution\" : \"Test-Script\" }"))
-    (parameterize ((%metacpan-base-url (%local-url))
-                   (current-http-proxy (%local-url)))
+  (with-http-server `(("/release/Foo-Bar" 200 ,(test-json))
+                      ("/Foo-Bar-0.1.tar.gz" 200 ,test-source)
+                      ("/module/Test::Script?fields=distribution"
+                       200 "{ \"distribution\" : \"Test-Script\" }"))
+    (parameterize ((%metacpan-base-url (%local-url* ""))
+                   (current-http-proxy #false))
       (match (cpan->guix-package "Foo::Bar")
         (('package
            ('name "perl-foo-bar")
            ('version "0.1")
            ('source ('origin
                       ('method 'url-fetch)
-                      ('uri ('string-append "http://example.com/Foo-Bar-"
+                      ('uri ('string-append (? string? base-uri)
                                             'version ".tar.gz"))
                       ('sha256
                        ('base32
@@ -86,9 +89,10 @@
            ('synopsis "Fizzle Fuzz")
            ('description 'fill-in-yourself!)
            ('license 'perl-license))
-         (string=? (bytevector->nix-base32-string
-                    (call-with-input-string test-source port-sha256))
-                   hash))
+         (and (string=? base-uri (%local-url* "/Foo-Bar-"))
+              (string=? (bytevector->nix-base32-string
+                         (call-with-input-string test-source port-sha256))
+                        hash)))
         (x
          (pk 'fail x #f))))))
 
-- 
2.30.2
L
L
Ludovic Courtès wrote on 20 Jan 16:11 +0100
Re: [bug#53389] [PATCH 0/9] Replace some mocking with with-http-server*, avoid hardcoding ports,
(name . Maxime Devos)(address . maximedevos@telenet.be)(address . 53389@debbugs.gnu.org)
87czkm788a.fsf@gnu.org
Hi,

Maxime Devos <maximedevos@telenet.be> skribis:

Toggle quote (10 lines)
>
> by extending with-http-server to with-http-server* to allow arbitrary
> request handlers and extending with-http-server to allow verifying the
> URI of a request.
>
> tests/cpan.scm has been modified to verify the URIs.
> tests/import-github.scm and tests/minetest.scm have been modified to
> avoid mocking.

Great, I’ll take a look.

Toggle quote (16 lines)
> Somewhat unrelated, tests/lint.scm, tests/cpan.scm and
> tests/challenge.scm have been modified to avoid hard coding ports,
> as a follow-up to commit c05ceaf2b650d090cf39a048193505cb4e6bd257:
>
> [...]
> Previously, test cases could fail if some process was listening
> at a hard-coded port. This patch eliminates most of these
> potential failures, by automatically assigning an unbound port. 
> This should allow for building multiple guix trees in parallel
> outside a build container, though this is currently untested.
> [...]
>
> After this patch series, there's to my knowledge only one instance of
> hardcoded ports remaining, in tests/lint.scm ("home-page: Connection
> refused").

That’s a much welcome change.

Thank you!

Ludo’.
L
L
Ludovic Courtès wrote on 22 Jan 17:48 +0100
Re: bug#53389: [PATCH 0/9] Replace some mocking with with-http-server*, avoid hardcoding ports,
(name . Maxime Devos)(address . maximedevos@telenet.be)(address . 53389@debbugs.gnu.org)
87lez7zpgf.fsf_-_@gnu.org
Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

Toggle quote (18 lines)
> An incompatible change to with-http-server has been made: it now
> also exits when the thunk exits. This change allows implementing
> with-http-server*. It also keeps threads from lingering if the
> thunk doesn't access all of RESPONSES+DATA.
>
> Usually, this change is fine, but it does not interact nicely with
> monads in tests/challenge, so a variant with-http-server/lingering
> preserving the old behaviour has been defined.
>
> * guix/tests/http.scm
> (call-with-http-server): Extract most functionality to ...
> (call-with-http-server*): ... this new procedure. Also stop the
> server thread after 'thunk' returns instead of when the last response
> has been sent unless requested not to.
> (with-http-server/keep-lingering): New macro.
> * tests/challenge.scm (call-mismatch-test): Use the 'keep-lingering'
> variant of 'with-http-server'.

[...]

Toggle quote (8 lines)
> #:export (with-http-server
> + with-http-server/keep-lingering
> + with-http-server*
> call-with-http-server
> + call-with-http-server*
> %http-server-port
> %local-url))

My first reaction was: have we gone overboard? :-)

Since it’s an internal module and a test helper, I’m in favor of keeping
it as simple as possible. Can we keep a single ‘with-http-server’ form
that would cover all cases?

We can update existing tests to include the expected URL path (or a
wildcard, if needed), instead of keeping several forms. We don’t need
to worry about backward compatibility at all.

Toggle quote (4 lines)
> + (unless keep-lingering?
> + ;; exit the server thread
> + (system-async-mark (lambda () (throw 'quit)) server))

When do we need ‘keep-lingering?’? So far, all uses of
‘with-http-server’ expected that the server would quit once the last
response has been sent. It would be nice if we could keep it that way.

Toggle quote (15 lines)
> + (apply values results)))))
> +
> +
> +(define* (call-with-http-server responses+data thunk #:key (keep-lingering? #false))
> + "Call THUNK with an HTTP server running and returning RESPONSES+DATA
> +on HTTP requests. Each element of RESPONSES+DATA must be a tuple containing a
> +response and a string, or an HTTP response code and a string.
> +
> +The argument RESPONSES+DATA is thunked. As such, RESPONSES+DATA can use
> +%http-server-port. %http-server-port will be set to the port listened at.
> +It will be set for the dynamic extent of THUNK and RESPONSES+DATA.
> +
> +The server will exit after the last response. When KEEP-LINGERING? is false,
> +the server will also exit after THUNK returns."

Within tests, it would be nice if we could avoid using the ‘thunk’ form
and instead always use the declarative form (list of URL path/response
code/response body). That should make the tests more concise and
readable.

Or are there new uses where the declarative form is insufficiently
expressive?

Thanks,
Ludo’.
M
M
Maxime Devos wrote on 22 Jan 19:08 +0100
Re: [PATCH 1/9] tests: Support arbitrary HTTP request handlers.
(address . 53389@debbugs.gnu.org)(address . ludo@gnu.org)
e4138e11d6ec25b32792099f136ff2f1e1fc49c3.camel@telenet.be
Maxime Devos schreef op do 20-01-2022 om 13:08 [+0000]:
Toggle quote (5 lines)
> -      (when (null? responses)
> -        (quit #t))                                ;exit the server thread
> +      (when (last-response?)
> +        (throw 'quit))

(quit #t) can be preserved here (TBD in v2)
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYexIChccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7gkPAQC1wM+ujji+rYklwRCDEgKwkaas
ctlvxr9EVuLwAdbumAEA15Pt1KlSYdiETgxm/YmRnIcFGkSQuZFJf3zv5jxfEgM=
=QVq3
-----END PGP SIGNATURE-----


M
M
Maxime Devos wrote on 22 Jan 19:55 +0100
Re: bug#53389: [PATCH 0/9] Replace some mocking with with-http-server*, avoid hardcoding ports,
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 53389@debbugs.gnu.org)
687d96c300852e684422de877cd87769daae7ccd.camel@telenet.be
Hi,

Ludovic Courtès schreef op za 22-01-2022 om 17:48 [+0100]:
Toggle quote (6 lines)
> > +        (unless keep-lingering?
> > +          ;; exit the server thread
> > +          (system-async-mark (lambda () (throw 'quit)) server))
>
> When do we need ‘keep-lingering?’?

In tests/challenge.scm (call-mismatch-test), due to how the store monad
work, the thunk technically returns (*) before we are done with the
querying the server. Perhaps this can be resolved with sufficient
monadology, but I don't quite see how.

(*) a monadic value.

Toggle quote (3 lines)
> So far, all uses of ‘with-http-server’ expected that the server would
> quit once the last response has been sent.

AFAIK, they don't expect that the server quits. But they don't expect
that the server does not quit either. Rather, they need the server
to keep running as long as needed -- i.e., after the last request
has been answered.

The only reason that the server quits, is to perform a form of garbage
collection, to avoid accumulating threads and server ports.

There appear to be two criteria for deciding when to exit the server:

(a) Exit when the thunk returns.

This is similar to 'call-with-port' and 'call-with-output-file'
automatically closing the port when the procedure returns.
There don't seem to be any drawbacks with this criterium.

(b) Exit when there are no responses left.

This is problematic when there is no list of reponses but rather
some function mapping requests to responses without any
limitations on how often a resource is requested, or when there
are multiple resources available and the ‘client’ is allowed to
query a proper subset ...

E.g., the way the tests in tests/minetest.scm are written, the
tests don't care in which order resources are accessed and whether
a resource is accessed multiple time. Furthermore, the procedure
for creating a testing model of ContentDB (call-with-packages) has
no idea what parts of the model will be accessed.

That is, the same model can be used for searches (either
sorted by score or download), for requesting a description of a
ContentDB ‘package’ and for requesting a specific release of a
package.

Furthermore, the space of resources is even infinite (due to the
search API).

In principle, that procedure could be modified to accept a few
arguments specifying what things will be asked and with
which parameters, but doing that and figuring out the arguments
for each test would be rather tedious.

Aside from verifying that no more traffic than strictly necessary
happens (which would be a nice property but not really required),
I don't see the point of verifying which resources exactly are
queried.

Furthermore, which resources precisely are queried and how often,
seems more of an implementation detail to me. I would rather
focus on the end result: verifying that the imported package
definition is what is expected.

Most tests in tests/minetest.scm are like that: they tell
call-with-packages to create a ContentDB model with some data
(using make-package-json etc.) ask (guix import minetest) to
import some package from the model and compare the result with a
prediction (make-package-sexp) (can this called integration
testing?).

These tests do not care how (guix import minetest) works -- they
don't care about which resources are queried. Instead, they
simply test that the end result (the package definition) is as
predicted.

While criterium (b) might suffice for various unit tests
(e.g. in tests/lint.scm), it is rather impractical and limiting
for the kind of tests that tests/minetest.scm does.

OTOH, criterium (a) not only suffices for tests/lint.scm-style tests,
but also for tests/minetest.scm-style tests. It seems to work
everywhere, except for the single exception tests/challenge.scm.

Toggle quote (2 lines)
> It would be nice if we could keep it that way.

Compare (a) and (b), then I think it will be easy to infer what I would
prefer 😉.

Greetings,
Maxime.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYexTIhccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7itTAQD1YOZJg2DKpV6zRoGJMI/YjFQ8
rnvcCyQmVDqdauZQvAEAxWD+Il+A8dyjdRcIgS5EQhFN0Xpkh85nwzpz3Tx8ZQc=
=ozOG
-----END PGP SIGNATURE-----


M
M
Maxime Devos wrote on 22 Jan 20:21 +0100
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 53389@debbugs.gnu.org)
aa4a48ceb1b50a108f7d560f916372e75013a818.camel@telenet.be
Ludovic Courtès schreef op za 22-01-2022 om 17:48 [+0100]:
Toggle quote (21 lines)
> > +(define* (call-with-http-server responses+data thunk #:key (keep-
> > lingering? #false))
> > +  "Call THUNK with an HTTP server running and returning
> > RESPONSES+DATA
> > +on HTTP requests.  Each element of RESPONSES+DATA must be a tuple
> > containing a
> > +response and a string, or an HTTP response code and a string.
> > +
> > +The argument RESPONSES+DATA is thunked.  As such, RESPONSES+DATA
> > can use
> > +%http-server-port.  %http-server-port will be set to the port
> > listened at.
> > +It will be set for the dynamic extent of THUNK and RESPONSES+DATA.
> > +
> > +The server will exit after the last response.  When KEEP-
> > LINGERING? is false,
> > +the server will also exit after THUNK returns."
>
> Within tests, it would be nice if we could avoid using the ‘thunk’
> form

We can't unthunk 'thunk', otherwise the code querying the server will
be run before the server starts, which isn't very useful. It's the
same reasn why unthunking the 'thunk' argument of 'with-output-to-file'
is not useful -- unless you only want to make a file empty I suppose.

Did you mean 'responses+data'? For some context, consider
tests/cpan.scm:

- (with-http-server `((200 ,test-json)
- (200 ,test-source)
- (200 "{ \"distribution\" : \"Test-Script\" }"))
- (parameterize ((%metacpan-base-url (%local-url))
- (current-http-proxy (%local-url)))
+ (with-http-server `(("/release/Foo-Bar" 200 ,(test-json))
+ ("/Foo-Bar-0.1.tar.gz" 200 ,test-source)
+ ("/module/Test::Script?fields=distribution"
+ 200 "{ \"distribution\" : \"Test-Script\" }"))
+ (parameterize ((%metacpan-base-url (%local-url* ""))
+ (current-http-proxy #false))

(Side note: should parametrising current-http-proxy be moved into
'with-http-server', to avoid forgetting to do it in individual tests?)

This 'with-http-server' is ‘self-referrent’: the responses depend on
the port that the HTTP server bound to -- (test-json) refers to
http://localhost:THE-PORT/Foo-Bar-0.1.tar.gz. As such, the
responses+data needs to be thunked, because this port is not known in
advance.

In principle, thunking can be avoided here by running two HTTP servers
by nesting two with-http-server forms, but why make things more
complicated by running multiple servers when a single one is
sufficient? It can also be avoided by doing this proxy thing the
original code did, but why complicate things with proxies when
a regular server suffices?

Also, tests don't really see that thunking happens unless they actually
use the thunking to do make self-references, because all tests use
with-http-server (*) (which does thunking automatically, not unlike
'package' records). So except for simplifying implementation details
of call-with-http-server, I don't see how unthunking would make things
nicer.

(*) Unless they use with-http-server*.

Toggle quote (3 lines)
> and instead always use the declarative form (list of URL
> path/response code/response body).

Thunking and declarative forms don't appear mutually exclusive to me;
the tests/cpan.scm example above uses a thunked declarative form.

It would be nice to always specify the paths in the declarative
form though, to make tests more precise, but there are a lot
of tests to convert.

Toggle quote (2 lines)
>  That should make the tests more concise and readable.

The declarative form is still available and isn't going away.

Toggle quote (4 lines)
>
> Or are there new uses where the declarative form is insufficiently
> expressive?

tests/minetest.scm, see other mail.

with-http-server is still declarative, so maybe you meant the
functional with-http-server* instead?

Greetings,
Maxime
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYexZNhccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7p59AP99NGaQ1+gmQsJm94VjJTNruOyN
7e0HSIMSmP7kAf1FsgD8C6uZqByXzp1qAHiV4b2lJixqlIK6xFbOCVdnKelpOQI=
=DKbF
-----END PGP SIGNATURE-----


M
M
Maxime Devos wrote on 22 Jan 20:57 +0100
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 53389@debbugs.gnu.org)
729a1d056ccd32c52e45c667749f1e7f0981ae42.camel@telenet.be
Ludovic Courtès schreef op za 22-01-2022 om 17:48 [+0100]:
Toggle quote (6 lines)
> My first reaction was: have we gone overboard?  :-)
>
> Since it’s an internal module and a test helper, I’m in favor of keeping
> it as simple as possible.
>

I don't see what it matters that this module is only available from
a git checkout (or extracted tarball) and that it is only used by
tests.

Keeping things simple is good, but making it simpler in such a way
that it becomes unusable to some tests (tests/minetest.scm) somewhat
defeats the purpose of the test helper.

Toggle quote (3 lines)
>   Can we keep a single ‘with-http-server’ form
> that would cover all cases?

We have a single form that covers all cases: with-http-server*.
However, the full power of the functinal with-http-server*, accepting
an arbitrary mapping from requests to responses, often isn't necessary.
For those cases, we have the declarative with-http-server, which is
quite a bit simpler to use, but much less flexible.

We could remove 'with-http-server' and keep a single macro
'with-http-server*' but I don't think that's what you were going for.

This seems a bit like trivial-build-system/copy-build-system.
trivial-build-system is rather complicated to use, but can in theory do
anything. copy-build-system is rather limited in what it can do, but
when it is suitable to the problem, it is very easy to use.
There is no attempt to somehow shove everything trivial-build-system
can do into copy-build-system.

There's also the option of letting 'call-with-http-server' test
if the (responses+data) is a procedure or a list, and in the first
case behave like the old 'with-http-server*' and in the second
case like 'with-http-server'. This overloading doesn't seem
great though, I would rather have two separate procedures for
two separate APIs -- albeit with one implemented with the other.

Toggle quote (4 lines)
> We can update existing tests to include the expected URL path (or a
> wildcard, if needed), instead of keeping several forms.  We don’t need
> to worry about backward compatibility at all.

Always including the URL path in the declarative forms
(with-http-server) seems good to me, but it would be a lot of work
-- actually, on second though, I ran
"git grep -F with-http-server | wc -l" and there were 51 hits, which
seems doable. Let's do that in the v2.

However, the declarative form is too limiting and not sufficiently
expressive for some tests (tests/minetest.scm) and tests/minetest.scm
doesn't have any use for wildcards, so with-http-server remains
unsuitable for some tests.

Greetings,
Maxime.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYexhrhccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7ie9AQDQKmBJ5Ftew3o8q8NbB660J8ak
i1Z8FMzEqsZzVMp4yQEAxdDivaUzzO1SNPMC1GRLa9I8g2IAubDNmCJyu41o+Qw=
=BfMF
-----END PGP SIGNATURE-----


M
M
Maxime Devos wrote on 22 Jan 21:42 +0100
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 53389@debbugs.gnu.org)
b15ff88dd5a602365f4008baf541452876bded35.camel@telenet.be
Ludovic Courtès schreef op za 22-01-2022 om 17:48 [+0100]:
Toggle quote (6 lines)
> My first reaction was: have we gone overboard?  :-)
>
> Since it’s an internal module and a test helper, I’m in favor of keeping
> it as simple as possible.
>

I don't see what it matters that this module is only available from
a git checkout (or extracted tarball) and that it is only used by
tests.

Keeping things simple is good, but making it simpler in such a way
that it becomes unusable to some tests (tests/minetest.scm) somewhat
defeats the purpose of the test helper.

Toggle quote (3 lines)
>   Can we keep a single ‘with-http-server’ form
> that would cover all cases?

We have a single form that covers all cases: with-http-server*.
However, the full power of the functinal with-http-server*, accepting
an arbitrary mapping from requests to responses, often isn't necessary.
For those cases, we have the declarative with-http-server, which is
quite a bit simpler to use, but much less flexible.

We could remove 'with-http-server' and keep a single macro
'with-http-server*' but I don't think that's what you were going for.

This seems a bit like trivial-build-system/copy-build-system.
trivial-build-system is rather complicated to use, but can in theory do
anything. copy-build-system is rather limited in what it can do, but
when it is suitable to the problem, it is very easy to use.
There is no attempt to somehow move everything trivial-build-system
can do into copy-build-system.

There's also the option of letting 'call-with-http-server' test
if the (responses+data) is a procedure or a list, and in the first
case behave like the old 'with-http-server*' and in the second
case like 'with-http-server'. This overloading doesn't seem
great though, I would rather have two separate procedures for
two separate APIs -- albeit with one implemented using the other.

Toggle quote (5 lines)
>
> We can update existing tests to include the expected URL path (or a
> wildcard, if needed), instead of keeping several forms.  We don’t need
> to worry about backward compatibility at all.

Always including the URL path in the declarative forms
(with-http-server) seems good to me, but it would be a lot of work
-- actually, on second though, I ran
"git grep -F with-http-server | wc -l" and there were 51 hits, which
seems doable. Let's do that in the v2.

However, the declarative form is too limiting and not sufficiently
expressive for some tests (tests/minetest.scm), tests/minetest.scm
doesn't have any use for wildcards, so with-http-server remains
unsuitable for some tests.

Greetings,
Maxime.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYexsUBccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7ssVAP93v+UNC96exqMq+RVo4YUMfFJ+
IwzP2NRQ7WQNwWD7ugD8CHO6qlnI7Gyqp5cT4isyyEHSwYdR/9mhhtgdcpw1tgU=
=O3S3
-----END PGP SIGNATURE-----


L
L
Ludovic Courtès wrote on 25 Jan 08:54 +0100
(name . Maxime Devos)(address . maximedevos@telenet.be)(address . 53389@debbugs.gnu.org)
87wniop7wh.fsf@gnu.org
Hi,

Maxime Devos <maximedevos@telenet.be> skribis:

Toggle quote (14 lines)
> Ludovic Courtès schreef op za 22-01-2022 om 17:48 [+0100]:
>> > +        (unless keep-lingering?
>> > +          ;; exit the server thread
>> > +          (system-async-mark (lambda () (throw 'quit)) server))
>>
>> When do we need ‘keep-lingering?’?
>
> In tests/challenge.scm (call-mismatch-test), due to how the store monad
> work, the thunk technically returns (*) before we are done with the
> querying the server. Perhaps this can be resolved with sufficient
> monadology, but I don't quite see how.
>
> (*) a monadic value.

Oh I see.

Toggle quote (11 lines)
>> So far, all uses of ‘with-http-server’ expected that the server would
>> quit once the last response has been sent.
>
> AFAIK, they don't expect that the server quits. But they don't expect
> that the server does not quit either. Rather, they need the server
> to keep running as long as needed -- i.e., after the last request
> has been answered.
>
> The only reason that the server quits, is to perform a form of garbage
> collection, to avoid accumulating threads and server ports.

Yes.

Toggle quote (22 lines)
> There appear to be two criteria for deciding when to exit the server:
>
> (a) Exit when the thunk returns.
>
> This is similar to 'call-with-port' and 'call-with-output-file'
> automatically closing the port when the procedure returns.
> There don't seem to be any drawbacks with this criterium.
>
> (b) Exit when there are no responses left.
>
> This is problematic when there is no list of reponses but rather
> some function mapping requests to responses without any
> limitations on how often a resource is requested, or when there
> are multiple resources available and the ‘client’ is allowed to
> query a proper subset ...
>
> E.g., the way the tests in tests/minetest.scm are written, the
> tests don't care in which order resources are accessed and whether
> a resource is accessed multiple time. Furthermore, the procedure
> for creating a testing model of ContentDB (call-with-packages) has
> no idea what parts of the model will be accessed.

So tests/minetest.scm needs more than pre-programmed responses that are
returned in a specified order?

In ideal black-box testing, sure, you would make the test HTTP server
completely oblivious to what’s being tested, in particular oblivious to
the order in which requests might arrive.

But in practice, you also want to keep the test infrastructure as simple
and concise as possible, or you’ll need tests for that infrastructure
too. I guess that’s my main concern.

So I would opt for minimal changes. There are 6 files under tests/ that
mock ‘http-fetch’. Perhaps we can start converting them one by one to
the (guix tests http) infrastructure as it exists, and only change that
infrastructure when needed?

Thanks,
Ludo’.
M
M
Maxime Devos wrote on 25 Jan 14:37 +0100
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 53389@debbugs.gnu.org)
6b68d02fea18699d944b92e5b0351853201ff511.camel@telenet.be
Ludovic Courtès schreef op di 25-01-2022 om 08:54 [+0100]:
Toggle quote (11 lines)
> So tests/minetest.scm needs more than pre-programmed responses that are
> returned in a specified order?
>
> In ideal black-box testing, sure, you would make the test HTTP server
> completely oblivious to what’s being tested, in particular oblivious to
> the order in which requests might arrive.
>
> But in practice, you also want to keep the test infrastructure as simple
> and concise as possible, or [...]


I think the most concise test infrastructure here, with the least
potential of breakage (and hence the least need to test the test
infrastructure), would be to use mocking instead of creating a HTTP
server listening to a port: 

* mocking doesn't require threads, which eliminates the problem of
deciding when to stop the thread (e.g., the current version doesn't
stop the thread if the thunk throws an exception) and looking out
for concurrency-related problems.

* mocking doesn't use ports, which eliminates the problem of having
to choose a _free_ port and eventually close it

* somehow, when using mocking instead of threads, the
ECONNREFUSED/par-map from [PATH 3/9] doesn't happen

'with-http-server' could then be renamed to 'with-http-mocking'
and be based on mocking. 'with-http-server*' could be removed;
tests/minetest.scm would keep mocking directly.

As such, mocking seems a lot simpler to me and 'with-http-server' could
be made simpler by implementing it on top of mocking. Guile's
optimiser has been beginning to do some inlining for a while,
so maybe not though.

Toggle quote (3 lines)
> [...] or you’ll need tests for that infrastructure
> too. I guess that’s my main concern.

I don't think guix/tests/http.scm has become significantly more complex
and less concise, the changes seem more splitting a procedure doing
multiple somewhat unrelated things (call-with-http-server, which did
both construct a HTTP server and decide what to respond to a request)
into two separate procedures (call-with-http-server*, which constructs
a HTTP server and lets the handler procedure choose how to map requests
to responses, and call-with-http-server's handler procedure).

Additionally, it would seem to me that all tests using
call-with-http-server and call-with-http-server* are also tests of
guix/tests.scm

Still, I could write some tests for (guix tests http)?

Toggle quote (5 lines)
> So I would opt for minimal changes. There are 6 files under tests/
> that mock ‘http-fetch’. Perhaps we can start converting them one by
> one to the (guix tests http) infrastructure as it exists, and only
> change that infrastructure when needed?

One of these files is tests/minetest.scm. The main purpose of this
patch series was to convert tests/minetest.scm from mocking to
(guix tests http). However, the tests in tests/minetest.scm did not
fit the original (guix tests http). As such, some changes to the
(guix tests http) infrastructure were needed, in [PATCH 1/9]. These
changes seem rather minimal to me.

That said, there might also be other minimal changes possible.
E.g. call-with-packages could generate a map from URI -> response in
advance. But that would require modifying both tests/minetest.scm
quite a bit and (guix tests http) (to allow optionally ignoring
ordering, adding a new flag and hence some complexity). That doesn't
seem minimal to me?

It would also make things more complicated later, e.g. I would like to
someday teach the Minetest importer to use http-fetch/cached, If-
Modified-Since and friends to reduce network traffic and some degree of
resiliency (in case of flaky interruptions or even being offline) (*).
To test that, a static URI->response map would not suffice. Another
tweak to the tests would be to verify the content type (for the
Minetest importer, ContentDB doesn't care currently, but for the GitHub
updater, GitHub does IIUC).

(*) Could be useful for supporting something like

(packages->manifest
(map specification->imported-package
'("minetest-not-in-guix-yet@2.1.0" "minetest-mod-old-or-newer-version@9.0.0")))

without incurring excessive network traffic, and having a chance of
working when offline.

Greetings,
Maxime.

p.s. I'll take some time off and write a v2 for the Minetest documentation
patch later (before the v2 of this patch series).
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYe/9IxccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7kY0AP4vgU/2gv6+eAvLFf/BqjcgdA+5
O6UuD4tSWLCf8xV5KwEAvQAX05x2qWs7Yn4Um56sxs+pY1g6482zvN8c8zZzTwQ=
=Gwm/
-----END PGP SIGNATURE-----


L
L
Ludovic Courtès wrote on 7 Feb 10:53 +0100
(name . Maxime Devos)(address . maximedevos@telenet.be)(address . 53389@debbugs.gnu.org)
87r18fdmtv.fsf_-_@gnu.org
Hi,

Maxime Devos <maximedevos@telenet.be> skribis:

Toggle quote (14 lines)
> Ludovic Courtès schreef op za 22-01-2022 om 17:48 [+0100]:
>> > +        (unless keep-lingering?
>> > +          ;; exit the server thread
>> > +          (system-async-mark (lambda () (throw 'quit)) server))
>>
>> When do we need ‘keep-lingering?’?
>
> In tests/challenge.scm (call-mismatch-test), due to how the store monad
> work, the thunk technically returns (*) before we are done with the
> querying the server. Perhaps this can be resolved with sufficient
> monadology, but I don't quite see how.
>
> (*) a monadic value.

How about fixing it locally like this:
Toggle diff (51 lines)
diff --git a/tests/challenge.scm b/tests/challenge.scm
index fdd5fd238e..0b44ed7d21 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -57,6 +57,17 @@ (define-syntax with-derivation-narinfo*
        (lambda () body ...)
        hash))))
 
+(define-syntax-rule (with-http-server* arguments body ...)
+  ;; Like 'with-http-server' but for use in a monadic context.
+  (let ((port (%http-server-port)))
+    (lambda (store)
+      (values (parameterize ((%http-server-port port))
+                (call-with-http-server arguments
+                                       (lambda ()
+                                         (run-with-store store
+                                           body ...))))
+              store))))
+
 
 (test-begin "challenge")
 
@@ -198,11 +209,11 @@ (define (call-mismatch-test proc)
                                      (lambda (port)
                                        (write-file out2 port)))))
         (parameterize ((%http-server-port 9000))
-          (with-http-server `((200 ,(make-narinfo item size1 hash1))
-                              (200 ,nar1))
+          (with-http-server* `((200 ,(make-narinfo item size1 hash1))
+                               (200 ,nar1))
             (parameterize ((%http-server-port 9001))
-              (with-http-server `((200 ,(make-narinfo item size2 hash2))
-                                  (200 ,nar2))
+              (with-http-server* `((200 ,(make-narinfo item size2 hash2))
+                                   (200 ,nar2))
                 (mlet* %store-monad ((urls -> (list (%local-url 9000)
                                                     (%local-url 9001)))
                                      (reports (compare-contents (list item)
@@ -238,4 +249,5 @@ (define (call-mismatch-test proc)
 
 ;;; Local Variables:
 ;;; eval: (put 'with-derivation-narinfo* 'scheme-indent-function 2)
+;;; eval: (put 'with-http-server* 'scheme-indent-function 1)
 ;;; End:
That way we don’t need to keep the lingering variant in (guix tests
http).

WDYT?

Ludo’.
M
M
Maxime Devos wrote on 7 Feb 11:59 +0100
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 53389@debbugs.gnu.org)
490f1dca8f20293a931a45847018ea52eca07cd5.camel@telenet.be
Ludovic Courtès schreef op ma 07-02-2022 om 10:53 [+0100]:
Toggle quote (25 lines)
> Hi,
>
> Maxime Devos <maximedevos@telenet.be> skribis:
>
> > Ludovic Courtès schreef op za 22-01-2022 om 17:48 [+0100]:
> > > > +        (unless keep-lingering?
> > > > +          ;; exit the server thread
> > > > +          (system-async-mark (lambda () (throw 'quit)) server))
> > >
> > > When do we need ‘keep-lingering?’?
> >
> > In tests/challenge.scm (call-mismatch-test), due to how the store monad
> > work, the thunk technically returns (*) before we are done with the
> > querying the server. Perhaps this can be resolved with sufficient
> > monadology, but I don't quite see how.
> >
> > (*) a monadic value.
>
> How about fixing it locally like this:
>
> That way we don’t need to keep the lingering variant in (guix tests
> http).
>
> WDYT?

Looks nice, though it isn't ideal that port 9000/9001 is hardcoded
here. That can be left as an exercise for later though. I'll do this
in the v2 (and remove keep-lingering?) whenever I get around to writing
the v2 (I'm mostly doing Scheme-GNUnet stuff at the moment).

Greetings,
Maaxime.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYgD7gRccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7hPIAQDkOnEYeiTRLanyOZQnIWCtzHNU
N/GFa5wpKKx5IvCM0AD+JEPxWyd7NNZzuMi6H3GY5eEq9aUq3LHcKtOoGohX8w0=
=RlSD
-----END PGP SIGNATURE-----


L
L
Ludovic Courtès wrote on 6 Mar 17:23 +0100
(name . Maxime Devos)(address . maximedevos@telenet.be)(address . 53389@debbugs.gnu.org)
878rtnkq3a.fsf_-_@gnu.org
Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

Toggle quote (5 lines)
> Looks nice, though it isn't ideal that port 9000/9001 is hardcoded
> here. That can be left as an exercise for later though. I'll do this
> in the v2 (and remove keep-lingering?) whenever I get around to writing
> the v2 (I'm mostly doing Scheme-GNUnet stuff at the moment).

I just remembered about this patch series. Let me know when you can
come up with v2.

Ludo’.
M
M
Maxime Devos wrote on 7 Mar 08:00 +0100
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 53389@debbugs.gnu.org)
c99b5fcdf59cd8d15555f33e8e0b095e969ea9d8.camel@telenet.be
Ludovic Courtès schreef op zo 06-03-2022 om 17:23 [+0100]:
Toggle quote (3 lines)
> I just remembered about this patch series.  Let me know when you can
> come up with v2.

Not right now, but there's another (older) patch series that should be

Greetings,
Maxime.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYiWteBccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7lEgAP93ZJMW8extc8emoEQv7odblYx5
qz1CRy7NJE8CCZZK3wEAhXn3n0ZAz1eLDfkr6o/eJV1EGa2wCtl8wGKW3Bb1lQM=
=q4az
-----END PGP SIGNATURE-----


M
M
Maxime Devos wrote on 12 Apr 21:46 +0200
Re: [PATCH 0/9] Replace some mocking with with-http-server
(address . 53389@debbugs.gnu.org)
f868253f4de7842ef74a3b5ee540ce7c49829291.camel@telenet.be
Hi,

Status update for this patch series:

* Rebased.
* Fixed a typo in docstrings.
* Worked-around a (guix import github) quasi-bug / Guile http server
limitation / http-fetch limitation involving connection reuse.
* keep-lingering has been been eliminated in favour of Ludo's
with-http-server* (renamed to with-http-server/monadic to avoid
confusion with the other with-http-server*). Code is a bit simpler
now!

It has also been tweaked to automatically allocate ports.

To do:

* Look into if further simplification is possible
* Adjust remaining tests to use the form explicitly mentioning
the URL
* Maybe remove the URL-less form?

Current patch series can be found at
(with some unrelated changes, commit 01d8fc1f856f1b802d359ceb1a5986bce551daf5).
Will send a proper patch series later, after looking into the TODOs.

Greetings,
Maxime.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYlXXJhccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7sW/AP0bnWXLcbE+JsIK14+7N2/REH1E
5ro6TQU0W5jh7p8VfAD/RVFG0M9AzMvRwYWNzcPwTgVM8V8ElAkEM2oYb6iQ6Q8=
=KY0G
-----END PGP SIGNATURE-----


M
M
Maxime Devos wrote on 21 Apr 17:20 +0200
[PATCH v2 0/25] Replace some mocking with with-http-server*, avoid harcoding ports.
(address . 53389@debbugs.gnu.org)(name . Ludovic Courtès)(address . ludo@gnu.org)
e64393ed6671ccbc3176ebfdecdf9e85f0da4974.camel@telenet.be
Hi,

Changes since the v1:

* Simplification: keep-lingering? has been removed. For
tests/challenge, I have taken the proposed with-http-server*,
renamed it to with-http-server/monadic to avoid confusion and
removed its hardcoding of ports.

* Simplification: the semantics of with-http-server*/with-http-server
are now a bit simpler: it _always_ chooses a fresh port, regardless
of whether %http-server-port was already set.

* Simplification: %local-url and %local-url* have been unified to a
single one-optional-argument procedure.

* Simplification: no tests use %http-server-port anymore. Instead,
they directly use %local-url.

* YMMV: %http-server-port is now a lexical variable instead of a dynamic
parameter, using syntax parameters.

* The ‘home-page: Connection refused’ test does not hardcode 9999 anymore.
Instead, 'with-unreachable-http-server' binds a fresh port (claiming it)
but does not listen to it (causing connections to be refused).

* Simplification: with-http-server only supports a single form now:
a list of (uri response-code response) triples. The URI must now
always be set! Existing tests have been adjusted appropriately.

What would be preferred:

* The 2827e9f8a5834be65f8709a595ec2d870fd39271 commit from https://notabug.org/maximed/scheme-gnunet/
* or a bunch of v2 mails sent with "git send-email?

Greetings,
Maxime.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYmF2ORccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7uhUAP4uFHWZLEsKMI+YJArIBYUVWxU1
AsHIZzv9Nov1CefqzAD+OD/f4UKiI2aCnyp/JZ69WYyoCV8KpCT1HLZCageM4gM=
=cjah
-----END PGP SIGNATURE-----


?