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

From: Maxime Devos <[email-masked]>
Date: Thu, 20 Jan 2022 13:08:43 +0000

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 <[email-masked]>
---
 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)
+
 
 
 ;;;
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 <[email-masked]>
+;;; Copyright © 2021, 2022 Maxime Devos <[email-masked]>
 ;;;
 ;;; 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