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

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

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 1670 bytes --]

X-Debbugs-CC: ludo@gnu.org

Hi,

This patch series addresses:

Ludovic Courtès schreef op zo 16-01-2022 om 23:19 [+0100]:
> 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?

(see <https://issues.guix.gnu.org/53060#3>.)

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
https://notabug.org/maximed/guix-gnunet (branch
more-precise-http-tests, commit
f0a0303c17b5aa92493aea5a6d28183421b7cf44).

Greetings,
Maxime.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

[bug#53389] [PATCH 1/9] tests: Support arbitrary HTTP request handlers.

[Maxime Devos]

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(-)

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

[bug#53389] [PATCH 2/9] tests: Generalise %local-url.

[Maxime Devos]

* 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(-)

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

[bug#53389] [PATCH 3/9] tests/minetest: Run a HTTP server instead of mocking.

[Maxime Devos]

Fixes: <https://issues.guix.gnu.org/53060#3>

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(-)

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)
+
 \f
 
 ;;;
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

[bug#53389] [PATCH 4/9] tests/import-github: Run a HTTP server instead of mocking.

[Maxime Devos]

Fixes: <https://issues.guix.gnu.org/53060#3>

* 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(-)

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

[bug#53389] [PATCH 5/9] tests/cpan: Do not hard code a HTTP port.

[Maxime Devos]

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(-)

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

[bug#53389] [PATCH 6/9] tests/lint: Do not assume the next port is free.

[Maxime Devos]

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(-)

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

[bug#53389] [PATCH 7/9] tests: Allow checking the URI of a HTTP request.

[Maxime Devos]

* 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(-)

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

[bug#53389] [PATCH 8/9] tests/cpan: Verify URIs.

[Maxime Devos]

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(-)

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

[bug#53389] [PATCH 9/9] tests/challenge: Do not hard code HTTP ports.

[Maxime Devos]

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(-)

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

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

[Ludovic Courtès]

Hi,

Maxime Devos <maximedevos@telenet.be> skribis:

> (see <https://issues.guix.gnu.org/53060#3>.)
>
> 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.

> 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’.

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

[Ludovic Courtès]

Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

> 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'.

[...]

>    #: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.

> +        (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.

> +        (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’.

[bug#53389] [PATCH 1/9] tests: Support arbitrary HTTP request handlers.

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 324 bytes --]

Maxime Devos schreef op do 20-01-2022 om 13:08 [+0000]:
> -      (when (null? responses)
> -        (quit #t))                                ;exit the server thread
> +      (when (last-response?)
> +        (throw 'quit))

(quit #t) can be preserved here (TBD in v2)

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

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

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 4236 bytes --]

Hi,

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.

> 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. 

> 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.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

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

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 3863 bytes --]

Ludovic Courtès schreef op za 22-01-2022 om 17:48 [+0100]:
> > +(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*.

>  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.

>  That should make the tests more concise and readable.

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

> 
> 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

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

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

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 2608 bytes --]

Ludovic Courtès schreef op za 22-01-2022 om 17:48 [+0100]:
> 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.

>   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.

> 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.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

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

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 2607 bytes --]

Ludovic Courtès schreef op za 22-01-2022 om 17:48 [+0100]:
> 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.

>   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.

> 
> 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.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

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

[Ludovic Courtès]

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.

Oh I see.

>> 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.

> 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’.

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

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 4390 bytes --]

Ludovic Courtès schreef op di 25-01-2022 om 08:54 [+0100]:
> 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.

> [...] 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)?

> 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).

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

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

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 678 bytes --]

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:


[-- Attachment #2: Type: text/x-patch, Size: 2285 bytes --]

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))))
+
 \f
 (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:

[-- Attachment #3: Type: text/plain, Size: 102 bytes --]


That way we don’t need to keep the lingering variant in (guix tests
http).

WDYT?

Ludo’.

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

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 1182 bytes --]

Ludovic Courtès schreef op ma 07-02-2022 om 10:53 [+0100]:
> 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.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

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

[Ludovic Courtès]

Hi Maxime,

Maxime Devos <maximedevos@telenet.be> skribis:

> 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’.

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

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 299 bytes --]

Ludovic Courtès schreef op zo 06-03-2022 om 17:23 [+0100]:
> 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
ready: <https://issues.guix.gnu.org/50299#91>.

Greetings,
Maxime.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

[bug#53389] [PATCH 0/9] Replace some mocking with with-http-server

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 985 bytes --]

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
<https://notabug.org/maximed/guix-gnunet/src/more-precise-http-server-2>
(with some unrelated changes, commit 01d8fc1f856f1b802d359ceb1a5986bce551daf5).
Will send a proper patch series later, after looking into the TODOs.

Greetings,
Maxime.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

[bug#53389] [PATCH v2 0/25] Replace some mocking with with-http-server*, avoid harcoding ports.

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 1542 bytes --]

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/
   (https://notabug.org/maximed/guix-gnunet/commit/2827e9f8a5834be65f8709a595ec2d870fd39271)
 * or a bunch of v2 mails sent with "git send-email?

Greetings,
Maxime.

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]