08/09: git-download: Download from SWH by nar hash when possible.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 264fdbcaff9c078642355bace0c61c094b3581fc
Author: Ludovic Courtès <ludovic.courtes@inria.fr>
AuthorDate: Fri Jan 26 17:27:11 2024 +0100

    git-download: Download from SWH by nar hash when possible.
    
    * guix/build/git.scm (git-fetch-with-fallback): Add #:hash
    and #:hash-algorithm.  Try ‘swh-download-directory-by-nar-hash’ before
    ‘swh-download’ when #:hash is provided.
    * guix/git-download.scm (git-fetch/in-band*): Pass #:hash
    and #:hash-algorithm to ‘git-fetch-with-fallback’.
    * guix/scripts/perform-download.scm (perform-git-download): Likewise.
    
    Change-Id: Ic875a7022fd78c9fac32e92ad4f8ce4d81646ec5
---
 guix/build/git.scm                | 20 ++++++++++++++++----
 guix/git-download.scm             |  4 +++-
 guix/scripts/perform-download.scm |  4 +++-
 3 files changed, 22 insertions(+), 6 deletions(-)

diff --git a/guix/build/git.scm b/guix/build/git.scm
index 867cade2c4..4c69365a7b 100644
--- a/guix/build/git.scm
+++ b/guix/build/git.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2016, 2019, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2016, 2019, 2023-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -20,7 +20,9 @@
 (define-module (guix build git)
   #:use-module (guix build utils)
   #:autoload   (guix build download-nar) (download-nar)
-  #:autoload   (guix swh) (%verify-swh-certificate? swh-download)
+  #:autoload   (guix swh) (%verify-swh-certificate?
+                           swh-download
+                           swh-download-directory-by-nar-hash)
   #:use-module (srfi srfi-34)
   #:use-module (ice-9 format)
   #:export (git-fetch
@@ -91,10 +93,13 @@ fetched, recursively.  Return #t on success, #f otherwise."
 
 (define* (git-fetch-with-fallback url commit directory
                                   #:key (git-command "git")
+                                  hash hash-algorithm
                                   lfs? recursive?)
   "Like 'git-fetch', fetch COMMIT from URL into DIRECTORY, but fall back to
 alternative methods when fetching from URL fails: attempt to download a nar,
-and if that also fails, download from the Software Heritage archive."
+and if that also fails, download from the Software Heritage archive.  When
+HASH and HASH-ALGORITHM are provided, they are interpreted as the nar hash of
+the directory of interested and are used as its content address at SWH."
   (or (git-fetch url commit directory
                  #:lfs? lfs?
                  #:recursive? recursive?
@@ -110,7 +115,14 @@ and if that also fails, download from the Software 
Heritage archive."
              (format (current-error-port)
                      "Trying to download from Software Heritage...~%")
 
-             (swh-download url commit directory)
+             ;; First try to look up and download the directory corresponding
+             ;; to HASH: this is fundamentally more reliable than looking up
+             ;; COMMIT, especially when COMMIT denotes a tag.
+             (or (and hash hash-algorithm
+                      (swh-download-directory-by-nar-hash hash hash-algorithm
+                                                          directory))
+                 (swh-download url commit directory))
+
              (when (file-exists?
                     (string-append directory "/.gitattributes"))
                ;; Perform CR/LF conversion and other changes
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 3de6ae970d..aadcbd234c 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014-2021, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2021, 2023-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
@@ -165,6 +165,8 @@ respective documentation."
 
             (git-fetch-with-fallback (getenv "git url") (getenv "git commit")
                                      #$output
+                                     #:hash #$hash
+                                     #:hash-algorithm '#$hash-algo
                                      #:lfs? lfs?
                                      #:recursive? recursive?
                                      #:git-command "git")))))
diff --git a/guix/scripts/perform-download.scm 
b/guix/scripts/perform-download.scm
index 9aa0e61e9d..e7eb3b2a1f 100644
--- a/guix/scripts/perform-download.scm
+++ b/guix/scripts/perform-download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016-2018, 2020, 2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016-2018, 2020, 2023-2024 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -115,6 +115,8 @@ Note: OUTPUT may differ from the 'out' value of DRV, 
notably for 'bmCheck' or
       (setenv "PATH" "/run/current-system/profile/bin:/bin:/usr/bin")
 
       (git-fetch-with-fallback url commit output
+                               #:hash hash
+                               #:hash-algorithm algo
                                #:recursive? recursive?
                                #:git-command %git))))