Subject: [bug#65866] [PATCH 0/8] Add built-in builder for Git checkouts

From: Maxim Cournoyer <[email-masked]>
Date: Wed, 20 Sep 2023 13:50:09 -0400

Hello!

Ludovic Courtès <[email-masked]> writes:

> Fixes <https://issues.guix.gnu.org/63331>.
>
> Longer-term this will remove Git from the derivation graph when its sole
> use is to perform a checkout for a fixed-output derivation, thereby
> breaking dependency cycles that can arise in these situations.
>
> * guix/git-download.scm (git-fetch): Rename to…
> (git-fetch/in-band): … this.  Deal with GIT or GUILE being #f.

Nitpick, but I find this usage of dynamic default argument on top of
default arguments inelegant; see my comments below for an
alternative.

> (git-fetch/built-in, built-in-builders*, git-fetch): New procedures.
> * tests/builders.scm ("git-fetch, file URI"): New test.
> ---
>  guix/git-download.scm | 68 +++++++++++++++++++++++++++++++++++++------
>  tests/builders.scm    | 29 +++++++++++++++++-
>  2 files changed, 87 insertions(+), 10 deletions(-)
>
> diff --git a/guix/git-download.scm b/guix/git-download.scm
> index f1f19397c6..505dff0a89 100644
> --- a/guix/git-download.scm
> +++ b/guix/git-download.scm
> @@ -27,6 +27,7 @@ (define-module (guix git-download)
>    #:use-module (guix records)
>    #:use-module (guix packages)
>    #:use-module (guix modules)
> +  #:use-module ((guix derivations) #:select (raw-derivation))
>    #:autoload   (guix build-system gnu) (standard-packages)
>    #:autoload   (guix download) (%download-fallback-test)
>    #:autoload   (git bindings)   (libgit2-init!)
> @@ -78,15 +79,19 @@ (define (git-package)
>    (let ((distro (resolve-interface '(gnu packages version-control))))
>      (module-ref distro 'git-minimal)))
>  
> -(define* (git-fetch ref hash-algo hash
> -                    #:optional name
> -                    #:key (system (%current-system)) (guile (default-guile))
> -                    (git (git-package)))
> -  "Return a fixed-output derivation that fetches REF, a <git-reference>
> -object.  The output is expected to have recursive hash HASH of type
> -HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
> +(define* (git-fetch/in-band ref hash-algo hash
> +                            #:optional name
> +                            #:key (system (%current-system))
> +                            (guile (default-guile))
> +                            (git (git-package)))
> +  "Return a fixed-output derivation that performs a Git checkout of REF, using
> +GIT and GUILE (thus, said derivation depends on GIT and GUILE).
> +
> +This method is deprecated in favor of the \"builtin:git-download\" builder.
> +It will be removed when versions of guix-daemon implementing
> +\"builtin:git-download\" will be sufficiently widespread."
>    (define inputs
> -    `(("git" ,git)
> +    `(("git" ,(or git (git-package)))

Instead of using 'or' here to ensure git has a value, the default values
should have been copied to the new definition of git-fetch.

>  
>        ;; When doing 'git clone --recursive', we need sed, grep, etc. to be
>        ;; available so that 'git submodule' works.
> @@ -154,7 +159,8 @@ (define* (git-fetch ref hash-algo hash
>                                       #:recursive? recursive?
>                                       #:git-command "git")))))
>  
> -  (mlet %store-monad ((guile (package->derivation guile system)))
> +  (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
> +                                                  system)))
>      (gexp->derivation (or name "git-checkout") build
>  
>                        ;; Use environment variables and a fixed script name so
> @@ -181,6 +187,50 @@ (define* (git-fetch ref hash-algo hash
>                        #:recursive? #t
>                        #:guile-for-build guile)))
>  
> +(define* (git-fetch/built-in ref hash-algo hash
> +                             #:optional name
> +                             #:key (system (%current-system)))
> +  "Return a fixed-output derivation without any dependency that performs a Git
> +checkout of REF, using the \"builtin:git-download\" derivation builder."
> +  (raw-derivation (or name "git-checkout") "builtin:git-download" '()
> +                  #:system system
> +                  #:hash-algo hash-algo
> +                  #:hash hash
> +                  #:recursive? #t
> +                  #:env-vars
> +                  `(("url" . ,(object->string
> +                               (match (%download-fallback-test)
> +                                 ('content-addressed-mirrors
> +                                  "https://example.org/does-not-exist")
> +                                 (_
> +                                  (git-reference-url ref)))))
> +                    ("commit" . ,(git-reference-commit ref))
> +                    ("recursive?" . ,(object->string
> +                                      (git-reference-recursive? ref))))
> +                  #:leaked-env-vars '("http_proxy" "https_proxy"
> +                                      "LC_ALL" "LC_MESSAGES" "LANG"
> +                                      "COLUMNS")
> +                  #:local-build? #t))
> +
> +(define built-in-builders*
> +  (store-lift built-in-builders))
> +
> +(define* (git-fetch ref hash-algo hash
> +                    #:optional name
> +                    #:key (system (%current-system))
> +                    guile git)

As mentioned above, I'd have kept the default values for guile and git
here.

> +  "Return a fixed-output derivation that fetches REF, a <git-reference>
> +object.  The output is expected to have recursive hash HASH of type
> +HASH-ALGO (a symbol).  Use NAME as the file name, or a generic name if #f."
> +  (mlet %store-monad ((builtins (built-in-builders*)))
> +    (if (member "git-download" builtins)
> +        (git-fetch/built-in ref hash-algo hash name
> +                            #:system system)
> +        (git-fetch/in-band ref hash-algo hash name
> +                           #:system system
> +                           #:guile guile
> +                           #:git git))))
> +
>  (define (git-version version revision commit)
>    "Return the version string for packages using git-download."
>    ;; git-version is almost exclusively executed while modules are being loaded.
> diff --git a/tests/builders.scm b/tests/builders.scm
> index 0b5577c7a3..619caa5f31 100644
> --- a/tests/builders.scm
> +++ b/tests/builders.scm
> @@ -1,5 +1,5 @@
>  ;;; GNU Guix --- Functional package management for GNU
> -;;; Copyright © 2012, 2013, 2014, 2015, 2018, 2019, 2021 Ludovic Courtès <[email-masked]>
> +;;; Copyright © 2012-2015, 2018-2019, 2021, 2023 Ludovic Courtès <[email-masked]>
>  ;;; Copyright © 2021 Lars-Dominik Braun <[email-masked]>
>  ;;;
>  ;;; This file is part of GNU Guix.
> @@ -20,6 +20,7 @@
>  
>  (define-module (tests builders)
>    #:use-module (guix download)
> +  #:use-module (guix git-download)
>    #:use-module (guix build-system)
>    #:use-module (guix build-system gnu)
>    #:use-module (guix build gnu-build-system)
> @@ -31,9 +32,12 @@ (define-module (tests builders)
>    #:use-module (guix base32)
>    #:use-module (guix derivations)
>    #:use-module (gcrypt hash)
> +  #:use-module ((guix hash) #:select (file-hash*))
>    #:use-module (guix tests)
> +  #:use-module (guix tests git)
>    #:use-module (guix packages)
>    #:use-module (gnu packages bootstrap)
> +  #:use-module ((ice-9 ftw) #:select (scandir))
>    #:use-module (ice-9 match)
>    #:use-module (ice-9 textual-ports)
>    #:use-module (srfi srfi-1)
> @@ -84,6 +88,29 @@ (define url-fetch*
>      (and (file-exists? out)
>           (valid-path? %store out))))
>  
> +(test-equal "git-fetch, file URI"
> +  '("." ".." "a.txt" "b.scm")
> +  (let ((nonce (random-text)))
> +    (with-temporary-git-repository directory
> +        `((add "a.txt" ,nonce)
> +          (add "b.scm" "#t")
> +          (commit "Commit.")
> +          (tag "v1.0.0" "The tag."))
> +      (run-with-store %store
> +        (mlet* %store-monad ((hash
> +                              -> (file-hash* directory
> +                                             #:algorithm (hash-algorithm sha256)
> +                                             #:recursive? #t))
> +                             (drv (git-fetch
> +                                   (git-reference
> +                                    (url (string-append "file://" directory))
> +                                    (commit "v1.0.0"))
> +                                   'sha256 hash
> +                                   "git-fetch-test")))
> +          (mbegin %store-monad
> +            (built-derivations (list drv))
> +            (return (scandir (derivation->output-path drv)))))))))
> +
>  (test-assert "gnu-build-system"
>    (build-system? gnu-build-system))

Pretty neat test!  LGTM.  You can add a 'Reviewed-by:' git trailer in
Magit easily with 'C-u C-c C-r' :-)

-- 
Thanks,
Maxim