Adding content-addressed URLs to https://guix.gnu.org/sources.json

["Ludovic Courtès" <ludovic.courtes@inria.fr>]

[-- Attachment #1: Type: text/plain, Size: 1588 bytes --]

Hi,

Simon Tournier <zimon.toutoune@gmail.com> skribis:

> On Thu, 16 Mar 2023 at 12:48, Ludovic Courtès <ludovic.courtes@inria.fr> wrote:
>
>>   1. Reproducibility of past revisions.  If we lose copies of the
>>      auto-generated tarballs, then OpenJDK in past revisions of Guix is
>>      irreparably lost.  We should check whether/how to get them in
>>      Disarchive + SWH.
>
> The file sources.json that SWH ingests only contains original upstream
> and not our copies.  One step forward would be to also list the URL of
> our tarball substitutes as the last mirror in sources.json.

The patch below (against maintenance.git) does that.  The result is
something like this:

--8<---------------cut here---------------start------------->8---
{
  "type": "url",
  "urls": [
    "https://ftpmirror.gnu.org/gnu/zile/zile-2.6.2.tar.gz",
    "ftp://ftp.cs.tu-berlin.de/pub/gnu/zile/zile-2.6.2.tar.gz",
    "ftp://ftp.funet.fi/pub/mirrors/ftp.gnu.org/gnu/zile/zile-2.6.2.tar.gz",
    "http://ftp.gnu.org/pub/gnu/zile/zile-2.6.2.tar.gz",
    "https://bordeaux.guix.gnu.org/file/zile-2.6.2.tar.gz/sha256/0hf788zadmwx0xp1dhrgqcfvhwnarh6h9b51va4dr2y9yfppvsvp",
    "https://ci.guix.gnu.org/file/zile-2.6.2.tar.gz/sha256/0hf788zadmwx0xp1dhrgqcfvhwnarh6h9b51va4dr2y9yfppvsvp",
    "https://tarballs.nixos.org/sha256/0hf788zadmwx0xp1dhrgqcfvhwnarh6h9b51va4dr2y9yfppvsvp"
  ],
  "integrity": "sha256-d+t9r/PJi9yI2qGsBA3MynK4HcMvwxZuB53Xpj5Cx0E="
},
--8<---------------cut here---------------end--------------->8---

How does that sound?

Thanks,
Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 3205 bytes --]

diff --git a/hydra/build-package-metadata.scm b/hydra/build-package-metadata.scm
index 6fa2173..1ddb409 100755
--- a/hydra/build-package-metadata.scm
+++ b/hydra/build-package-metadata.scm
@@ -30,6 +30,7 @@
              (guix utils)
              (guix gexp)
              ((guix build download) #:select (maybe-expand-mirrors))
+             ((guix base32) #:select (bytevector->nix-base32-string))
              ((guix base64) #:select (base64-encode))
              ((guix describe) #:select (current-profile))
              ((guix config) #:select (%guix-version))
@@ -73,6 +74,27 @@ superseded packages."
 ;;; Required by 'origin->json' for 'computed-origin-method' corner cases
 (define gexp-references (@@ (guix gexp) gexp-references))
 
+(define %content-addressed-mirrors
+  ;; List of content-addressed mirrors.
+  ;; XXX: somewhat duplicated from (guix download)
+  (let ((guix-publish
+         (lambda (host)
+           (lambda (file hash)
+             ;; Files served by 'guix publish'.
+             (string-append "https://" host "/file/"
+                            file "/" (symbol->string
+                                      (content-hash-algorithm hash))
+                            "/" (bytevector->nix-base32-string
+                                 (content-hash-value hash)))))))
+
+    (list (guix-publish "bordeaux.guix.gnu.org")
+          (guix-publish "ci.guix.gnu.org")
+          (lambda (file hash)
+            (string-append "https://tarballs.nixos.org/"
+                           (symbol->string (content-hash-algorithm hash))
+                           "/" (bytevector->nix-base32-string
+                                (content-hash-value hash)))))))
+
 (define (origin->json origin)
   "Return a list of JSON representations (an alist) of ORIGIN."
   (define method
@@ -81,10 +103,17 @@ superseded packages."
   (define uri
     (origin-uri origin))
 
-  (define (resolve urls)
-    (map uri->string
-         (append-map (cut maybe-expand-mirrors <> %mirrors)
-                     (map string->uri urls))))
+  (define (resolve urls hash)
+    (append (map uri->string
+                 (append-map (cut maybe-expand-mirrors <> %mirrors)
+                             (map string->uri urls)))
+            (if hash
+                (let ((file (origin-actual-file-name origin))
+                      (hash (origin-hash origin)))
+                  (map (lambda (make-url)
+                         (make-url file hash))
+                       %content-addressed-mirrors))
+                '())))
 
   (if (eq? method (@@ (guix packages) computed-origin-method))
       ;; Packages in gnu/packages/gnuzilla.scm and gnu/packages/linux.scm
@@ -118,7 +147,8 @@ superseded packages."
                                 (resolve
                                  (match uri
                                    ((? string? url) (list url))
-                                   ((urls ...) urls)))))))
+                                   ((urls ...) urls))
+                                 (origin-hash origin))))))
                  ((eq? git-fetch method)
                   `(("git_url" . ,(git-reference-url uri))))
                  ((eq? svn-fetch method)