Add support for fixed-output derivations.
* guix/derivations.scm (read-derivation)[outputs->alist]: For fixed-outputs, convert HASH with `base16-string->bytevector'. (write-derivation): Likewise, convert HASH-ALGO to a string and HASH to a base16 string. (derivation-hash): Expect HASH to be a bytevector, not a string; convert HASH with `bytevector->base16-string'. * tests/derivations.scm ("fixed-output derivation"): New test.
This commit is contained in:
parent
6d800a80ea
commit
749c656755
|
@ -74,7 +74,7 @@
|
|||
derivation-output?
|
||||
(path derivation-output-path) ; store path
|
||||
(hash-algo derivation-output-hash-algo) ; symbol | #f
|
||||
(hash derivation-output-hash)) ; symbol | #f
|
||||
(hash derivation-output-hash)) ; bytevector | #f
|
||||
|
||||
(define-record-type <derivation-input>
|
||||
(make-derivation-input path sub-derivations)
|
||||
|
@ -112,7 +112,8 @@ download with a fixed hash (aka. `fetchurl')."
|
|||
result))
|
||||
((name path hash-algo hash)
|
||||
;; fixed-output
|
||||
(let ((algo (string->symbol hash-algo)))
|
||||
(let ((algo (string->symbol hash-algo))
|
||||
(hash (base16-string->bytevector hash)))
|
||||
(alist-cons name
|
||||
(make-derivation-output path algo hash)
|
||||
result)))))
|
||||
|
@ -170,8 +171,10 @@ that form."
|
|||
(write-list (map (match-lambda
|
||||
((name . ($ <derivation-output> path hash-algo hash))
|
||||
(format #f "(~s,~s,~s,~s)"
|
||||
name path (or hash-algo "")
|
||||
(or hash ""))))
|
||||
name path
|
||||
(or (and=> hash-algo symbol->string) "")
|
||||
(or (and=> hash bytevector->base16-string)
|
||||
""))))
|
||||
outputs))
|
||||
(display "," port)
|
||||
(write-list (map (match-lambda
|
||||
|
@ -222,12 +225,13 @@ in SIZE bytes."
|
|||
"Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
|
||||
(match drv
|
||||
(($ <derivation> ((_ . ($ <derivation-output> path
|
||||
(? symbol? hash-algo) (? string? hash)))))
|
||||
(? symbol? hash-algo) (? bytevector? hash)))))
|
||||
;; A fixed-output derivation.
|
||||
(sha256
|
||||
(string->utf8
|
||||
(string-append "fixed:out:" (symbol->string hash-algo)
|
||||
":" hash ":" path))))
|
||||
":" (bytevector->base16-string hash)
|
||||
":" path))))
|
||||
(($ <derivation> outputs inputs sources
|
||||
system builder args env-vars)
|
||||
;; A regular derivation: replace the path of each input with that
|
||||
|
|
|
@ -25,6 +25,7 @@
|
|||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-64)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (ice-9 rdelim))
|
||||
|
||||
(define %store
|
||||
|
@ -68,6 +69,20 @@
|
|||
(string=? (call-with-input-file path read-line)
|
||||
"hello, world")))))
|
||||
|
||||
(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-path (derivation %store "fixed" "x86_64-linux"
|
||||
"/bin/sh" `(,builder)
|
||||
'() `((,builder))
|
||||
#:hash hash #:hash-algo 'sha256))
|
||||
(succeeded? (build-derivations %store (list drv-path))))
|
||||
(and succeeded?
|
||||
(let ((p (derivation-path->output-path drv-path)))
|
||||
(equal? (string->utf8 "hello")
|
||||
(call-with-input-file p get-bytevector-all))))))
|
||||
|
||||
|
||||
(define %coreutils
|
||||
(false-if-exception (nixpkgs-derivation "coreutils")))
|
||||
|
|
Loading…
Reference in New Issue