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.
* tests/challenge.scm: Add #:prefix for (gcrypt hash) and adjust users.
* tests/derivations.scm: Likewise.
* tests/store.scm: Likewise.
* tests/graph.scm ("bag DAG, including origins"): Provide 'sha256' field
with the right length.
* 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'.

5 files changed, 55 insertions, 25 deletions

diff --git a/tests/challenge.scm b/tests/challenge.scm
index bb5633a3ebe..9c6d6e0d58f 100644
--- a/tests/challenge.scm
+++ b/tests/challenge.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,7 +19,7 @@
 (define-module (test-challenge)
   #:use-module (guix tests)
   #:use-module (guix tests http)
-  #:use-module (gcrypt hash)
+  #:use-module ((gcrypt hash) #:prefix gcrypt:)
   #:use-module (guix store)
   #:use-module (guix monads)
   #:use-module (guix derivations)
@@ -135,7 +135,7 @@
     (mlet* %store-monad ((drv (gexp->derivation "something"
                                                 #~(list #$output #$text)))
                          (out -> (derivation->output-path drv))
-                         (hash -> (sha256 #vu8())))
+                         (hash -> (gcrypt:sha256 #vu8())))
       (with-derivation-narinfo* drv (sha256 => hash)
         (>>= (compare-contents (list out) (%test-substitute-urls))
              (match-lambda
diff --git a/tests/derivations.scm b/tests/derivations.scm
index a409fa99f0d..9f1104a8879 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -23,7 +23,7 @@
   #:use-module (guix grafts)
   #:use-module (guix store)
   #:use-module (guix utils)
-  #:use-module (gcrypt hash)
+  #:use-module ((gcrypt hash) #:prefix gcrypt:)
   #:use-module (guix base32)
   #:use-module (guix tests)
   #:use-module (guix tests http)
@@ -215,7 +215,7 @@
                               #:env-vars `(("url"
                                             . ,(object->string (%local-url))))
                               #:hash-algo 'sha256
-                              #:hash (sha256 (string->utf8 text)))))
+                              #:hash (gcrypt:sha256 (string->utf8 text)))))
         (and (build-derivations %store (list drv))
              (string=? (call-with-input-file (derivation->output-path drv)
                          get-string-all)
@@ -230,7 +230,7 @@
                             #:env-vars `(("url"
                                           . ,(object->string (%local-url))))
                             #:hash-algo 'sha256
-                            #:hash (sha256 (random-bytevector 100))))) ;wrong
+                            #:hash (gcrypt:sha256 (random-bytevector 100))))) ;wrong
       (guard (c ((store-protocol-error? c)
                  (string-contains (store-protocol-error-message c) "failed")))
         (build-derivations %store (list drv))
@@ -245,7 +245,7 @@
                             #:env-vars `(("url"
                                           . ,(object->string (%local-url))))
                             #:hash-algo 'sha256
-                            #:hash (sha256 (random-bytevector 100)))))
+                            #:hash (gcrypt:sha256 (random-bytevector 100)))))
       (guard (c ((store-protocol-error? c)
                  (string-contains (store-protocol-error-message (pk c)) "failed")))
         (build-derivations %store (list drv))
@@ -273,7 +273,7 @@
                           #:env-vars `(("url"
                                         . ,(object->string (%local-url))))
                           #:hash-algo 'sha256
-                          #:hash (sha256 (string->utf8 text)))))
+                          #:hash (gcrypt:sha256 (string->utf8 text)))))
     (and (with-http-server `((200 ,text))
            (build-derivations %store (list drv)))
          (with-http-server `((200 ,text))
@@ -317,7 +317,7 @@
 (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")))
+         (hash       (gcrypt:sha256 (string->utf8 "hello")))
          (drv        (derivation %store "fixed"
                                  %bash `(,builder)
                                  #:sources (list builder)
@@ -329,10 +329,10 @@
   (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
+                (sha256  (gcrypt:sha256 (string->utf8 "hello")))
+                (hash    (gcrypt:bytevector-hash
                           (string->utf8 "hello")
-                          (lookup-hash-algorithm hash-algorithm)))
+                          (gcrypt:lookup-hash-algorithm hash-algorithm)))
                 (drv     (derivation %store
                                      (string-append
                                       "fixed-" (symbol->string hash-algorithm))
@@ -353,7 +353,7 @@
                                         "echo -n hello > $out" '()))
          (builder2   (add-text-to-store %store "fixed-builder2.sh"
                                         "echo hey; echo -n hello > $out" '()))
-         (hash       (sha256 (string->utf8 "hello")))
+         (hash       (gcrypt:sha256 (string->utf8 "hello")))
          (drv1       (derivation %store "fixed"
                                  %bash `(,builder1)
                                  #:hash hash #:hash-algo 'sha256))
@@ -368,7 +368,7 @@
 (test-assert "fixed-output derivation, recursive"
   (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
                                         "echo -n hello > $out" '()))
-         (hash       (sha256 (string->utf8 "hello")))
+         (hash       (gcrypt:sha256 (string->utf8 "hello")))
          (drv        (derivation %store "fixed-rec"
                                  %bash `(,builder)
                                  #:sources (list builder)
@@ -390,7 +390,7 @@
                                         "echo -n hello > $out" '()))
          (builder2   (add-text-to-store %store "fixed-builder2.sh"
                                         "echo hey; echo -n hello > $out" '()))
-         (hash       (sha256 (string->utf8 "hello")))
+         (hash       (gcrypt:sha256 (string->utf8 "hello")))
          (fixed1     (derivation %store "fixed"
                                  %bash `(,builder1)
                                  #:hash hash #:hash-algo 'sha256))
@@ -427,7 +427,7 @@
                                         "echo -n hello > $out" '()))
          (builder2   (add-text-to-store %store "fixed-builder2.sh"
                                         "echo hey; echo -n hello > $out" '()))
-         (hash       (sha256 (string->utf8 "hello")))
+         (hash       (gcrypt:sha256 (string->utf8 "hello")))
          (fixed1     (derivation %store "fixed"
                                  %bash `(,builder1)
                                  #:hash hash #:hash-algo 'sha256))
@@ -680,7 +680,7 @@
   (let* ((value (getenv "GUIX_STATE_DIRECTORY"))
          (drv   (derivation %store "leaked-env-vars" %bash
                             '("-c" "echo -n $GUIX_STATE_DIRECTORY > $out")
-                            #:hash (sha256 (string->utf8 value))
+                            #:hash (gcrypt:sha256 (string->utf8 value))
                             #:hash-algo 'sha256
                             #:sources (list %bash)
                             #:leaked-env-vars '("GUIX_STATE_DIRECTORY"))))
@@ -1106,7 +1106,7 @@
          (builder2   '(call-with-output-file (pk 'difference-here! %output)
                         (lambda (p)
                           (write "hello" p))))
-         (hash       (sha256 (string->utf8 "hello")))
+         (hash       (gcrypt:sha256 (string->utf8 "hello")))
          (input1     (build-expression->derivation %store "fixed" builder1
                                                    #:hash hash
                                                    #:hash-algo 'sha256))
@@ -1127,7 +1127,7 @@
          (builder2   '(call-with-output-file (pk 'difference-here! %output)
                         (lambda (p)
                           (write "hello" p))))
-         (hash       (sha256 (string->utf8 "hello")))
+         (hash       (gcrypt:sha256 (string->utf8 "hello")))
          (input1     (build-expression->derivation %store "fixed" builder1
                                                    #:hash hash
                                                    #:hash-algo 'sha256))
diff --git a/tests/graph.scm b/tests/graph.scm
index 136260c7d10..0663d13b493 100644
--- a/tests/graph.scm
+++ b/tests/graph.scm
@@ -162,7 +162,11 @@ edges."
   (let-values (((backend nodes+edges) (make-recording-backend)))
     (let* ((m (lambda* (uri hash-type hash name #:key system)
                 (text-file "foo-1.2.3.tar.gz" "This is a fake!")))
-           (o (origin (method m) (uri "the-uri") (sha256 #vu8(0 1 2))))
+           (o (origin
+                (method m) (uri "the-uri")
+                (sha256
+                 (base32
+                  "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))))
            (p (dummy-package "p" (source o))))
       (run-with-store %store
         (export-graph (list p) 'port
diff --git a/tests/packages.scm b/tests/packages.scm
index c528d2080c9..4935d4503e6 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"
diff --git a/tests/store.scm b/tests/store.scm
index f007846dc16..06f79396579 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -22,7 +22,7 @@
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix monads)
-  #:use-module (gcrypt hash)
+  #:use-module ((gcrypt hash) #:prefix gcrypt:)
   #:use-module (guix base32)
   #:use-module (guix packages)
   #:use-module (guix derivations)
@@ -321,7 +321,7 @@
                            #:env-vars `(("t2" . ,t2))))
            (o  (derivation->output-path d)))
       (with-derivation-narinfo d
-        (sha256 => (sha256 (string->utf8 t2)))
+        (sha256 => (gcrypt:sha256 (string->utf8 t2)))
         (references => (list t2))
 
         (equal? (references/substitutes s (list o t3 t2 t1))
@@ -940,7 +940,7 @@
         (foldm %store-monad
                (lambda (item result)
                  (define ref-hash
-                   (let-values (((port get) (open-sha256-port)))
+                   (let-values (((port get) (gcrypt:open-sha256-port)))
                      (write-file item port)
                      (close-port port)
                      (get)))
@@ -1144,7 +1144,7 @@
          (info (query-path-info %store item)))
     (and (equal? (path-info-references info) (list ref))
          (equal? (path-info-hash info)
-                 (sha256
+                 (gcrypt:sha256
                   (string->utf8
                    (call-with-output-string (cut write-file item <>))))))))