summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-05-19 15:55:08 +0200
committerLudovic Courtès <ludo@gnu.org>2020-05-22 01:29:39 +0200
commitce0be5675b702b2ff89aed1772ebb42af4150243 (patch)
treeec275112c97e9450ed9c4a8d30e7c153a7c10786
parent56f7ca6e7c8b5eadeee48b00bcbd78f9fa9e5f43 (diff)
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'.
-rw-r--r--doc/guix.texi34
-rw-r--r--gnu/packages/aspell.scm8
-rw-r--r--gnu/packages/bash.scm8
-rw-r--r--gnu/packages/bootstrap.scm6
-rw-r--r--gnu/packages/readline.scm8
-rw-r--r--gnu/packages/virtualization.scm4
-rw-r--r--guix/import/utils.scm2
-rw-r--r--guix/packages.scm126
-rw-r--r--guix/tests.scm2
-rw-r--r--tests/challenge.scm6
-rw-r--r--tests/derivations.scm32
-rw-r--r--tests/graph.scm6
-rw-r--r--tests/packages.scm28
-rw-r--r--tests/store.scm8
14 files changed, 220 insertions, 58 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 01dab5b72c3..c1e23b5ef3b 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
5966@end table 5966@end table
5967 5967
5968@item @code{sha256} 5968@item @code{sha256}
5969A bytevector containing the SHA-256 hash of the source. Typically the 5969A bytevector containing the SHA-256 hash of the source. This is
5970@code{base32} form is used here to generate the bytevector from a 5970equivalent to providing a @code{content-hash} SHA256 object in the
5971base-32 string. 5971@code{hash} field described below.
5972
5973@item @code{hash}
5974The @code{content-hash} object of the source---see below for how to use
5975@code{content-hash}.
5972 5976
5973You can obtain this information using @code{guix download} 5977You can obtain this information using @code{guix download}
5974(@pxref{Invoking guix download}) or @code{guix hash} (@pxref{Invoking 5978(@pxref{Invoking guix download}) or @code{guix hash} (@pxref{Invoking
@@ -6013,6 +6017,30 @@ this is @code{#f}, a sensible default is used.
6013@end table 6017@end table
6014@end deftp 6018@end deftp
6015 6019
6020@deftp {Data Type} content-hash @var{value} [@var{algorithm}]
6021Construct a content hash object for the given @var{algorithm}, and with
6022@var{value} as its hash value. When @var{algorithm} is omitted, assume
6023it is @code{sha256}.
6024
6025@var{value} can be a literal string, in which case it is base32-decoded,
6026or it can be a bytevector.
6027
6028The following forms are all equivalent:
6029
6030@lisp
6031(content-hash "05zxkyz9bv3j9h0xyid1rhvh3klhsmrpkf3bcs6frvlgyr2gwilj")
6032(content-hash "05zxkyz9bv3j9h0xyid1rhvh3klhsmrpkf3bcs6frvlgyr2gwilj"
6033 sha256)
6034(content-hash (base32
6035 "05zxkyz9bv3j9h0xyid1rhvh3klhsmrpkf3bcs6frvlgyr2gwilj"))
6036(content-hash (base64 "kkb+RPaP7uyMZmu4eXPVkM4BN8yhRd8BTHLslb6f/Rc=")
6037 sha256)
6038@end lisp
6039
6040Technically, @code{content-hash} is currently implemented as a macro.
6041It performs sanity checks at macro-expansion time, when possible, such
6042as ensuring that @var{value} has the right size for @var{algorithm}.
6043@end deftp
6016 6044
6017@node Build Systems 6045@node Build Systems
6018@section Build Systems 6046@section Build Systems
diff --git a/gnu/packages/aspell.scm b/gnu/packages/aspell.scm
index 7550736c404..22256f750b6 100644
--- a/gnu/packages/aspell.scm
+++ b/gnu/packages/aspell.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> 3;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
4;;; Copyright © 2016 John Darrington <jmd@gnu.org> 4;;; Copyright © 2016 John Darrington <jmd@gnu.org>
5;;; Copyright © 2016, 2017, 2019 Efraim Flashner <efraim@flashner.co.il> 5;;; Copyright © 2016, 2017, 2019 Efraim Flashner <efraim@flashner.co.il>
@@ -111,7 +111,7 @@ dictionaries, including personal ones.")
111 (uri (string-append "mirror://gnu/aspell/dict/" dict-name 111 (uri (string-append "mirror://gnu/aspell/dict/" dict-name
112 "/" prefix dict-name "-" 112 "/" prefix dict-name "-"
113 version ".tar.bz2")) 113 version ".tar.bz2"))
114 (sha256 sha256))) 114 (hash (content-hash sha256))))
115 (build-system gnu-build-system) 115 (build-system gnu-build-system)
116 (arguments 116 (arguments
117 `(#:phases 117 `(#:phases
@@ -163,7 +163,7 @@ dictionaries, including personal ones.")
163 (method url-fetch) 163 (method url-fetch)
164 (uri (string-append "https://www.softcatala.org/pub/softcatala/aspell/" 164 (uri (string-append "https://www.softcatala.org/pub/softcatala/aspell/"
165 version "/aspell6-ca-" version ".tar.bz2")) 165 version "/aspell6-ca-" version ".tar.bz2"))
166 (sha256 sha256))) 166 (hash (content-hash sha256))))
167 (home-page "https://www.softcatala.org/pub/softcatala/aspell/")))) 167 (home-page "https://www.softcatala.org/pub/softcatala/aspell/"))))
168 168
169(define-public aspell-dict-de 169(define-public aspell-dict-de
@@ -264,7 +264,7 @@ dictionaries, including personal ones.")
264 (uri (string-append "mirror://sourceforge/linguistico/" 264 (uri (string-append "mirror://sourceforge/linguistico/"
265 "Dizionario%20italiano%20per%20Aspell/" version "/" 265 "Dizionario%20italiano%20per%20Aspell/" version "/"
266 "aspell6-it-" version ".tar.bz2")) 266 "aspell6-it-" version ".tar.bz2"))
267 (sha256 sha256))) 267 (hash (content-hash sha256))))
268 (home-page 268 (home-page
269 "http://linguistico.sourceforge.net/pages/dizionario_italiano.html")))) 269 "http://linguistico.sourceforge.net/pages/dizionario_italiano.html"))))
270 270
diff --git a/gnu/packages/bash.scm b/gnu/packages/bash.scm
index 1b342827c54..311e07a9446 100644
--- a/gnu/packages/bash.scm
+++ b/gnu/packages/bash.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org> 3;;; Copyright © 2014, 2015, 2018 Mark H Weaver <mhw@netris.org>
4;;; Copyright © 2015, 2017 Leo Famulari <leo@famulari.name> 4;;; Copyright © 2015, 2017 Leo Famulari <leo@famulari.name>
5;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il> 5;;; Copyright © 2016, 2017, 2018, 2019 Efraim Flashner <efraim@flashner.co.il>
@@ -48,12 +48,12 @@
48 "Return the URL of Bash patch number SEQNO." 48 "Return the URL of Bash patch number SEQNO."
49 (format #f "mirror://gnu/bash/bash-5.0-patches/bash50-~3,'0d" seqno)) 49 (format #f "mirror://gnu/bash/bash-5.0-patches/bash50-~3,'0d" seqno))
50 50
51(define (bash-patch seqno sha256) 51(define (bash-patch seqno sha256-bv)
52 "Return the origin of Bash patch SEQNO, with expected hash SHA256" 52 "Return the origin of Bash patch SEQNO, with expected hash SHA256-BV."
53 (origin 53 (origin
54 (method url-fetch) 54 (method url-fetch)
55 (uri (patch-url seqno)) 55 (uri (patch-url seqno))
56 (sha256 sha256))) 56 (sha256 sha256-bv)))
57 57
58(define-syntax-rule (patch-series (seqno hash) ...) 58(define-syntax-rule (patch-series (seqno hash) ...)
59 (list (bash-patch seqno (base32 hash)) 59 (list (bash-patch seqno (base32 hash))
diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index f58ce2de93b..a3ecb6e6928 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2014, 2015, 2018, 2019 Mark H Weaver <mhw@netris.org> 3;;; Copyright © 2014, 2015, 2018, 2019 Mark H Weaver <mhw@netris.org>
4;;; Copyright © 2017, 2020 Efraim Flashner <efraim@flashner.co.il> 4;;; Copyright © 2017, 2020 Efraim Flashner <efraim@flashner.co.il>
5;;; Copyright © 2018, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> 5;;; Copyright © 2018, 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
@@ -151,14 +151,14 @@ built for SYSTEM."
151 (format #f (G_ "could not find bootstrap binary '~a' \ 151 (format #f (G_ "could not find bootstrap binary '~a' \
152for system '~a'") 152for system '~a'")
153 program system)))))) 153 program system))))))
154 ((sha256) 154 ((bv)
155 (origin 155 (origin
156 (method url-fetch/executable) 156 (method url-fetch/executable)
157 (uri (map (cute string-append <> 157 (uri (map (cute string-append <>
158 (bootstrap-executable-file-name system program)) 158 (bootstrap-executable-file-name system program))
159 %bootstrap-executable-base-urls)) 159 %bootstrap-executable-base-urls))
160 (file-name program) 160 (file-name program)
161 (sha256 sha256))))))) 161 (hash (content-hash bv sha256))))))))
162 162
163 163
164;;; 164;;;
diff --git a/gnu/packages/readline.scm b/gnu/packages/readline.scm
index 5f61dcb7357..8a368833474 100644
--- a/gnu/packages/readline.scm
+++ b/gnu/packages/readline.scm
@@ -1,5 +1,5 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2012, 2013, 2014, 2020 Ludovic Courtès <ludo@gnu.org>
3;;; Copyright © 2016, 2019 Efraim Flashner <efraim@flashner.co.il> 3;;; Copyright © 2016, 2019 Efraim Flashner <efraim@flashner.co.il>
4;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> 4;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
5;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr> 5;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
@@ -35,12 +35,12 @@
35 (format #f "mirror://gnu/readline/readline-~a-patches/readline~a-~3,'0d" 35 (format #f "mirror://gnu/readline/readline-~a-patches/readline~a-~3,'0d"
36 version (string-join (string-split version #\.) "") seqno)) 36 version (string-join (string-split version #\.) "") seqno))
37 37
38(define (readline-patch version seqno sha256) 38(define (readline-patch version seqno sha256-bv)
39 "Return the origin of Readline patch SEQNO, with expected hash SHA256" 39 "Return the origin of Readline patch SEQNO, with expected hash SHA256-BV"
40 (origin 40 (origin
41 (method url-fetch) 41 (method url-fetch)
42 (uri (patch-url version seqno)) 42 (uri (patch-url version seqno))
43 (sha256 sha256))) 43 (sha256 sha256-bv)))
44 44
45(define-syntax-rule (patch-series version (seqno hash) ...) 45(define-syntax-rule (patch-series version (seqno hash) ...)
46 (list (readline-patch version seqno (base32 hash)) 46 (list (readline-patch version seqno (base32 hash))
diff --git a/gnu/packages/virtualization.scm b/gnu/packages/virtualization.scm
index e0b9a21e72c..32113a0f2c3 100644
--- a/gnu/packages/virtualization.scm
+++ b/gnu/packages/virtualization.scm
@@ -104,14 +104,14 @@
104 #:use-module (srfi srfi-1) 104 #:use-module (srfi srfi-1)
105 #:use-module (ice-9 match)) 105 #:use-module (ice-9 match))
106 106
107(define (qemu-patch commit file-name sha256) 107(define (qemu-patch commit file-name sha256-bv)
108 "Return an origin for COMMIT." 108 "Return an origin for COMMIT."
109 (origin 109 (origin
110 (method url-fetch) 110 (method url-fetch)
111 (uri (string-append 111 (uri (string-append
112 "http://git.qemu.org/?p=qemu.git;a=commitdiff_plain;h=" 112 "http://git.qemu.org/?p=qemu.git;a=commitdiff_plain;h="
113 commit)) 113 commit))
114 (sha256 sha256) 114 (hash (content-hash sha256-bv sha256))
115 (file-name file-name))) 115 (file-name file-name)))
116 116
117(define-public qemu 117(define-public qemu
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 3809c3d0744..0cfa1f83219 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -24,7 +24,7 @@
24(define-module (guix import utils) 24(define-module (guix import utils)
25 #:use-module (guix base32) 25 #:use-module (guix base32)
26 #:use-module ((guix build download) #:prefix build:) 26 #:use-module ((guix build download) #:prefix build:)
27 #:use-module (gcrypt hash) 27 #:use-module ((gcrypt hash) #:hide (sha256))
28 #:use-module (guix http-client) 28 #:use-module (guix http-client)
29 #:use-module ((guix licenses) #:prefix license:) 29 #:use-module ((guix licenses) #:prefix license:)
30 #:use-module (guix utils) 30 #:use-module (guix utils)
diff --git a/guix/packages.scm b/guix/packages.scm
index c1c4805ae9d..3d9988d8368 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -35,6 +35,8 @@
35 #:use-module (guix build-system) 35 #:use-module (guix build-system)
36 #:use-module (guix search-paths) 36 #:use-module (guix search-paths)
37 #:use-module (guix sets) 37 #:use-module (guix sets)
38 #:use-module (guix deprecation)
39 #:use-module (guix i18n)
38 #:use-module (ice-9 match) 40 #:use-module (ice-9 match)
39 #:use-module (ice-9 vlist) 41 #:use-module (ice-9 vlist)
40 #:use-module (ice-9 regex) 42 #:use-module (ice-9 regex)
@@ -44,16 +46,23 @@
44 #:use-module (srfi srfi-26) 46 #:use-module (srfi srfi-26)
45 #:use-module (srfi srfi-34) 47 #:use-module (srfi srfi-34)
46 #:use-module (srfi srfi-35) 48 #:use-module (srfi srfi-35)
49 #:use-module (rnrs bytevectors)
47 #:use-module (web uri) 50 #:use-module (web uri)
48 #:re-export (%current-system 51 #:re-export (%current-system
49 %current-target-system 52 %current-target-system
50 search-path-specification) ;for convenience 53 search-path-specification) ;for convenience
51 #:export (origin 54 #:export (content-hash
55 content-hash?
56 content-hash-algorithm
57 content-hash-value
58
59 origin
52 origin? 60 origin?
53 this-origin 61 this-origin
54 origin-uri 62 origin-uri
55 origin-method 63 origin-method
56 origin-sha256 64 origin-hash
65 origin-sha256 ;deprecated
57 origin-file-name 66 origin-file-name
58 origin-actual-file-name 67 origin-actual-file-name
59 origin-patches 68 origin-patches
@@ -157,15 +166,79 @@
157;;; 166;;;
158;;; Code: 167;;; Code:
159 168
169;; Crytographic content hash.
170(define-immutable-record-type <content-hash>
171 (%content-hash algorithm value)
172 content-hash?
173 (algorithm content-hash-algorithm) ;symbol
174 (value content-hash-value)) ;bytevector
175
176(define-syntax-rule (define-content-hash-constructor name
177 (algorithm size) ...)
178 "Define NAME as a <content-hash> constructor that ensures that (1) its
179second argument is among the listed ALGORITHM, and (2), when possible, that
180its first argument has the right size for the chosen algorithm."
181 (define-syntax name
182 (lambda (s)
183 (syntax-case s (algorithm ...)
184 ((_ bv algorithm)
185 (let ((bv* (syntax->datum #'bv)))
186 (when (and (bytevector? bv*)
187 (not (= size (bytevector-length bv*))))
188 (syntax-violation 'content-hash "invalid content hash length" s))
189 #'(%content-hash 'algorithm bv)))
190 ...))))
191
192(define-content-hash-constructor build-content-hash
193 (sha256 32)
194 (sha512 64))
195
196(define-syntax content-hash
197 (lambda (s)
198 "Return a content hash with the given parameters. The default hash
199algorithm is sha256. If the first argument is a literal string, it is decoded
200as base32. Otherwise, it must be a bytevector."
201 ;; What we'd really want here is something like C++ 'constexpr'.
202 (syntax-case s ()
203 ((_ str)
204 (string? (syntax->datum #'str))
205 #'(content-hash str sha256))
206 ((_ str algorithm)
207 (string? (syntax->datum #'str))
208 (with-syntax ((bv (base32 (syntax->datum #'str))))
209 #'(content-hash bv algorithm)))
210 ((_ (id str) algorithm)
211 (and (string? (syntax->datum #'str))
212 (free-identifier=? #'id #'base32))
213 (with-syntax ((bv (nix-base32-string->bytevector (syntax->datum #'str))))
214 #'(content-hash bv algorithm)))
215 ((_ (id str) algorithm)
216 (and (string? (syntax->datum #'str))
217 (free-identifier=? #'id #'base64))
218 (with-syntax ((bv (base64-decode (syntax->datum #'str))))
219 #'(content-hash bv algorithm)))
220 ((_ bv)
221 #'(content-hash bv sha256))
222 ((_ bv hash)
223 #'(build-content-hash bv hash)))))
224
225(define (print-content-hash hash port)
226 (format port "#<content-hash ~a:~a>"
227 (content-hash-algorithm hash)
228 (bytevector->nix-base32-string (content-hash-value hash))))
229
230(set-record-type-printer! <content-hash> print-content-hash)
231
232
160;; The source of a package, such as a tarball URL and fetcher---called 233;; The source of a package, such as a tarball URL and fetcher---called
161;; "origin" to avoid name clash with `package-source', `source', etc. 234;; "origin" to avoid name clash with `package-source', `source', etc.
162(define-record-type* <origin> 235(define-record-type* <origin>
163 origin make-origin 236 %origin make-origin
164 origin? 237 origin?
165 this-origin 238 this-origin
166 (uri origin-uri) ; string 239 (uri origin-uri) ; string
167 (method origin-method) ; procedure 240 (method origin-method) ; procedure
168 (sha256 origin-sha256) ; bytevector 241 (hash origin-hash) ; <content-hash>
169 (file-name origin-file-name (default #f)) ; optional file name 242 (file-name origin-file-name (default #f)) ; optional file name
170 243
171 ;; Patches are delayed so that the 'search-patch' calls are made lazily, 244 ;; Patches are delayed so that the 'search-patch' calls are made lazily,
@@ -188,12 +261,37 @@
188 (patch-guile origin-patch-guile ; package or #f 261 (patch-guile origin-patch-guile ; package or #f
189 (default #f))) 262 (default #f)))
190 263
264(define-syntax origin-compatibility-helper
265 (syntax-rules (sha256)
266 ((_ () (fields ...))
267 (%origin fields ...))
268 ((_ ((sha256 exp) rest ...) (others ...))
269 (%origin others ...
270 (hash (content-hash exp sha256))
271 rest ...))
272 ((_ (field rest ...) (others ...))
273 (origin-compatibility-helper (rest ...)
274 (others ... field)))))
275
276(define-syntax-rule (origin fields ...)
277 "Build an <origin> record, automatically converting 'sha256' field
278specifications to 'hash'."
279 (origin-compatibility-helper (fields ...) ()))
280
281(define-deprecated (origin-sha256 origin)
282 origin-hash
283 (let ((hash (origin-hash origin)))
284 (unless (eq? (content-hash-algorithm hash) 'sha256)
285 (raise (condition (&message
286 (message (G_ "no SHA256 hash for origin"))))))
287 (content-hash-value hash)))
288
191(define (print-origin origin port) 289(define (print-origin origin port)
192 "Write a concise representation of ORIGIN to PORT." 290 "Write a concise representation of ORIGIN to PORT."
193 (match origin 291 (match origin
194 (($ <origin> uri method sha256 file-name patches) 292 (($ <origin> uri method hash file-name patches)
195 (simple-format port "#<origin ~s ~a ~s ~a>" 293 (simple-format port "#<origin ~s ~a ~s ~a>"
196 uri (bytevector->base32-string sha256) 294 uri hash
197 (force patches) 295 (force patches)
198 (number->string (object-address origin) 16))))) 296 (number->string (object-address origin) 16)))))
199 297
@@ -238,6 +336,7 @@ name of its URI."
238 ;; git, svn, cvs, etc. reference 336 ;; git, svn, cvs, etc. reference
239 #f)))) 337 #f))))
240 338
339
241(define %supported-systems 340(define %supported-systems
242 ;; This is the list of system types that are supported. By default, we 341 ;; This is the list of system types that are supported. By default, we
243 ;; expect all packages to build successfully here. 342 ;; expect all packages to build successfully here.
@@ -1388,14 +1487,19 @@ unless you know what you are doing."
1388 #:optional (system (%current-system))) 1487 #:optional (system (%current-system)))
1389 "Return the derivation corresponding to ORIGIN." 1488 "Return the derivation corresponding to ORIGIN."
1390 (match origin 1489 (match origin
1391 (($ <origin> uri method sha256 name (= force ()) #f) 1490 (($ <origin> uri method hash name (= force ()) #f)
1392 ;; No patches, no snippet: this is a fixed-output derivation. 1491 ;; No patches, no snippet: this is a fixed-output derivation.
1393 (method uri 'sha256 sha256 name #:system system)) 1492 (method uri
1394 (($ <origin> uri method sha256 name (= force (patches ...)) snippet 1493 (content-hash-algorithm hash)
1494 (content-hash-value hash)
1495 name #:system system))
1496 (($ <origin> uri method hash name (= force (patches ...)) snippet
1395 (flags ...) inputs (modules ...) guile-for-build) 1497 (flags ...) inputs (modules ...) guile-for-build)
1396 ;; Patches and/or a snippet. 1498 ;; Patches and/or a snippet.
1397 (mlet %store-monad ((source (method uri 'sha256 sha256 name 1499 (mlet %store-monad ((source (method uri
1398 #:system system)) 1500 (content-hash-algorithm hash)
1501 (content-hash-value hash)
1502 name #:system system))
1399 (guile (package->derivation (or guile-for-build 1503 (guile (package->derivation (or guile-for-build
1400 (default-guile)) 1504 (default-guile))
1401 system 1505 system
diff --git a/guix/tests.scm b/guix/tests.scm
index 95a7d7c4b87..3ccf049a7dd 100644
--- a/guix/tests.scm
+++ b/guix/tests.scm
@@ -26,7 +26,7 @@
26 #:use-module (guix monads) 26 #:use-module (guix monads)
27 #:use-module ((guix utils) #:select (substitute-keyword-arguments)) 27 #:use-module ((guix utils) #:select (substitute-keyword-arguments))
28 #:use-module ((guix build utils) #:select (mkdir-p)) 28 #:use-module ((guix build utils) #:select (mkdir-p))
29 #:use-module (gcrypt hash) 29 #:use-module ((gcrypt hash) #:hide (sha256))
30 #:use-module (guix build-system gnu) 30 #:use-module (guix build-system gnu)
31 #:use-module (gnu packages base) 31 #:use-module (gnu packages base)
32 #:use-module (gnu packages bootstrap) 32 #:use-module (gnu packages bootstrap)
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 @@
1;;; GNU Guix --- Functional package management for GNU 1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2015, 2017, 2019 Ludovic Courtès <ludo@gnu.org> 2;;; Copyright © 2015, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
3;;; 3;;;
4;;; This file is part of GNU Guix. 4;;; This file is part of GNU Guix.
5;;; 5;;;
@@ -19,7 +19,7 @@
19(define-module (test-challenge) 19(define-module (test-challenge)
20 #:use-module (guix tests) 20 #:use-module (guix tests)
21 #:use-module (guix tests http) 21 #:use-module (guix tests http)
22 #:use-module (gcrypt hash) 22 #:use-module ((gcrypt hash) #:prefix gcrypt:)
23 #:use-module (guix store) 23 #:use-module (guix store)
24 #:use-module (guix monads) 24 #:use-module (guix monads)
25 #:use-module (guix derivations) 25 #:use-module (guix derivations)
@@ -135,7 +135,7 @@
135 (mlet* %store-monad ((drv (gexp->derivation "something" 135 (mlet* %store-monad ((drv (gexp->derivation "something"
136 #~(list #$output #$text))) 136 #~(list #$output #$text)))
137 (out -> (derivation->output-path drv)) 137 (out -> (derivation->output-path drv))
138 (hash -> (sha256 #vu8()))) 138 (hash -> (gcrypt:sha256 #vu8())))
139 (with-derivation-narinfo* drv (sha256 => hash) 139 (with-derivation-narinfo* drv (sha256 => hash)
140 (>>= (compare-contents (list out) (%test-substitute-urls)) 140 (>>= (compare-contents (list out) (%test-substitute-urls))
141 (match-lambda 141 (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 @@
23 #:use-module (guix grafts) 23 #:use-module (guix grafts)
24 #:use-module (guix store) 24 #:use-module (guix store)
25 #:use-module (guix utils) 25 #:use-module (guix utils)
26 #:use-module (gcrypt hash) 26 #:use-module ((gcrypt hash) #:prefix gcrypt:)
27 #:use-module (guix base32) 27 #:use-module (guix base32)
28 #:use-module (guix tests) 28 #:use-module (guix tests)
29 #:use-module (guix tests http) 29 #:use-module (guix tests http)
@@ -215,7 +215,7 @@
215 #:env-vars `(("url" 215 #:env-vars `(("url"
216 . ,(object->string (%local-url)))) 216 . ,(object->string (%local-url))))
217 #:hash-algo 'sha256 217 #:hash-algo 'sha256
218 #:hash (sha256 (string->utf8 text))))) 218 #:hash (gcrypt:sha256 (string->utf8 text)))))
219 (and (build-derivations %store (list drv)) 219 (and (build-derivations %store (list drv))
220 (string=? (call-with-input-file (derivation->output-path drv) 220 (string=? (call-with-input-file (derivation->output-path drv)
221 get-string-all) 221 get-string-all)
@@ -230,7 +230,7 @@
230 #:env-vars `(("url" 230 #:env-vars `(("url"
231 . ,(object->string (%local-url)))) 231 . ,(object->string (%local-url))))
232 #:hash-algo 'sha256 232 #:hash-algo 'sha256
233 #:hash (sha256 (random-bytevector 100))))) ;wrong 233 #:hash (gcrypt:sha256 (random-bytevector 100))))) ;wrong
234 (guard (c ((store-protocol-error? c) 234 (guard (c ((store-protocol-error? c)
235 (string-contains (store-protocol-error-message c) "failed"))) 235 (string-contains (store-protocol-error-message c) "failed")))
236 (build-derivations %store (list drv)) 236 (build-derivations %store (list drv))
@@ -245,7 +245,7 @@
245 #:env-vars `(("url" 245 #:env-vars `(("url"
246 . ,(object->string (%local-url)))) 246 . ,(object->string (%local-url))))
247 #:hash-algo 'sha256 247 #:hash-algo 'sha256
248 #:hash (sha256 (random-bytevector 100))))) 248 #:hash (gcrypt:sha256 (random-bytevector 100)))))
249 (guard (c ((store-protocol-error? c) 249 (guard (c ((store-protocol-error? c)
250 (string-contains (store-protocol-error-message (pk c)) "failed"))) 250 (string-contains (store-protocol-error-message (pk c)) "failed")))
251 (build-derivations %store (list drv)) 251 (build-derivations %store (list drv))
@@ -273,7 +273,7 @@
273 #:env-vars `(("url" 273 #:env-vars `(("url"
274 . ,(object->string (%local-url)))) 274 . ,(object->string (%local-url))))
275 #:hash-algo 'sha256 275 #:hash-algo 'sha256
276 #:hash (sha256 (string->utf8 text))))) 276 #:hash (gcrypt:sha256 (string->utf8 text)))))
277 (and (with-http-server `((200 ,text)) 277 (and (with-http-server `((200 ,text))
278 (build-derivations %store (list drv))) 278 (build-derivations %store (list drv)))
279 (with-http-server `((200 ,text)) 279 (with-http-server `((200 ,text))
@@ -317,7 +317,7 @@
317(test-assert "fixed-output-derivation?" 317(test-assert "fixed-output-derivation?"
318 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" 318 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
319 "echo -n hello > $out" '())) 319 "echo -n hello > $out" '()))
320 (hash (sha256 (string->utf8 "hello"))) 320 (hash (gcrypt:sha256 (string->utf8 "hello")))
321 (drv (derivation %store "fixed" 321 (drv (derivation %store "fixed"
322 %bash `(,builder) 322 %bash `(,builder)
323 #:sources (list builder) 323 #:sources (list builder)
@@ -329,10 +329,10 @@
329 (map (lambda (hash-algorithm) 329 (map (lambda (hash-algorithm)
330 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" 330 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
331 "echo -n hello > $out" '())) 331 "echo -n hello > $out" '()))
332 (sha256 (sha256 (string->utf8 "hello"))) 332 (sha256 (gcrypt:sha256 (string->utf8 "hello")))
333 (hash (bytevector-hash 333 (hash (gcrypt:bytevector-hash
334 (string->utf8 "hello") 334 (string->utf8 "hello")
335 (lookup-hash-algorithm hash-algorithm))) 335 (gcrypt:lookup-hash-algorithm hash-algorithm)))
336 (drv (derivation %store 336 (drv (derivation %store
337 (string-append 337 (string-append
338 "fixed-" (symbol->string hash-algorithm)) 338 "fixed-" (symbol->string hash-algorithm))
@@ -353,7 +353,7 @@
353 "echo -n hello > $out" '())) 353 "echo -n hello > $out" '()))
354 (builder2 (add-text-to-store %store "fixed-builder2.sh" 354 (builder2 (add-text-to-store %store "fixed-builder2.sh"
355 "echo hey; echo -n hello > $out" '())) 355 "echo hey; echo -n hello > $out" '()))
356 (hash (sha256 (string->utf8 "hello"))) 356 (hash (gcrypt:sha256 (string->utf8 "hello")))
357 (drv1 (derivation %store "fixed" 357 (drv1 (derivation %store "fixed"
358 %bash `(,builder1) 358 %bash `(,builder1)
359 #:hash hash #:hash-algo 'sha256)) 359 #:hash hash #:hash-algo 'sha256))
@@ -368,7 +368,7 @@
368(test-assert "fixed-output derivation, recursive" 368(test-assert "fixed-output derivation, recursive"
369 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" 369 (let* ((builder (add-text-to-store %store "my-fixed-builder.sh"
370 "echo -n hello > $out" '())) 370 "echo -n hello > $out" '()))
371 (hash (sha256 (string->utf8 "hello"))) 371 (hash (gcrypt:sha256 (string->utf8 "hello")))
372 (drv (derivation %store "fixed-rec" 372 (drv (derivation %store "fixed-rec"
373 %bash `(,builder) 373 %bash `(,builder)
374 #:sources (list builder) 374 #:sources (list builder)
@@ -390,7 +390,7 @@
390 "echo -n hello > $out" '())) 390 "echo -n hello > $out" '()))
391 (builder2 (add-text-to-store %store "fixed-builder2.sh" 391 (builder2 (add-text-to-store %store "fixed-builder2.sh"
392 "echo hey; echo -n hello > $out" '())) 392 "echo hey; echo -n hello > $out" '()))
393 (hash (sha256 (string->utf8 "hello"))) 393 (hash (gcrypt:sha256 (string->utf8 "hello")))
394 (fixed1 (derivation %store "fixed" 394 (fixed1 (derivation %store "fixed"
395 %bash `(,builder1) 395 %bash `(,builder1)
396 #:hash hash #:hash-algo 'sha256)) 396 #:hash hash #:hash-algo 'sha256))
@@ -427,7 +427,7 @@
427 "echo -n hello > $out" '())) 427 "echo -n hello > $out" '()))
428 (builder2 (add-text-to-store %store "fixed-builder2.sh" 428 (builder2 (add-text-to-store %store "fixed-builder2.sh"
429 "echo hey; echo -n hello > $out" '())) 429 "echo hey; echo -n hello > $out" '()))
430 (hash (sha256 (string->utf8 "hello"))) 430 (hash (gcrypt:sha256 (string->utf8 "hello")))
431 (fixed1 (derivation %store "fixed" 431 (fixed1 (derivation %store "fixed"
432 %bash `(,builder1) 432 %bash `(,builder1)
433 #:hash hash #:hash-algo 'sha256)) 433 #:hash hash #:hash-algo 'sha256))
@@ -680,7 +680,7 @@
680 (let* ((value (getenv "GUIX_STATE_DIRECTORY")) 680 (let* ((value (getenv "GUIX_STATE_DIRECTORY"))
681 (drv (derivation %store "leaked-env-vars" %bash 681 (drv (derivation %store "leaked-env-vars" %bash
682 '("-c" "echo -n $GUIX_STATE_DIRECTORY > $out") 682 '("-c" "echo -n $GUIX_STATE_DIRECTORY > $out")
683 #:hash (sha256 (string->utf8 value)) 683 #:hash (gcrypt:sha256 (string->utf8 value))
684 #:hash-algo 'sha256 684 #:hash-algo 'sha256
685 #:sources (list %bash) 685 #:sources (list %bash)
686 #:leaked-env-vars '("GUIX_STATE_DIRECTORY")))) 686 #:leaked-env-vars '("GUIX_STATE_DIRECTORY"))))
@@ -1106,7 +1106,7 @@
1106 (builder2 '(call-with-output-file (pk 'difference-here! %output) 1106 (builder2 '(call-with-output-file (pk 'difference-here! %output)
1107 (lambda (p) 1107 (lambda (p)
1108 (write "hello" p)))) 1108 (write "hello" p))))
1109 (hash (sha256 (string->utf8 "hello"))) 1109 (hash (gcrypt:sha256 (string->utf8 "hello")))
1110 (input1 (build-expression->derivation %store "fixed" builder1 1110 (input1 (build-expression->derivation %store "fixed" builder1
1111 #:hash hash 1111 #:hash hash
1112 #:hash-algo 'sha256)) 1112 #:hash-algo 'sha256))
@@ -1127,7 +1127,7 @@
1127 (builder2 '(call-with-output-file (pk 'difference-here! %output) 1127 (builder2 '(call-with-output-file (pk 'difference-here! %output)
1128 (lambda (p) 1128 (lambda (p)
1129 (write "hello" p)))) 1129 (write "hello" p))))
1130 (hash (sha256 (string->utf8 "hello"))) 1130 (hash (gcrypt:sha256 (string->utf8 "hello")))
1131 (input1 (build-expression->derivation %store "fixed" builder1 1131 (input1 (build-expression->derivation %store "fixed" builder1
1132 #:hash hash 1132 #:hash hash
1133 #:hash-algo 'sha256)) 1133 #: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."
162 (let-values (((backend nodes+edges) (make-recording-backend))) 162 (let-values (((backend nodes+edges) (make-recording-backend)))
163 (let* ((m (lambda* (uri hash-type hash name #:key system) 163 (let* ((m (lambda* (uri hash-type hash name #:key system)
164 (text-file "foo-1.2.3.tar.gz" "This is a fake!"))) 164 (text-file "foo-1.2.3.tar.gz" "This is a fake!")))
165 (o (origin (method m) (uri "the-uri") (sha256 #vu8(0 1 2)))) 165 (o (origin
166 (method m) (uri "the-uri")
167 (sha256
168 (base32
169 "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))))
166 (p (dummy-package "p" (source o)))) 170 (p (dummy-package "p" (source o))))
167 (run-with-store %store 171 (run-with-store %store
168 (export-graph (list p) 'port 172 (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 @@
29 #:renamer (lambda (name) 29 #:renamer (lambda (name)
30 (cond ((eq? name 'location) 'make-location) 30 (cond ((eq? name 'location) 'make-location)
31 (else name)))) 31 (else name))))
32 #:use-module (gcrypt hash) 32 #:use-module ((gcrypt hash) #:hide (sha256))
33 #:use-module (guix derivations) 33 #:use-module (guix derivations)
34 #:use-module (guix packages) 34 #:use-module (guix packages)
35 #:use-module (guix grafts) 35 #:use-module (guix grafts)
@@ -51,6 +51,7 @@
51 #:use-module (srfi srfi-34) 51 #:use-module (srfi srfi-34)
52 #:use-module (srfi srfi-35) 52 #:use-module (srfi srfi-35)
53 #:use-module (srfi srfi-64) 53 #:use-module (srfi srfi-64)
54 #:use-module (rnrs bytevectors)
54 #:use-module (rnrs io ports) 55 #:use-module (rnrs io ports)
55 #:use-module (ice-9 vlist) 56 #:use-module (ice-9 vlist)
56 #:use-module (ice-9 regex) 57 #:use-module (ice-9 regex)
@@ -497,6 +498,31 @@
497 (search-path %load-path "guix/base32.scm") 498 (search-path %load-path "guix/base32.scm")
498 get-bytevector-all))))) 499 get-bytevector-all)))))
499 500
501(test-equal "package-source-derivation, origin, sha512"
502 "hello"
503 (let* ((bash (search-bootstrap-binary "bash" (%current-system)))
504 (builder (add-text-to-store %store "my-fixed-builder.sh"
505 "echo -n hello > $out" '()))
506 (method (lambda* (url hash-algo hash #:optional name
507 #:rest rest)
508 (and (eq? hash-algo 'sha512)
509 (raw-derivation name bash (list builder)
510 #:sources (list builder)
511 #:hash hash
512 #:hash-algo hash-algo))))
513 (source (origin
514 (method method)
515 (uri "unused://")
516 (file-name "origin-sha512")
517 (hash (content-hash
518 (bytevector-hash (string->utf8 "hello")
519 (hash-algorithm sha512))
520 sha512))))
521 (drv (package-source-derivation %store source))
522 (output (derivation->output-path drv)))
523 (build-derivations %store (list drv))
524 (call-with-input-file output get-string-all)))
525
500(unless (network-reachable?) (test-skip 1)) 526(unless (network-reachable?) (test-skip 1))
501(test-equal "package-source-derivation, snippet" 527(test-equal "package-source-derivation, snippet"
502 "OK" 528 "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 @@
22 #:use-module (guix store) 22 #:use-module (guix store)
23 #:use-module (guix utils) 23 #:use-module (guix utils)
24 #:use-module (guix monads) 24 #:use-module (guix monads)
25 #:use-module (gcrypt hash) 25 #:use-module ((gcrypt hash) #:prefix gcrypt:)
26 #:use-module (guix base32) 26 #:use-module (guix base32)
27 #:use-module (guix packages) 27 #:use-module (guix packages)
28 #:use-module (guix derivations) 28 #:use-module (guix derivations)
@@ -321,7 +321,7 @@
321 #:env-vars `(("t2" . ,t2)))) 321 #:env-vars `(("t2" . ,t2))))
322 (o (derivation->output-path d))) 322 (o (derivation->output-path d)))
323 (with-derivation-narinfo d 323 (with-derivation-narinfo d
324 (sha256 => (sha256 (string->utf8 t2))) 324 (sha256 => (gcrypt:sha256 (string->utf8 t2)))
325 (references => (list t2)) 325 (references => (list t2))
326 326
327 (equal? (references/substitutes s (list o t3 t2 t1)) 327 (equal? (references/substitutes s (list o t3 t2 t1))
@@ -940,7 +940,7 @@
940 (foldm %store-monad 940 (foldm %store-monad
941 (lambda (item result) 941 (lambda (item result)
942 (define ref-hash 942 (define ref-hash
943 (let-values (((port get) (open-sha256-port))) 943 (let-values (((port get) (gcrypt:open-sha256-port)))
944 (write-file item port) 944 (write-file item port)
945 (close-port port) 945 (close-port port)
946 (get))) 946 (get)))
@@ -1144,7 +1144,7 @@
1144 (info (query-path-info %store item))) 1144 (info (query-path-info %store item)))
1145 (and (equal? (path-info-references info) (list ref)) 1145 (and (equal? (path-info-references info) (list ref))
1146 (equal? (path-info-hash info) 1146 (equal? (path-info-hash info)
1147 (sha256 1147 (gcrypt:sha256
1148 (string->utf8 1148 (string->utf8
1149 (call-with-output-string (cut write-file item <>)))))))) 1149 (call-with-output-string (cut write-file item <>))))))))
1150 1150