[bug#41382] [PATCH 0/6] Allow for a cryptographic hash function migration

[bug#41382] [PATCH 0/6] Allow for a cryptographic hash function migration

[Ludovic Courtès]

Hello Guix!

This is a first stab at preparing for a possible migration to
hash algorithms other than SHA256 (there’s no rush AFAIK, but it’s
good to be prepared).  The first bits just improve tests and
adjust the tools, which doesn’t hurt.

The last bit adds a ‘sha512’ field to <origin>, which we could
eventually provide instead of or in addition to ‘sha256’, possibly
as a base64-encoded string so that it’s not too large.

Another option would be to create a <hash> data type that specifies
its algorithm and its value.  We’d replace the ‘sha256’ field with
a ‘hash’ field of that type (in a backward-compatible way).  Thinking
about it, this is perhaps the better option.

Other bits that would need to be adjusted include importer, updaters,
and ‘guix publish’.

Thoughts?

Ludo’.

Ludovic Courtès (6):
  tests: Test 'add-to-store' with several hash algorithms.
  tests: Test fixed-output derivations with several hash algorithms.
  guix hash, guix download: Add '--hash'.
  guix hash, guix download: Support base64 format.
  packages: Add 'sha512' optional field to <origin>.
  packages: Add 'base64' macro.

 doc/guix.texi             | 25 +++++++++++++++--
 guix/packages.scm         | 56 +++++++++++++++++++++++----------------
 guix/scripts/download.scm | 26 +++++++++++++-----
 guix/scripts/hash.scm     | 35 +++++++++++++++++-------
 tests/derivations.scm     | 39 ++++++++++++++++-----------
 tests/guix-hash.sh        |  7 ++++-
 tests/packages.scm        | 26 ++++++++++++++++++
 tests/store.scm           | 12 +++++++++
 8 files changed, 170 insertions(+), 56 deletions(-)

-- 
2.26.2

[bug#41382] [PATCH 1/6] tests: Test 'add-to-store' with several hash algorithms.

[Ludovic Courtès]

* tests/store.scm ("add-to-store"): New test.
---
 tests/store.scm | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/tests/store.scm b/tests/store.scm
index 0af099c1ad..f007846dc1 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -115,6 +115,18 @@
                                 (passwd:name (getpwuid (getuid)))))))
     (list (stat:uid s) (stat:perms s))))
 
