[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