Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Mon, 11 Sep 2023 14:25:01 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: Ludovic Courtès <ludo <at> gnu.org> Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>, Tobias Geerinckx-Rice <me <at> tobias.gr>, Ricardo Wurmus <rekado <at> elephly.net>, 65866 <at> debbugs.gnu.org, Christopher Baines <guix <at> cbaines.net> Subject: [bug#65866] [PATCH 0/8] Add built-in builder for Git checkouts Date: Wed, 20 Sep 2023 13:50:09 -0400
Hello!
Ludovic Courtès <ludo <at> gnu.org> 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 <ludo <at> gnu.org>
> +;;; Copyright © 2012-2015, 2018-2019, 2021, 2023 Ludovic Courtès <ludo <at> gnu.org>
> ;;; Copyright © 2021 Lars-Dominik Braun <lars <at> 6xq.net>
> ;;;
> ;;; 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.