+(test-equal "add-to-store"
+  '("sha1" "sha256" "sha512")
+  (let* ((file    (search-path %load-path "guix.scm"))
+         (content (call-with-input-file file get-bytevector-all)))
+    (map (lambda (hash-algo)
+           (let ((file (add-to-store %store "guix.scm" #f hash-algo file)))
+             (and (direct-store-path? file)
+                  (bytevector=? (call-with-input-file file get-bytevector-all)
+                                content)
+                  hash-algo)))
+         '("sha1" "sha256" "sha512"))))
+
 (test-equal "add-data-to-store"
   #vu8(1 2 3 4 5)
   (call-with-input-file (add-data-to-store %store "data" #vu8(1 2 3 4 5))
-- 
2.26.2

[bug#41382] [PATCH 2/6] tests: Test fixed-output derivations with several hash algorithms.

[Ludovic Courtès]

* tests/derivations.scm ("fixed-output derivation"): Test several hash
algorithms.
---
 tests/derivations.scm | 39 ++++++++++++++++++++++++---------------
 1 file changed, 24 insertions(+), 15 deletions(-)

diff --git a/tests/derivations.scm b/tests/derivations.scm
index ef6cec6c76..a409fa99f0 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -324,20 +324,29 @@
                                  #:hash hash #:hash-algo 'sha256)))
     (fixed-output-derivation? drv)))
 
-(test-assert "fixed-output derivation"
-  (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
-                                        "echo -n hello > $out" '()))
-         (hash       (sha256 (string->utf8 "hello")))
-         (drv        (derivation %store "fixed"
-                                 %bash `(,builder)
-                                 #:sources `(,builder) ;optional
-                                 #:hash hash #:hash-algo 'sha256))
-         (succeeded? (build-derivations %store (list drv))))
-    (and succeeded?
-         (let ((p (derivation->output-path drv)))
-           (and (equal? (string->utf8 "hello")
-                        (call-with-input-file p get-bytevector-all))
-                (bytevector? (query-path-hash %store p)))))))
+(test-equal "fixed-output derivation"
+  '(sha1 sha256 sha512)
+  (map (lambda (hash-algorithm)
+         (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
+                                            "echo -n hello > $out" '()))
+                (sha256  (sha256 (string->utf8 "hello")))
+                (hash    (bytevector-hash
+                          (string->utf8 "hello")
+                          (lookup-hash-algorithm hash-algorithm)))
+                (drv     (derivation %store
+                                     (string-append
+                                      "fixed-" (symbol->string hash-algorithm))
+                                     %bash `(,builder)
+                                     #:sources `(,builder) ;optional
+                                     #:hash hash
+                                     #:hash-algo hash-algorithm)))
+           (build-derivations %store (list drv))
+           (let ((p (derivation->output-path drv)))
+             (and (bytevector=? (string->utf8 "hello")
+                                (call-with-input-file p get-bytevector-all))
+                  (bytevector? (query-path-hash %store p))
+                  hash-algorithm))))
+       '(sha1 sha256 sha512)))
 
 (test-assert "fixed-output derivation: output paths are equal"
   (let* ((builder1   (add-text-to-store %store "fixed-builder1.sh"
-- 
2.26.2

[bug#41382] [PATCH 3/6] guix hash, guix download: Add '--hash'.

[Ludovic Courtès]

* guix/scripts/download.scm (%default-options): Add 'hash-algorithm'.
(show-help, %options): Add "--hash".
(guix-download): Honor it.
* guix/scripts/hash.scm (%default-options): Add 'hash-algorithm'.
(show-help, %options): Add "--hash".
(guix-hash): Honor it.
* tests/guix-hash.sh: Test '-H sha512'.
* doc/guix.texi (Invoking guix download): Document it.
(Invoking guix hash): Document it.
---
 doc/guix.texi             | 15 +++++++++++++++
 guix/scripts/download.scm | 14 ++++++++++++--
 guix/scripts/hash.scm     | 21 +++++++++++++++++----
 tests/guix-hash.sh        |  6 +++++-
 4 files changed, 49 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index eef5b703fe..0cf006770e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9018,6 +9018,11 @@ Certificates}), unless @option{--no-check-certificate} is used.
 The following options are available:
 
 @table @code
+@item --hash=@var{algorithm}
+@itemx -H @var{algorithm}
+Compute a hash using the specified @var{algorithm}.  @xref{Invoking guix
+hash}, for more information.
+
 @item --format=@var{fmt}
 @itemx -f @var{fmt}
 Write the hash in the format specified by @var{fmt}.  For more
@@ -9057,6 +9062,16 @@ following options:
 
 @table @code
 
+@item --hash=@var{algorithm}
+@itemx -H @var{algorithm}
+Compute a hash using the specified @var{algorithm}, @code{sha256} by
+default.
+
+@var{algorithm} must the name of a cryptographic hash algorithm
+supported by Libgcrypt @i{via} Guile-Gcrypt---e.g., @code{sha512} or
+@code{sha3-256} (@pxref{Hash Functions,,, guile-gcrypt, Guile-Gcrypt
+Reference Manual}).
+
 @item --format=@var{fmt}
 @itemx -f @var{fmt}
 Write the hash in the format specified by @var{fmt}.
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index 22cd75ea0b..b4446c2e2f 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2015, 2016, 2017, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -77,6 +77,7 @@
 (define %default-options
   ;; Alist of default option values.
   `((format . ,bytevector->nix-base32-string)
+    (hash-algorithm . ,(hash-algorithm sha256))
     (verify-certificate? . #t)
     (download-proc . ,download-to-store*)))
 
@@ -89,6 +90,8 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
 ('hex' and 'hexadecimal' can be used as well).\n"))
   (format #t (G_ "
   -f, --format=FMT       write the hash in the given format"))
+  (format #t (G_ "
+  -H, --hash=ALGORITHM   use the given hash ALGORITHM"))
   (format #t (G_ "
       --no-check-certificate
                          do not validate the certificate of HTTPS servers "))
@@ -119,6 +122,13 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
 
                   (alist-cons 'format fmt-proc
                               (alist-delete 'format result))))
+        (option '(#\H "hash") #t #f
+                (lambda (opt name arg result)
+                  (match (lookup-hash-algorithm (string->symbol arg))
+                    (#f
+                     (leave (G_ "~a: unknown hash algorithm~%") arg))
+                    (algo
+                     (alist-cons 'hash-algorithm algo result)))))
         (option '("no-check-certificate") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'verify-certificate? #f result)))
@@ -175,7 +185,7 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
                       (or path
                           (leave (G_ "~a: download failed~%")
                                  arg))
-                    port-sha256))
+                    (cute port-hash (assoc-ref opts 'hash-algorithm) <>)))
            (fmt   (assq-ref opts 'format)))
       (format #t "~a~%~a~%" path (fmt hash))
       #t)))
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index b8b2158195..cfc4420260 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2016, 2017, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
@@ -42,7 +42,8 @@
 
 (define %default-options
   ;; Alist of default option values.
-  `((format . ,bytevector->nix-base32-string)))
+  `((format . ,bytevector->nix-base32-string)
+    (hash-algorithm . ,(hash-algorithm sha256))))
 
 (define (show-help)
   (display (G_ "Usage: guix hash [OPTION] FILE
@@ -53,6 +54,8 @@ and 'hexadecimal' can be used as well).\n"))
   (format #t (G_ "
   -x, --exclude-vcs      exclude version control directories"))
   (format #t (G_ "
+  -H, --hash=ALGORITHM   use the given hash ALGORITHM"))
+  (format #t (G_ "
   -f, --format=FMT       write the hash in the given format"))
   (format #t (G_ "
   -r, --recursive        compute the hash on FILE recursively"))
@@ -69,6 +72,13 @@ and 'hexadecimal' can be used as well).\n"))
   (list (option '(#\x "exclude-vcs") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'exclude-vcs? #t result)))
+        (option '(#\H "hash") #t #f
+                (lambda (opt name arg result)
+                  (match (lookup-hash-algorithm (string->symbol arg))
+                    (#f
+                     (leave (G_ "~a: unknown hash algorithm~%") arg))
+                    (algo
+                     (alist-cons 'hash-algorithm algo result)))))
         (option '(#\f "format") #t #f
                 (lambda (opt name arg result)
                   (define fmt-proc
@@ -139,8 +149,11 @@ and 'hexadecimal' can be used as well).\n"))
               (force-output port)
               (get-hash))
             (match file
-              ("-" (port-sha256 (current-input-port)))
-              (_   (call-with-input-file file port-sha256))))))
+              ("-" (port-hash (assoc-ref opts 'hash-algorithm)
+                              (current-input-port)))
+              (_   (call-with-input-file file
+                     (cute port-hash (assoc-ref opts 'hash-algorithm)
+                           <>)))))))
 
     (match args
       ((file)
diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh
index 190c9e7f8a..1c595b49ed 100644
--- a/tests/guix-hash.sh
+++ b/tests/guix-hash.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2013, 2014, 2016, 2020 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
 #
 # This file is part of GNU Guix.
@@ -31,6 +31,10 @@ test `echo -n | guix hash -` = 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9
 test `guix hash -f nix-base32 /dev/null` = 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73
 test `guix hash -f hex /dev/null` = e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855
 test `guix hash -f base32 /dev/null` = 4oymiquy7qobjgx36tejs35zeqt24qpemsnzgtfeswmrw6csxbkq
+test `guix hash -H sha512 -f hex /dev/null` = cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e
+
+if guix hash -H abcd1234 /dev/null;
+then false; else true; fi
 
 mkdir "$tmpdir"
 echo -n executable > "$tmpdir/exe"
-- 
2.26.2

[bug#41382] [PATCH 4/6] guix hash, guix download: Support base64 format.

[Ludovic Courtès]

* guix/scripts/download.scm (show-help, %options): Support "base64"
format.
* guix/scripts/hash.scm (show-help, %options): Likewise.
* tests/guix-hash.sh: Test it.
* doc/guix.texi (Invoking guix hash): Document it.
---
 doc/guix.texi             |  2 +-
 guix/scripts/download.scm | 12 ++++++++----
 guix/scripts/hash.scm     | 14 +++++++++-----
 tests/guix-hash.sh        |  1 +
 4 files changed, 19 insertions(+), 10 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 0cf006770e..fdd9622211 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -9076,7 +9076,7 @@ Reference Manual}).
 @itemx -f @var{fmt}
 Write the hash in the format specified by @var{fmt}.
 
-Supported formats: @code{nix-base32}, @code{base32}, @code{base16}
+Supported formats: @code{base64}, @code{nix-base32}, @code{base32}, @code{base16}
 (@code{hex} and @code{hexadecimal} can be used as well).
 
 If the @option{--format} option is not specified, @command{guix hash}
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index b4446c2e2f..589f62da9d 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -23,6 +23,7 @@
   #:use-module (gcrypt hash)
   #:use-module (guix base16)
   #:use-module (guix base32)
+  #:autoload   (guix base64) (base64-encode)
   #:use-module ((guix download) #:hide (url-fetch))
   #:use-module ((guix build download)
                 #:select (url-fetch))
@@ -84,10 +85,11 @@
 (define (show-help)
   (display (G_ "Usage: guix download [OPTION] URL
 Download the file at URL to the store or to the given file, and print its
-file name and the hash of its contents.
-
-Supported formats: 'nix-base32' (default), 'base32', and 'base16'
-('hex' and 'hexadecimal' can be used as well).\n"))
+file name and the hash of its contents.\n"))
+  (newline)
+  (display (G_ "\
+Supported formats: 'base64', 'nix-base32' (default), 'base32',
+and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
   (format #t (G_ "
   -f, --format=FMT       write the hash in the given format"))
   (format #t (G_ "
@@ -111,6 +113,8 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
                 (lambda (opt name arg result)
                   (define fmt-proc
                     (match arg
+                      ("base64"
+                       base64-encode)
                       ("nix-base32"
                        bytevector->nix-base32-string)
                       ("base32"
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index cfc4420260..9b4f419a24 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -20,12 +20,13 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix scripts hash)
-  #:use-module (guix base32)
   #:use-module (gcrypt hash)
   #:use-module (guix serialization)
   #:use-module (guix ui)
   #:use-module (guix scripts)
   #:use-module (guix base16)
+  #:use-module (guix base32)
+  #:autoload   (guix base64) (base64-encode)
   #:use-module (ice-9 binary-ports)
   #:use-module (rnrs files)
   #:use-module (ice-9 match)
@@ -47,10 +48,11 @@
 
 (define (show-help)
   (display (G_ "Usage: guix hash [OPTION] FILE
-Return the cryptographic hash of FILE.
-
-Supported formats: 'nix-base32' (default), 'base32', and 'base16' ('hex'
-and 'hexadecimal' can be used as well).\n"))
+Return the cryptographic hash of FILE.\n"))
+  (newline)
+  (display (G_ "\
+Supported formats: 'base64', 'nix-base32' (default), 'base32',
+and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
   (format #t (G_ "
   -x, --exclude-vcs      exclude version control directories"))
   (format #t (G_ "
@@ -83,6 +85,8 @@ and 'hexadecimal' can be used as well).\n"))
                 (lambda (opt name arg result)
                   (define fmt-proc
                     (match arg
+                      ("base64"
+                       base64-encode)
                       ("nix-base32"
                        bytevector->nix-base32-string)
                       ("base32"
diff --git a/tests/guix-hash.sh b/tests/guix-hash.sh
index 1c595b49ed..3538b9aeda 100644
--- a/tests/guix-hash.sh
+++ b/tests/guix-hash.sh
@@ -32,6 +32,7 @@ test `guix hash -f nix-base32 /dev/null` = 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lz
 test `guix hash -f hex /dev/null` = e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855
 test `guix hash -f base32 /dev/null` = 4oymiquy7qobjgx36tejs35zeqt24qpemsnzgtfeswmrw6csxbkq
 test `guix hash -H sha512 -f hex /dev/null` = cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e
+test `guix hash -H sha1 -f base64 /dev/null` = "2jmj7l5rSw0yVb/vlWAYkK/YBwk="
 
 if guix hash -H abcd1234 /dev/null;
 then false; else true; fi
-- 
2.26.2

[bug#41382] [PATCH 5/6] packages: Add 'sha512' optional field to <origin>.

[Ludovic Courtès]

* guix/packages.scm (<origin>)[sha512]: New field.
(print-origin): Honor it.
(origin->derivation): Likewise.
* tests/packages.scm ("package-source-derivation, origin, sha512"): New
test.
* doc/guix.texi (origin Reference): Document 'sha512'.
---
 doc/guix.texi      |  8 +++++++-
 guix/packages.scm  | 25 ++++++++++++++-----------
 tests/packages.scm | 26 ++++++++++++++++++++++++++
 3 files changed, 47 insertions(+), 12 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index fdd9622211..50d7eb7a43 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5966,10 +5966,16 @@ specified in the @code{uri} field as a @code{git-reference} object; a
 @end table
 
 @item @code{sha256}
-A bytevector containing the SHA-256 hash of the source.  Typically the
+@itemx @code{sha512}
+A bytevector containing the SHA-256 (respectively SHA-512) hash of the source.  Typically the
 @code{base32} form is used here to generate the bytevector from a
 base-32 string.
 
+One of these fields must be a bytevector while the others can be
+@code{#f}.  When several hashes are provided, the ``strongest'' is used
+when computing the underlying fixed-output derivation
+(@pxref{Derivations}).
+
 You can obtain this information using @code{guix download}
 (@pxref{Invoking guix download}) or @code{guix hash} (@pxref{Invoking
 guix hash}).
diff --git a/guix/packages.scm b/guix/packages.scm
index 3fff50a6e8..7cf4c9c3e6 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -164,6 +164,7 @@
   (uri       origin-uri)                          ; string
   (method    origin-method)                       ; procedure
   (sha256    origin-sha256)                       ; bytevector
+  (sha512    origin-sha512 (default #f))          ; bytevector | #f
   (file-name origin-file-name (default #f))       ; optional file name
 
   ;; Patches are delayed so that the 'search-patch' calls are made lazily,
@@ -189,9 +190,9 @@
 (define (print-origin origin port)
   "Write a concise representation of ORIGIN to PORT."
   (match origin
-    (($ <origin> uri method sha256 file-name patches)
+    (($ <origin> uri method sha256 sha512 file-name patches)
      (simple-format port "#<origin ~s ~a ~s ~a>"
-                    uri (bytevector->base32-string sha256)
+                    uri (bytevector->base32-string (or sha512 sha256))
                     (force patches)
                     (number->string (object-address origin) 16)))))
 
@@ -1381,18 +1382,20 @@ unless you know what you are doing."
                              #:optional (system (%current-system)))
   "Return the derivation corresponding to ORIGIN."
   (match origin
-    (($ <origin> uri method sha256 name (= force ()) #f)
+    (($ <origin> uri method sha256 sha512 name (= force ()) #f)
      ;; No patches, no snippet: this is a fixed-output derivation.
-     (method uri 'sha256 sha256 name #:system system))
-    (($ <origin> uri method sha256 name (= force (patches ...)) snippet
+     (let ((algorithm (if sha512 'sha512 'sha256)))
+       (method uri algorithm (or sha512 sha256) name #:system system)))
+    (($ <origin> uri method sha256 sha512 name (= force (patches ...)) snippet
         (flags ...) inputs (modules ...) guile-for-build)
      ;; Patches and/or a snippet.
-     (mlet %store-monad ((source (method uri 'sha256 sha256 name
-                                         #:system system))
-                         (guile  (package->derivation (or guile-for-build
-                                                          (default-guile))
-                                                      system
-                                                      #:graft? #f)))
+     (mlet* %store-monad ((algorithm -> (if sha512 'sha512 'sha256))
+                          (source (method uri algorithm (or sha512 sha256)
+                                          name #:system system))
+                          (guile  (package->derivation (or guile-for-build
+                                                           (default-guile))
+                                                       system
+                                                       #:graft? #f)))
        (patch-and-repack source patches
                          #:inputs inputs
                          #:snippet snippet
diff --git a/tests/packages.scm b/tests/packages.scm
index c528d2080c..06d41b5ce7 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -51,6 +51,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-64)
+  #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 regex)
@@ -497,6 +498,31 @@
                      (search-path %load-path "guix/base32.scm")
                    get-bytevector-all)))))
 
+(test-equal "package-source-derivation, origin, sha512"
+  "hello"
+  (let* ((bash    (search-bootstrap-binary "bash" (%current-system)))
+         (builder (add-text-to-store %store "my-fixed-builder.sh"
+                                     "echo -n hello > $out" '()))
+         (method  (lambda* (url hash-algo hash #:optional name
+                                #:rest rest)
+                    (and (eq? hash-algo 'sha512)
+                         (raw-derivation name bash (list builder)
+                                         #:sources (list builder)
+                                         #:hash hash
+                                         #:hash-algo hash-algo))))
+         (source  (origin
+                    (method method)
+                    (uri "unused://")
+                    (file-name "origin-sha512")
+                    (sha256 (bytevector-hash (string->utf8 "hello")
+                                             (hash-algorithm sha256)))
+                    (sha512 (bytevector-hash (string->utf8 "hello")
+                                             (hash-algorithm sha512)))))
+         (drv    (package-source-derivation %store source))
+         (output (derivation->output-path drv)))
+    (build-derivations %store (list drv))
+    (call-with-input-file output get-string-all)))
+
 (unless (network-reachable?) (test-skip 1))
 (test-equal "package-source-derivation, snippet"
   "OK"
-- 
2.26.2

[bug#41382] [PATCH 6/6] packages: Add 'base64' macro.

[Ludovic Courtès]

* guix/packages.scm (define-compile-time-decoder): New macro.
(base32): Redefine in terms of it.
(base64): New macro.
---
 guix/packages.scm | 31 +++++++++++++++++++------------
 1 file changed, 19 insertions(+), 12 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index 7cf4c9c3e6..724d7693c7 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -28,6 +28,7 @@
   #:use-module (guix monads)
   #:use-module (guix gexp)
   #:use-module (guix base32)
+  #:autoload   (guix base64) (base64-decode)
   #:use-module (guix grafts)
   #:use-module (guix derivations)
   #:use-module (guix memoization)
@@ -62,6 +63,7 @@
             origin-snippet
             origin-modules
             base32
+            base64
 
             package
             package?
@@ -198,19 +200,24 @@
 
 (set-record-type-printer! <origin> print-origin)
 
-(define-syntax base32
-  (lambda (s)
-    "Return the bytevector corresponding to the given Nix-base32
+(define-syntax-rule (define-compile-time-decoder name string->bytevector)
+  "Define NAME as a macro that runs STRING->BYTEVECTOR at macro expansion time
+if possible."
+  (define-syntax name
+    (lambda (s)
+      "Return the bytevector corresponding to the given textual
 representation."
-    (syntax-case s ()
-      ((_ str)
-       (string? (syntax->datum #'str))
-       ;; A literal string: do the conversion at expansion time.
-       (with-syntax ((bv (nix-base32-string->bytevector
-                          (syntax->datum #'str))))
-         #''bv))
-      ((_ str)
-       #'(nix-base32-string->bytevector str)))))
+      (syntax-case s ()
+        ((_ str)
+         (string? (syntax->datum #'str))
+         ;; A literal string: do the conversion at expansion time.
+         (with-syntax ((bv (string->bytevector (syntax->datum #'str))))
+           #''bv))
+        ((_ str)
+         #'(string->bytevector str))))))
+
+(define-compile-time-decoder base32 nix-base32-string->bytevector)
+(define-compile-time-decoder base64 base64-decode)
 
 (define (origin-actual-file-name origin)
   "Return the file name of ORIGIN, either its 'file-name' field or the file
-- 
2.26.2

[bug#41382] [PATCH 0/6] Allow for a cryptographic hash function migration

[Ludovic Courtès]

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

Hello,

Ludovic Courtès <ludo@gnu.org> skribis:

> Another option would be to create a <hash> data type that specifies
> its algorithm and its value.  We’d replace the ‘sha256’ field with
> a ‘hash’ field of that type (in a backward-compatible way).  Thinking
> about it, this is perhaps the better option.

Here’s a v2 that does that: instead of adding a ‘sha512’ field to
<origin>, it replaces the ‘sha256’ field with ‘hash’ and introduces a
<content-hash> data type (similar to the <uuid> data type we have).

One can now write things like:

  (origin
    ;; …
    (hash (content-hash (base64 "…") sha512)))

Since it’s a bit verbose, one can also pass a literal string directly,
in which case it’s base32-decoded:

  (origin
    ;; …
    (hash (content-hash "…")))

‘content-hash’ uses macrology to validate as much as possible at
macro-expansion time.

There’s a compatibility ‘origin’ macro intended to allow people to keep
writing:

  (origin
    (url …)
    (method …)
    (sha256 …))

and to automatically “convert” the ‘sha256’ field specification to a
‘content-hash’.  Due to the way identifiers are matched, there are cases
where we can’t preserve the illusion of compatibility, as can be seen
with the patch below.  Perhaps that’s acceptable, though.

Thoughts?

Thanks,
Ludo’.


[-- Attachment #2: the patch --]
[-- Type: text/x-patch, Size: 21215 bytes --]

From 0736d19071cc898e30b0bf06b445e7434848c825 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 19 May 2020 15:55:08 +0200
Subject: [PATCH] packages: Introduce <content-hash> and use it in <origin>.

* guix/packages.scm (<content-hash>): New record type.
(define-content-hash-constructor, build-content-hash)
(content-hash): New macros.
(print-content-hash): New procedure.
(<origin>): Rename constructor to '%origin'.
[sha256]: Remove field.
[hash]: New field.  Adjust users.
(origin-compatibility-helper, origin): New macros.
(origin-sha256): New deprecated procedure.
(origin->derivation): Adjust accordingly.
* tests/packages.scm ("package-source-derivation, origin, sha512"): New
test.
* guix/tests.scm: Hide (gcrypt hash) 'sha256' for proper syntax
matching.
* gnu/packages/aspell.scm (aspell-dictionary)
(aspell-dict-ca, aspell-dict-it): Use 'hash' and 'content-hash' for
proper syntax matching.
* gnu/packages/bash.scm (bash-patch): Rename 'sha256' to 'sha256-bv'.
* gnu/packages/bootstrap.scm (bootstrap-executable): Rename 'sha256' to 'bv'.
* gnu/packages/readline.scm (readline-patch): Likewise.
* gnu/packages/virtualization.scm (qemu-patch): Rename 'sha256' to
'sha256-bv'.
* guix/import/utils.scm: Hide (gcrypt hash) 'sha256'.
---
 doc/guix.texi                   |  34 ++++++++-
 gnu/packages/aspell.scm         |   8 +-
 gnu/packages/bash.scm           |   8 +-
 gnu/packages/bootstrap.scm      |   6 +-
 gnu/packages/readline.scm       |   8 +-
 gnu/packages/virtualization.scm |   4 +-
 guix/import/utils.scm           |   2 +-
 guix/packages.scm               | 126 +++++++++++++++++++++++++++++---
 guix/tests.scm                  |   2 +-
 tests/packages.scm              |  28 ++++++-
 10 files changed, 192 insertions(+), 34 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index fdd9622211..71b10a141d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5966,9 +5966,13 @@ specified in the @code{uri} field as a @code{git-reference} object; a
 @end table
 
 @item @code{sha256}
-A bytevector containing the SHA-256 hash of the source.  Typically the
-@code{base32} form is used here to generate the bytevector from a
-base-32 string.
+A bytevector containing the SHA-256 hash of the source.  This is
+equivalent to providing a @code{content-hash} SHA256 object in the
+@code{hash} field described below.
+
+@item @code{hash}
+The @code{content-hash} object of the source---see below for how to use
+@code{content-hash}.
 
 You can obtain this information using @code{guix download}
 (@pxref{Invoking guix download}) or @code{guix hash} (@pxref{Invoking
@@ -6013,6 +6017,30 @@ this is @code{#f}, a sensible default is used.
 @end table
 @end deftp
 
+@deftp {Data Type} content-hash @var{value} [@var{algorithm}]
+Construct a content hash object for the given @var{algorithm}, and with
+@var{value} as its hash value.  When @var{algorithm} is omitted, assume
+it is @code{sha256}.
+
+@var{value} can be a literal string, in which case it is base32-decoded,
+or it can be a bytevector.
+
+The following forms are all equivalent:
+
+@lisp
+(content-hash "05zxkyz9bv3j9h0xyid1rhvh3klhsmrpkf3bcs6frvlgyr2gwilj")
+(content-hash "05zxkyz9bv3j9h0xyid1rhvh3klhsmrpkf3bcs6frvlgyr2gwilj"
+              sha256)
+(content-hash (base32
+               "05zxkyz9bv3j9h0xyid1rhvh3klhsmrpkf3bcs6frvlgyr2gwilj"))
+(content-hash (base64 "kkb+RPaP7uyMZmu4eXPVkM4BN8yhRd8BTHLslb6f/Rc=")
+              sha256)
+@end lisp
+
+Technically, @code{content-hash} is currently implemented as a macro.
+It performs sanity checks at macro-expansion time, when possible, such
+as ensuring that @var{value} has the right size for @var{algorithm}.
+@end deftp
 
 @node Build Systems
 @section Build Systems
diff --git a/gnu/packages/aspell.scm b/gnu/packages/aspell.scm
index 7550736c40..22256f750b 100644
--- a/gnu/packages/aspell.scm
+++ b/gnu/packages/aspell.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
 ;;; Copyright © 2016, 2017, 2019 Efraim Flashner <efraim@flashner.co.il>
@@ -111,7 +111,7 @@ dictionaries, including personal ones.")
               (uri (string-append "mirror://gnu/aspell/dict/" dict-name
                                   "/" prefix dict-name "-"
                                   version ".tar.bz2"))
-              (sha256 sha256)))
+              (hash (content-hash sha256))))
     (build-system gnu-build-system)
     (arguments
      `(#:phases
@@ -163,7 +163,7 @@ dictionaries, including personal ones.")
          (method url-fetch)
          (uri (string-append "https://www.softcatala.org/pub/softcatala/aspell/"
                              version "/aspell6-ca-" version ".tar.bz2"))
-         (sha256 sha256)))
+         (hash (content-hash sha256))))
       (home-page "https://www.softcatala.org/pub/softcatala/aspell/"))))
 
 (define-public aspell-dict-de
@@ -264,7 +264,7 @@ dictionaries, including personal ones.")
          (uri (string-append "mirror://sourceforge/linguistico/"
                              "Dizionario%20italiano%20per%20Aspell/" version "/"
                              "aspell6-it-" version ".tar.bz2"))
-         (sha256 sha256)))
+         (hash (content-hash sha256))))
        (home-page
         "http://linguistico.sourceforge.net/pages/dizionario_italiano.html"))))
 
diff --git a/gnu/packages/bash.scm b/gnu/packages/bash.scm
index 1b342827c5..311e07a944 100644
--- a/gnu/packages/bash.scm
+++ b/gnu/packages/bash.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015, 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il>
@@ -48,12 +48,12 @@
   "Return the URL of Bash patch number SEQNO."
   (format #f "mirror://gnu/bash/bash-5.0-patches/bash50-~3,'0d" seqno))
 
-(define (bash-patch seqno sha256)
-  "Return the origin of Bash patch SEQNO, with expected hash SHA256"
+(define (bash-patch seqno sha256-bv)
+  "Return the origin of Bash patch SEQNO, with expected hash SHA256-BV."
   (origin
     (method url-fetch)
     (uri (patch-url seqno))
-    (sha256 sha256)))
+    (sha256 sha256-bv)))
 
 (define-syntax-rule (patch-series (seqno hash) ...)
   (list (bash-patch seqno (base32 hash))
diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index f58ce2de93..a3ecb6e692 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014, 2015, 2018, 2019 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017, 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2018, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
@@ -151,14 +151,14 @@ built for SYSTEM."
                    (format #f (G_ "could not find bootstrap binary '~a' \
 for system '~a'")
                            program system))))))
-        ((sha256)
+        ((bv)
          (origin
            (method url-fetch/executable)
            (uri (map (cute string-append <>
                            (bootstrap-executable-file-name system program))
                      %bootstrap-executable-base-urls))
            (file-name program)
-           (sha256 sha256)))))))
+           (hash (content-hash bv sha256))))))))
 
 \f
 ;;;
