daemon: Add “git-download” built-in builder.

The new builder makes it possible to break cycles that occurs when the
fixed-output derivation for the source of a dependency of ‘git’ would
itself depend on ‘git’.

* guix/scripts/perform-download.scm (perform-git-download): New
procedure.
(perform-download): Move fixed-output derivation check to…
(guix-perform-download): … here.  Invoke ‘perform-download’ or
‘perform-git-download’ depending on what ‘derivation-builder’ returns.
* nix/libstore/builtins.cc (builtins): Add “git-download”.
* tests/derivations.scm ("built-in-builders"): Update.
("'git-download' built-in builder")
("'git-download' built-in builder, invalid hash")
("'git-download' built-in builder, invalid commit")
("'git-download' built-in builder, not found"): New tests.

1 files changed, 98 insertions, 2 deletions

diff --git a/tests/derivations.scm b/tests/derivations.scm
index 66c777cfe7..e1312bd46b 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -24,10 +24,15 @@
   #:use-module (guix utils)
   #:use-module ((gcrypt hash) #:prefix gcrypt:)
   #:use-module (guix base32)
+  #:use-module ((guix git) #:select (with-repository))
   #:use-module (guix tests)
+  #:use-module (guix tests git)
   #:use-module (guix tests http)
   #:use-module ((guix packages) #:select (package-derivation base32))
-  #:use-module ((guix build utils) #:select (executable-file?))
+  #:use-module ((guix build utils) #:select (executable-file? which))
+  #:use-module ((guix hash) #:select (file-hash*))
+  #:use-module ((git oid) #:select (oid->string))
+  #:use-module ((git reference) #:select (reference-name->oid))
   #:use-module (gnu packages bootstrap)
   #:use-module ((gnu packages guile) #:select (guile-1.8))
   #:use-module (srfi srfi-1)
@@ -195,7 +200,7 @@
                    (stat:ino (lstat file2))))))))
 
 (test-equal "built-in-builders"
-  '("download")
+  '("download" "git-download")
   (built-in-builders %store))
 
 (test-assert "unknown built-in builder"
@@ -290,6 +295,97 @@
                          get-string-all)
                        text))))))
 
+;; 'with-temporary-git-repository' relies on the 'git' command.
+(unless (which (git-command)) (test-skip 1))
+(test-equal "'git-download' built-in builder"
+  `(("/a.txt" . "AAA")
+    ("/b.scm" . "#t"))
+  (let ((nonce (random-text)))
+    (with-temporary-git-repository directory
+        `((add "a.txt" "AAA")
+          (add "b.scm" "#t")
+          (commit ,nonce))
+      (let* ((commit (with-repository directory repository
+                       (oid->string
+                        (reference-name->oid repository "HEAD"))))
+             (drv (derivation %store "git-download"
+                              "builtin:git-download" '()
+                              #:env-vars
+                              `(("url"
+                                 . ,(object->string
+                                     (string-append "file://" directory)))
+                                ("commit" . ,commit))
+                              #:hash-algo 'sha256
+                              #:hash (file-hash* directory
+                                                 #:algorithm
+                                                 (gcrypt:hash-algorithm
+                                                  gcrypt:sha256)
+                                                 #:recursive? #t)
+                              #:recursive? #t)))
+        (build-derivations %store (list drv))
+        (directory-contents (derivation->output-path drv) get-string-all)))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-assert "'git-download' built-in builder, invalid hash"
+  (with-temporary-git-repository directory
+      `((add "a.txt" "AAA")
+        (add "b.scm" "#t")
+        (commit "Commit!"))
+    (let* ((commit (with-repository directory repository
+                     (oid->string
+                      (reference-name->oid repository "HEAD"))))
+           (drv (derivation %store "git-download"
+                            "builtin:git-download" '()
+                            #:env-vars
+                            `(("url"
+                               . ,(object->string
+                                   (string-append "file://" directory)))
+                              ("commit" . ,commit))
+                            #:hash-algo 'sha256
+                            #:hash (gcrypt:sha256 #vu8())
+                            #:recursive? #t)))
+      (guard (c ((store-protocol-error? c)
+                 (string-contains (store-protocol-error-message c) "failed")))
+        (build-derivations %store (list drv))
+        #f))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-assert "'git-download' built-in builder, invalid commit"
+  (with-temporary-git-repository directory
+      `((add "a.txt" "AAA")
+        (add "b.scm" "#t")
+        (commit "Commit!"))
+    (let* ((drv (derivation %store "git-download"
+                            "builtin:git-download" '()
+                            #:env-vars
+                            `(("url"
+                               . ,(object->string
+                                   (string-append "file://" directory)))
+                              ("commit"
+                               . "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))
+                            #:hash-algo 'sha256
+                            #:hash (gcrypt:sha256 #vu8())
+                            #:recursive? #t)))
+      (guard (c ((store-protocol-error? c)
+                 (string-contains (store-protocol-error-message c) "failed")))
+        (build-derivations %store (list drv))
+        #f))))
+
+(test-assert "'git-download' built-in builder, not found"
+  (let* ((drv (derivation %store "git-download"
+                          "builtin:git-download" '()
+                          #:env-vars
+                          `(("url" . "file:///does-not-exist.git")
+                            ("commit"
+                             . "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))
+                          #:hash-algo 'sha256
+                          #:hash (gcrypt:sha256 #vu8())
+                          #:recursive? #t)))
+    (guard (c ((store-protocol-error? c)
+               (string-contains (store-protocol-error-message c) "failed")))
+      (build-derivations %store (list drv))
+      #f)))
+
 (test-equal "derivation-name"
   "foo-0.0"
   (let ((drv (derivation %store "foo-0.0" %bash '())))