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

Previous Next

Full log

Message #20 received at 53389 <at> debbugs.gnu.org (full text, mbox):

From: Maxime Devos <maximedevos <at> telenet.be>
To: 53389 <at> debbugs.gnu.org
Cc: ludo <at> gnu.org, Maxime Devos <maximedevos <at> telenet.be>
Subject: [PATCH 4/9] tests/import-github: Run a HTTP server instead of mocking.
Date: Thu, 20 Jan 2022 13:08:44 +0000

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

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.