diff --git a/gnu/packages/readline.scm b/gnu/packages/readline.scm
index 5f61dcb735..8a36883347 100644
--- a/gnu/packages/readline.scm
+++ b/gnu/packages/readline.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016, 2019 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
@@ -35,12 +35,12 @@
   (format #f "mirror://gnu/readline/readline-~a-patches/readline~a-~3,'0d"
           version (string-join (string-split version #\.) "") seqno))
 
-(define (readline-patch version seqno sha256)
-  "Return the origin of Readline patch SEQNO, with expected hash SHA256"
+(define (readline-patch version seqno sha256-bv)
+  "Return the origin of Readline patch SEQNO, with expected hash SHA256-BV"
   (origin
     (method url-fetch)
     (uri (patch-url version seqno))
-    (sha256 sha256)))
+    (sha256 sha256-bv)))
 
 (define-syntax-rule (patch-series version (seqno hash) ...)
   (list (readline-patch version seqno (base32 hash))
diff --git a/gnu/packages/virtualization.scm b/gnu/packages/virtualization.scm
index c2025c4fbe..da110bf8c6 100644
--- a/gnu/packages/virtualization.scm
+++ b/gnu/packages/virtualization.scm
@@ -104,14 +104,14 @@
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match))
 
-(define (qemu-patch commit file-name sha256)
+(define (qemu-patch commit file-name sha256-bv)
   "Return an origin for COMMIT."
   (origin
     (method url-fetch)
     (uri (string-append
           "http://git.qemu.org/?p=qemu.git;a=commitdiff_plain;h="
           commit))
-    (sha256 sha256)
+    (hash (content-hash sha256-bv sha256))
     (file-name file-name)))
 
 (define-public qemu
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 3809c3d074..0cfa1f8321 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -24,7 +24,7 @@
 (define-module (guix import utils)
   #:use-module (guix base32)
   #:use-module ((guix build download) #:prefix build:)
-  #:use-module (gcrypt hash)
+  #:use-module ((gcrypt hash) #:hide (sha256))
   #:use-module (guix http-client)
   #:use-module ((guix licenses) #:prefix license:)
   #:use-module (guix utils)
diff --git a/guix/packages.scm b/guix/packages.scm
index c1c4805ae9..3d9988d836 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -35,6 +35,8 @@
   #:use-module (guix build-system)
   #:use-module (guix search-paths)
   #:use-module (guix sets)
+  #:use-module (guix deprecation)
+  #:use-module (guix i18n)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 regex)
@@ -44,16 +46,23 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
+  #:use-module (rnrs bytevectors)
   #:use-module (web uri)
   #:re-export (%current-system
                %current-target-system
                search-path-specification)         ;for convenience
-  #:export (origin
+  #:export (content-hash
+            content-hash?
+            content-hash-algorithm
+            content-hash-value
+
+            origin
             origin?
             this-origin
             origin-uri
             origin-method
-            origin-sha256
+            origin-hash
+            origin-sha256                         ;deprecated
             origin-file-name
             origin-actual-file-name
             origin-patches
@@ -157,15 +166,79 @@
 ;;;
 ;;; Code:
 
+;; Crytographic content hash.
+(define-immutable-record-type <content-hash>
+  (%content-hash algorithm value)
+  content-hash?
+  (algorithm content-hash-algorithm)              ;symbol
+  (value     content-hash-value))                 ;bytevector
+
+(define-syntax-rule (define-content-hash-constructor name
+                      (algorithm size) ...)
+  "Define NAME as a <content-hash> constructor that ensures that (1) its
+second argument is among the listed ALGORITHM, and (2), when possible, that
+its first argument has the right size for the chosen algorithm."
+  (define-syntax name
+    (lambda (s)
+      (syntax-case s (algorithm ...)
+        ((_ bv algorithm)
+         (let ((bv* (syntax->datum #'bv)))
+           (when (and (bytevector? bv*)
+                      (not (= size (bytevector-length bv*))))
+             (syntax-violation 'content-hash "invalid content hash length" s))
+           #'(%content-hash 'algorithm bv)))
+        ...))))
+
+(define-content-hash-constructor build-content-hash
+  (sha256 32)
+  (sha512 64))
+
+(define-syntax content-hash
+  (lambda (s)
+    "Return a content hash with the given parameters.  The default hash
+algorithm is sha256.  If the first argument is a literal string, it is decoded
+as base32.  Otherwise, it must be a bytevector."
+    ;; What we'd really want here is something like C++ 'constexpr'.
+    (syntax-case s ()
+      ((_ str)
+       (string? (syntax->datum #'str))
+       #'(content-hash str sha256))
+      ((_ str algorithm)
+       (string? (syntax->datum #'str))
+       (with-syntax ((bv (base32 (syntax->datum #'str))))
+         #'(content-hash bv algorithm)))
+      ((_ (id str) algorithm)
+       (and (string? (syntax->datum #'str))
+            (free-identifier=? #'id #'base32))
+       (with-syntax ((bv (nix-base32-string->bytevector (syntax->datum #'str))))
+         #'(content-hash bv algorithm)))
+      ((_ (id str) algorithm)
+       (and (string? (syntax->datum #'str))
+            (free-identifier=? #'id #'base64))
+       (with-syntax ((bv (base64-decode (syntax->datum #'str))))
+         #'(content-hash bv algorithm)))
+      ((_ bv)
+       #'(content-hash bv sha256))
+      ((_ bv hash)
+       #'(build-content-hash bv hash)))))
+
+(define (print-content-hash hash port)
+  (format port "#<content-hash ~a:~a>"
+          (content-hash-algorithm hash)
+          (bytevector->nix-base32-string (content-hash-value hash))))
+
+(set-record-type-printer! <content-hash> print-content-hash)
+
+\f
 ;; The source of a package, such as a tarball URL and fetcher---called
 ;; "origin" to avoid name clash with `package-source', `source', etc.
 (define-record-type* <origin>
-  origin make-origin
+  %origin make-origin
   origin?
   this-origin
   (uri       origin-uri)                          ; string
   (method    origin-method)                       ; procedure
-  (sha256    origin-sha256)                       ; bytevector
+  (hash      origin-hash)                         ; <content-hash>
   (file-name origin-file-name (default #f))       ; optional file name
 
   ;; Patches are delayed so that the 'search-patch' calls are made lazily,
@@ -188,12 +261,37 @@
   (patch-guile origin-patch-guile                 ; package or #f
                (default #f)))
 
+(define-syntax origin-compatibility-helper
+  (syntax-rules (sha256)
+    ((_ () (fields ...))
+     (%origin fields ...))
+    ((_ ((sha256 exp) rest ...) (others ...))
+     (%origin others ...
+              (hash (content-hash exp sha256))
+              rest ...))
+    ((_ (field rest ...) (others ...))
+     (origin-compatibility-helper (rest ...)
+                                  (others ... field)))))
+
+(define-syntax-rule (origin fields ...)
+  "Build an <origin> record, automatically converting 'sha256' field
+specifications to 'hash'."
+  (origin-compatibility-helper (fields ...) ()))
+
+(define-deprecated (origin-sha256 origin)
+  origin-hash
+  (let ((hash (origin-hash origin)))
+    (unless (eq? (content-hash-algorithm hash) 'sha256)
+      (raise (condition (&message
+                         (message (G_ "no SHA256 hash for origin"))))))
+    (content-hash-value hash)))
+
 (define (print-origin origin port)
   "Write a concise representation of ORIGIN to PORT."
   (match origin
-    (($ <origin> uri method sha256 file-name patches)
+    (($ <origin> uri method hash file-name patches)
      (simple-format port "#<origin ~s ~a ~s ~a>"
-                    uri (bytevector->base32-string sha256)
+                    uri hash
                     (force patches)
                     (number->string (object-address origin) 16)))))
 
@@ -238,6 +336,7 @@ name of its URI."
          ;; git, svn, cvs, etc. reference
          #f))))
 
+\f
 (define %supported-systems
   ;; This is the list of system types that are supported.  By default, we
   ;; expect all packages to build successfully here.
@@ -1388,14 +1487,19 @@ unless you know what you are doing."
                              #:optional (system (%current-system)))
   "Return the derivation corresponding to ORIGIN."
   (match origin
-    (($ <origin> uri method sha256 name (= force ()) #f)
+    (($ <origin> uri method hash name (= force ()) #f)
      ;; No patches, no snippet: this is a fixed-output derivation.
-     (method uri 'sha256 sha256 name #:system system))
-    (($ <origin> uri method sha256 name (= force (patches ...)) snippet
+     (method uri
+             (content-hash-algorithm hash)
+             (content-hash-value hash)
+             name #:system system))
+    (($ <origin> uri method hash name (= force (patches ...)) snippet
         (flags ...) inputs (modules ...) guile-for-build)
      ;; Patches and/or a snippet.
-     (mlet %store-monad ((source (method uri 'sha256 sha256 name
-                                         #:system system))
+     (mlet %store-monad ((source (method uri
+                                         (content-hash-algorithm hash)
+                                         (content-hash-value hash)
+                                         name #:system system))
                          (guile  (package->derivation (or guile-for-build
                                                           (default-guile))
                                                       system
diff --git a/guix/tests.scm b/guix/tests.scm
index 95a7d7c4b8..3ccf049a7d 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -26,7 +26,7 @@
   #:use-module (guix monads)
   #:use-module ((guix utils) #:select (substitute-keyword-arguments))
   #:use-module ((guix build utils) #:select (mkdir-p))
-  #:use-module (gcrypt hash)
+  #:use-module ((gcrypt hash) #:hide (sha256))
   #:use-module (guix build-system gnu)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bootstrap)
diff --git a/tests/packages.scm b/tests/packages.scm
index c528d2080c..4935d4503e 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -29,7 +29,7 @@
                 #:renamer (lambda (name)
                             (cond ((eq? name 'location) 'make-location)
                                   (else name))))
-  #:use-module (gcrypt hash)
+  #:use-module ((gcrypt hash) #:hide (sha256))
   #:use-module (guix derivations)
   #:use-module (guix packages)
   #:use-module (guix grafts)
@@ -51,6 +51,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-64)
+  #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 regex)
@@ -497,6 +498,31 @@
                      (search-path %load-path "guix/base32.scm")
                    get-bytevector-all)))))
 
+(test-equal "package-source-derivation, origin, sha512"
+  "hello"
+  (let* ((bash    (search-bootstrap-binary "bash" (%current-system)))
+         (builder (add-text-to-store %store "my-fixed-builder.sh"
+                                     "echo -n hello > $out" '()))
+         (method  (lambda* (url hash-algo hash #:optional name
+                                #:rest rest)
+                    (and (eq? hash-algo 'sha512)
+                         (raw-derivation name bash (list builder)
+                                         #:sources (list builder)
+                                         #:hash hash
+                                         #:hash-algo hash-algo))))
+         (source  (origin
+                    (method method)
+                    (uri "unused://")
+                    (file-name "origin-sha512")
+                    (hash (content-hash
+                           (bytevector-hash (string->utf8 "hello")
+                                            (hash-algorithm sha512))
+                           sha512))))
+         (drv    (package-source-derivation %store source))
+         (output (derivation->output-path drv)))
+    (build-derivations %store (list drv))
+    (call-with-input-file output get-string-all)))
+
 (unless (network-reachable?) (test-skip 1))
 (test-equal "package-source-derivation, snippet"
   "OK"
-- 
2.26.2

[bug#41382] [PATCH 0/6] Allow for a cryptographic hash function migration

[Leo Famulari]

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

On Tue, May 19, 2020 at 08:00:34PM +0200, Marius Bakke wrote:
> This is a great initiative, and the patches LGTM.

+1

> I think that if we are to move away from SHA256, we should go with
> something that is immune to length extension attacks[0] such as BLAKE2/3
> or SHA-3 (Keccak).

I think we are so far from needing to move away from SHA256 that we
can't know what the best replacement will be when the time comes. It
will probably be quite a long time, maybe decades.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]