~ruther/guix-local

eb1150c22c2175fbcf834b9f5164ef0d693df3cf — Ludovic Courtès 8 years ago d738f13
derivations: Split 'derivation-hash' in two procedures.

* guix/derivations.scm (derivation/masked-inputs): New procedure.
(derivation-hash): Use it instead of the inline code.
1 files changed, 24 insertions(+), 21 deletions(-)

M guix/derivations.scm
M guix/derivations.scm => guix/derivations.scm +24 -21
@@ 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