From eb1150c22c2175fbcf834b9f5164ef0d693df3cf Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 13 Dec 2017 14:00:20 +0100 Subject: derivations: Split 'derivation-hash' in two procedures. * guix/derivations.scm (derivation/masked-inputs): New procedure. (derivation-hash): Use it instead of the inline code. --- guix/derivations.scm | 45 ++++++++++++++++++++++++--------------------- 1 file changed, 24 insertions(+), 21 deletions(-) (limited to 'guix/derivations.scm') 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 + (($ outputs inputs sources + system builder args env-vars) + (let ((inputs (map (match-lambda + (($ 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-inputstring hash-algo) ":" (bytevector->base16-string hash) ":" path)))) - (($ 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 - (($ 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-inputbytevector 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 -- cgit v1.2.3