import: cpan: Rewrite tests to use an HTTP server instead of mocking.

* guix/import/cpan.scm (%metacpan-base-url): New variable.
(module->dist-name, cpan-fetch): Refer to it instead of the hard-coded URL.
* tests/cpan.scm ("cpan->guix-package"): Use 'with-http-server' instead
of 'mock'.

guix/import/cpan.scm

@@ -61,7 +61,9 @@ (define-module (guix import cpan)
             cpan-fetch
             cpan->guix-package
             metacpan-url->mirror-url
-            %cpan-updater))
+            %cpan-updater
+
+            %metacpan-base-url))
 
 ;;; Commentary:
 ;;;
@@ -70,6 +72,10 @@ (define-module (guix import cpan)
 ;;;
 ;;; Code:
 
+(define %metacpan-base-url
+  ;; Base URL of the MetaCPAN API.
+  (make-parameter "https://fastapi.metacpan.org/v1/"))
+
 ;; Dependency of a "release".
 (define-json-mapping <cpan-dependency> make-cpan-dependency cpan-dependency?
   json->cpan-dependency
@@ -149,7 +155,7 @@ (define (module->dist-name module)
 module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would
 return \"Test-Simple\""
   (assoc-ref (json-fetch (string-append
-                          "https://fastapi.metacpan.org/v1/module/"
+                          (%metacpan-base-url) "/module/"
                           module
                           "?fields=distribution"))
              "distribution"))
@@ -176,7 +182,7 @@ (define (cpan-fetch name)
 \"Test-Script\" for the \"Test::Script\" module."
   ;; This API always returns the latest release of the module.
   (json->cpan-release
-   (json-fetch (string-append "https://fastapi.metacpan.org/v1/release/"
+   (json-fetch (string-append (%metacpan-base-url) "/release/"
                               name))))
 
 (define (cpan-home name)

tests/cpan.scm

@@ -22,9 +22,10 @@ (define-module (test-cpan)
   #:use-module (guix import cpan)
   #:use-module (guix base32)
   #:use-module (gcrypt hash)
-  #:use-module (guix tests)
+  #:use-module (guix tests http)
   #:use-module (guix grafts)
   #:use-module (srfi srfi-64)
+  #:use-module (web client)
   #:use-module (ice-9 match))
 
 ;; Globally disable grafts because they can trigger early builds.
@@ -57,32 +58,18 @@ (define test-json
 (define test-source
   "foobar")
 
+;; Avoid collisions with other tests.
+(%http-server-port 10400)
+
 (test-begin "cpan")
 
 (test-assert "cpan->guix-package"
   ;; Replace network resources with sample data.
-  (mock ((guix build download) url-fetch
+  (with-http-server `((200 ,test-json)
-         (lambda* (url file-name
+                      (200 ,test-source)
-                       #:key
+                      (200 "{ \"distribution\" : \"Test-Script\" }"))
-                       (mirrors '()) verify-certificate?)
+    (parameterize ((%metacpan-base-url (%local-url))
-           (with-output-to-file file-name
+                   (current-http-proxy (%local-url)))
-             (lambda ()
-               (display
-                (match url
-                  ("http://example.com/Foo-Bar-0.1.tar.gz"
-                   test-source)
-                  (_ (error "Unexpected URL: " url))))))))
-        (mock ((guix http-client) http-fetch
-               (lambda (url . rest)
-                 (match url
-                   ("https://fastapi.metacpan.org/v1/release/Foo-Bar"
-                    (values (open-input-string test-json)
-                            (string-length test-json)))
-                   ("https://fastapi.metacpan.org/v1/module/Test::Script?fields=distribution"
-                    (let ((result "{ \"distribution\" : \"Test-Script\" }"))
-                      (values (open-input-string result)
-                              (string-length result))))
-                   (_ (error "Unexpected URL: " url)))))
       (match (cpan->guix-package "Foo::Bar")
         (('package
            ('name "perl-foo-bar")