03/12: download: Disarchive mirrors can be URL-returning procedures.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 3cb5ae8577db28b2c6013b9d9ecf99cb696e3432
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue Sep 14 10:11:42 2021 +0200

    download: Disarchive mirrors can be URL-returning procedures.
    
    As discussed at <https://issues.guix.gnu.org/47336#16>.
    
    * guix/build/download.scm (url-fetch)[disarchive-uris]: Accept MIRROR as
    a procedure.
    * guix/download.scm (%disarchive-mirrors): Add comment.  This change can
    only be made once a 'guix perform-download' that understands procedures
    is widely deployed.
---
 guix/build/download.scm | 23 ++++++++++++++---------
 guix/download.scm       |  2 ++
 2 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/guix/build/download.scm b/guix/build/download.scm
index 54627ee..c8ddadf 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -747,15 +747,20 @@ otherwise simply ignore them."
                 content-addressed-mirrors))
 
   (define disarchive-uris
-    (append-map (match-lambda
-                  ((? string? mirror)
-                   (map (match-lambda
-                          ((hash-algo . hash)
-                           (string->uri
-                            (string-append mirror
-                                           (symbol->string hash-algo) "/"
-                                           (bytevector->base16-string hash)))))
-                        hashes)))
+    (append-map (lambda (mirror)
+                  (let ((make-url (match mirror
+                                    ((? string?)
+                                     (lambda (hash-algo hash)
+                                       (string-append
+                                        mirror
+                                        (symbol->string hash-algo) "/"
+                                        (bytevector->base16-string hash))))
+                                    ((? procedure?)
+                                     mirror))))
+                    (map (match-lambda
+                           ((hash-algo . hash)
+                            (string->uri (make-url hash-algo hash))))
+                         hashes)))
                 disarchive-mirrors))
 
   ;; Make this unbuffered so 'progress-report/file' works as expected.  'line
diff --git a/guix/download.scm b/guix/download.scm
index a66cf0c..85b97a4 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -400,6 +400,8 @@
               (object->string %content-addressed-mirrors)))
 
 (define %disarchive-mirrors
+  ;; TODO: Eventually turn into a procedure that takes a hash algorithm
+  ;; (symbol) and hash (bytevector).
   '("https://disarchive.ngyro.com/";))
 
 (define %disarchive-mirror-file