diff options
author | Ludovic Courtès <ludo@gnu.org> | 2017-12-13 14:00:20 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2017-12-13 23:11:53 +0100 |
commit | eb1150c22c2175fbcf834b9f5164ef0d693df3cf (patch) | |
tree | 275c57a0af7fc233e10fd78d1cdb98e7d07843c8 | |
parent | d738f134e496f3a954e51d3625d3eb1fcd5e638d (diff) | |
download | guix-eb1150c22c2175fbcf834b9f5164ef0d693df3cf.tar.gz |
derivations: Split 'derivation-hash' in two procedures.
* guix/derivations.scm (derivation/masked-inputs): New procedure. (derivation-hash): Use it instead of the inline code.
-rw-r--r-- | guix/derivations.scm | 45 |
1 files changed, 24 insertions, 21 deletions
diff --git a/guix/derivations.scm b/guix/derivations.scm index b95849727b..bb18ce6bb1 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -632,6 +632,24 @@ derivation at FILE." (bytevector->base16-string (derivation-hash (read-derivation-from-file file))))) +(define (derivation/masked-inputs drv) + "Assuming DRV is a regular derivation (not fixed-output), replace the file +name of each input with that input's hash." + (match drv + (($ <derivation> outputs inputs sources + system builder args env-vars) + (let ((inputs (map (match-lambda + (($ <derivation-input> path sub-drvs) + (let ((hash (derivation-path->base16-hash path))) + (make-derivation-input hash sub-drvs)))) + inputs))) + (make-derivation outputs + (sort (coalesce-duplicate-inputs inputs) + derivation-input<?) + sources + system builder args env-vars + #f))))) + (define derivation-hash ; `hashDerivationModulo' in derivations.cc (mlambda (drv) "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector." @@ -647,27 +665,12 @@ derivation at FILE." (symbol->string hash-algo) ":" (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 - ;; input's hash; return the hash of serialization of the resulting - ;; derivation. - (let* ((inputs (map (match-lambda - (($ <derivation-input> path sub-drvs) - (let ((hash (derivation-path->base16-hash path))) - (make-derivation-input hash sub-drvs)))) - inputs)) - (drv (make-derivation outputs - (sort (coalesce-duplicate-inputs inputs) - derivation-input<?) - sources - system builder args env-vars - #f))) - - ;; XXX: At this point this remains faster than `port-sha256', because - ;; the SHA256 port's `write' method gets called for every single - ;; character. - (sha256 (derivation->bytevector drv))))))) + (_ + + ;; XXX: At this point this remains faster than `port-sha256', because + ;; the SHA256 port's `write' method gets called for every single + ;; character. + (sha256 (derivation->bytevector (derivation/masked-inputs drv))))))) (define* (derivation store name builder args #:key |