guix/derivations.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (guix derivations)
  21   #:use-module (srfi srfi-1)
  22   #:use-module (srfi srfi-9)
  23   #:use-module (srfi srfi-9 gnu)
  24   #:use-module (srfi srfi-26)
  25   #:use-module (srfi srfi-34)
  26   #:use-module (srfi srfi-35)
  27   #:use-module (ice-9 binary-ports)
  28   #:use-module (rnrs bytevectors)
  29   #:use-module (ice-9 match)
  30   #:use-module (ice-9 rdelim)
  31   #:use-module (ice-9 vlist)
  32   #:use-module (guix store)
  33   #:use-module (guix utils)
  34   #:use-module (guix memoization)
  35   #:use-module (guix combinators)
  36   #:use-module (guix monads)
  37   #:use-module (guix hash)
  38   #:use-module (guix base32)
  39   #:use-module (guix records)
  40   #:use-module (guix sets)
  41   #:export (<derivation>
  42             derivation?
  43             derivation-outputs
  44             derivation-inputs
  45             derivation-sources
  46             derivation-system
  47             derivation-builder
  48             derivation-builder-arguments
  49             derivation-builder-environment-vars
  50             derivation-file-name
  51             derivation-prerequisites
  52             derivation-prerequisites-to-build
  53
  54             <derivation-output>
  55             derivation-output?
  56             derivation-output-path
  57             derivation-output-hash-algo
  58             derivation-output-hash
  59             derivation-output-recursive?
  60
  61             <derivation-input>
  62             derivation-input?
  63             derivation-input-path
  64             derivation-input-sub-derivations
  65             derivation-input-output-paths
  66             valid-derivation-input?
  67
  68             &derivation-error
  69             derivation-error?
  70             derivation-error-derivation
  71             &derivation-missing-output-error
  72             derivation-missing-output-error?
  73             derivation-missing-output
  74
  75             derivation-name
  76             derivation-output-names
  77             fixed-output-derivation?
  78             fixed-output-path
  79             offloadable-derivation?
  80             substitutable-derivation?
  81             substitution-oracle
  82             derivation-hash
  83
  84             read-derivation
  85             write-derivation
  86             derivation->output-path
  87             derivation->output-paths
  88             derivation-path->output-path
  89             derivation-path->output-paths
  90             derivation
  91             raw-derivation
  92
  93             map-derivation
  94
  95             build-derivations
  96             built-derivations
  97
  98             file-search-error?
  99             file-search-error-file-name
 100             file-search-error-search-path
 101
 102             search-path*
 103             module->source-file-name
 104             build-expression->derivation)
 105
 106   ;; Re-export it from here for backward compatibility.
 107   #:re-export (%guile-for-build))
 108
 109 ;;;
 110 ;;; Error conditions.
 111 ;;;
 112
 113 (define-condition-type &derivation-error &nix-error
 114   derivation-error?
 115   (derivation derivation-error-derivation))
 116
 117 (define-condition-type &derivation-missing-output-error &derivation-error
 118   derivation-missing-output-error?
 119   (output derivation-missing-output))
 120
 121 ;;;
 122 ;;; Nix derivations, as implemented in Nix's `derivations.cc'.
 123 ;;;
 124
 125 (define-immutable-record-type <derivation>
 126   (make-derivation outputs inputs sources system builder args env-vars
 127                    file-name)
 128   derivation?
 129   (outputs  derivation-outputs)      ; list of name/<derivation-output> pairs
 130   (inputs   derivation-inputs)       ; list of <derivation-input>
 131   (sources  derivation-sources)      ; list of store paths
 132   (system   derivation-system)       ; string
 133   (builder  derivation-builder)      ; store path
 134   (args     derivation-builder-arguments)         ; list of strings
 135   (env-vars derivation-builder-environment-vars)  ; list of name/value pairs
 136   (file-name derivation-file-name))               ; the .drv file name
 137
 138 (define-record-type <derivation-output>
 139   (make-derivation-output path hash-algo hash recursive?)
 140   derivation-output?
 141   (path       derivation-output-path)             ; store path
 142   (hash-algo  derivation-output-hash-algo)        ; symbol | #f
 143   (hash       derivation-output-hash)             ; bytevector | #f
 144   (recursive? derivation-output-recursive?))      ; Boolean
 145
 146 (define-record-type <derivation-input>
 147   (make-derivation-input path sub-derivations)
 148   derivation-input?
 149   (path            derivation-input-path)             ; store path
 150   (sub-derivations derivation-input-sub-derivations)) ; list of strings
 151
 152 (set-record-type-printer! <derivation>
 153                           (lambda (drv port)
 154                             (format port "#<derivation ~a => ~a ~a>"
 155                                     (derivation-file-name drv)
 156                                     (string-join
 157                                      (map (match-lambda
 158                                            ((_ . output)
 159                                             (derivation-output-path output)))
 160                                           (derivation-outputs drv)))
 161                                     (number->string (object-address drv) 16))))
 162
 163 (define (derivation-name drv)
 164   "Return the base name of DRV."
 165   (let ((base (store-path-package-name (derivation-file-name drv))))
 166     (string-drop-right base 4)))
 167
 168 (define (derivation-output-names drv)
 169   "Return the names of the outputs of DRV."
 170   (match (derivation-outputs drv)
 171     (((names . _) ...)
 172      names)))
 173
 174 (define (fixed-output-derivation? drv)
 175   "Return #t if DRV is a fixed-output derivation, such as the result of a
 176 download with a fixed hash (aka. `fetchurl')."
 177   (match drv
 178     (($ <derivation>
 179         (("out" . ($ <derivation-output> _ (? symbol?) (? bytevector?)))))
 180      #t)
 181     (_ #f)))
 182
 183 (define (derivation-input<? input1 input2)
 184   "Compare INPUT1 and INPUT2, two <derivation-input>."
 185   (string<? (derivation-input-path input1)
 186             (derivation-input-path input2)))
 187
 188 (define (derivation-input-output-paths input)
 189   "Return the list of output paths corresponding to INPUT, a
 190 <derivation-input>."
 191   (match input
 192     (($ <derivation-input> path sub-drvs)
 193      (map (cut derivation-path->output-path path <>)
 194           sub-drvs))))
 195
 196 (define (valid-derivation-input? store input)
 197   "Return true if INPUT is valid--i.e., if all the outputs it requests are in
 198 the store."
 199   (every (cut valid-path? store <>)
 200          (derivation-input-output-paths input)))
 201
 202 (define (coalesce-duplicate-inputs inputs)
 203   "Return a list of inputs, such that when INPUTS contains the same DRV twice,
 204 they are coalesced, with their sub-derivations merged.  This is needed because
 205 Nix itself keeps only one of them."
 206   (fold (lambda (input result)
 207           (match input
 208             (($ <derivation-input> path sub-drvs)
 209              ;; XXX: quadratic
 210              (match (find (match-lambda
 211                             (($ <derivation-input> p s)
 212                              (string=? p path)))
 213                           result)
 214                (#f
 215                 (cons input result))
 216                ((and dup ($ <derivation-input> _ sub-drvs2))
 217                 ;; Merge DUP with INPUT.
 218                 (let ((sub-drvs (delete-duplicates
 219                                  (append sub-drvs sub-drvs2))))
 220                   (cons (make-derivation-input path
 221                                                (sort sub-drvs string<?))
 222                         (delq dup result))))))))
 223         '()
 224         inputs))
 225
 226 (define* (derivation-prerequisites drv #:optional (cut? (const #f)))
 227   "Return the list of derivation-inputs required to build DRV, recursively.
 228
 229 CUT? is a predicate that is passed a derivation-input and returns true to
 230 eliminate the given input and its dependencies from the search.  An example of
 231 search a predicate is 'valid-derivation-input?'; when it is used as CUT?, the
 232 result is the set of prerequisites of DRV not already in valid."
 233   (let loop ((drv       drv)
 234              (result    '())
 235              (input-set (set)))
 236     (let ((inputs (remove (lambda (input)
 237                             (or (set-contains? input-set input)
 238                                 (cut? input)))
 239                           (derivation-inputs drv))))
 240       (fold2 loop
 241              (append inputs result)
 242              (fold set-insert input-set inputs)
 243              (map (lambda (i)
 244                     (call-with-input-file (derivation-input-path i)
 245                       read-derivation))
 246                   inputs)))))
 247
 248 (define (offloadable-derivation? drv)
 249   "Return true if DRV can be offloaded, false otherwise."
 250   (match (assoc "preferLocalBuild"
 251                 (derivation-builder-environment-vars drv))
 252     (("preferLocalBuild" . "1") #f)
 253     (_ #t)))
 254
 255 (define (substitutable-derivation? drv)
 256   "Return #t if DRV can be substituted."
 257   (match (assoc "allowSubstitutes"
 258                 (derivation-builder-environment-vars drv))
 259     (("allowSubstitutes" . value)
 260      (string=? value "1"))
 261     (_ #t)))
 262
 263 (define (derivation-output-paths drv sub-drvs)
 264   "Return the output paths of outputs SUB-DRVS of DRV."
 265   (match drv
 266     (($ <derivation> outputs)
 267      (map (lambda (sub-drv)
 268             (derivation-output-path (assoc-ref outputs sub-drv)))
 269           sub-drvs))))
 270
 271 (define* (substitution-oracle store drv
 272                               #:key (mode (build-mode normal)))
 273   "Return a one-argument procedure that, when passed a store file name,
 274 returns #t if it's substitutable and #f otherwise.  The returned procedure
 275 knows about all substitutes for all the derivations listed in DRV, *except*
 276 those that are already valid (that is, it won't bother checking whether an
 277 item is substitutable if it's already on disk); it also knows about their
 278 prerequisites, unless they are themselves substitutable.
 279
 280 Creating a single oracle (thus making a single 'substitutable-paths' call) and
 281 reusing it is much more efficient than calling 'has-substitutes?' or similar
 282 repeatedly, because it avoids the costs associated with launching the
 283 substituter many times."
 284   (define valid?
 285     (cut valid-path? store <>))
 286
 287   (define valid-input?
 288     (cut valid-derivation-input? store <>))
 289
 290   (define (dependencies drv)
 291     ;; Skip prerequisite sub-trees of DRV whose root is valid.  This allows us
 292     ;; to ask the substituter for just as much as needed, instead of asking it
 293     ;; for the whole world, which can be significantly faster when substitute
 294     ;; info is not already in cache.
 295     (append-map derivation-input-output-paths
 296                 (derivation-prerequisites drv valid-input?)))
 297
 298   (let* ((paths (delete-duplicates
 299                  (concatenate
 300                   (fold (lambda (drv result)
 301                           (let ((self (match (derivation->output-paths drv)
 302                                         (((names . paths) ...)
 303                                          paths))))
 304                             (cond ((eqv? mode (build-mode check))
 305                                    (cons (dependencies drv) result))
 306                                   ((every valid? self)
 307                                    result)
 308                                   (else
 309                                    (cons* self (dependencies drv) result)))))
 310                         '()
 311                         drv))))
 312          (subst (list->set (substitutable-paths store paths))))
 313     (cut set-contains? subst <>)))
 314
 315 (define* (derivation-prerequisites-to-build store drv
 316                                             #:key
 317                                             (mode (build-mode normal))
 318                                             (outputs
 319                                              (derivation-output-names drv))
 320                                             (substitutable?
 321                                              (substitution-oracle store
 322                                                                   (list drv)
 323                                                                   #:mode mode)))
 324   "Return two values: the list of derivation-inputs required to build the
 325 OUTPUTS of DRV and not already available in STORE, recursively, and the list
 326 of required store paths that can be substituted.  SUBSTITUTABLE? must be a
 327 one-argument procedure similar to that returned by 'substitution-oracle'."
 328   (define built?
 329     (cut valid-path? store <>))
 330
 331   (define input-built?
 332     (compose (cut any built? <>) derivation-input-output-paths))
 333
 334   (define input-substitutable?
 335     ;; Return true if and only if all of SUB-DRVS are subsitutable.  If at
 336     ;; least one is missing, then everything must be rebuilt.
 337     (compose (cut every substitutable? <>) derivation-input-output-paths))
 338
 339   (define (derivation-built? drv* sub-drvs)
 340     ;; In 'check' mode, assume that DRV is not built.
 341     (and (not (and (eqv? mode (build-mode check))
 342                    (eq? drv* drv)))
 343          (every built? (derivation-output-paths drv* sub-drvs))))
 344
 345   (define (derivation-substitutable? drv sub-drvs)
 346     (and (substitutable-derivation? drv)
 347          (every substitutable? (derivation-output-paths drv sub-drvs))))
 348
 349   (let loop ((drv        drv)
 350              (sub-drvs   outputs)
 351              (build      '())
 352              (substitute '()))
 353     (cond ((derivation-built? drv sub-drvs)
 354            (values build substitute))
 355           ((derivation-substitutable? drv sub-drvs)
 356            (values build
 357                    (append (derivation-output-paths drv sub-drvs)
 358                            substitute)))
 359           (else
 360            (let ((build  (if (substitutable-derivation? drv)
 361                              build
 362                              (cons (make-derivation-input
 363                                     (derivation-file-name drv) sub-drvs)
 364                                    build)))
 365                  (inputs (remove (lambda (i)
 366                                    (or (member i build) ; XXX: quadratic
 367                                        (input-built? i)
 368                                        (input-substitutable? i)))
 369                                  (derivation-inputs drv))))
 370              (fold2 loop
 371                     (append inputs build)
 372                     (append (append-map (lambda (input)
 373                                           (if (and (not (input-built? input))
 374                                                    (input-substitutable? input))
 375                                               (derivation-input-output-paths
 376                                                input)
 377                                               '()))
 378                                         (derivation-inputs drv))
 379                             substitute)
 380                     (map (lambda (i)
 381                            (call-with-input-file (derivation-input-path i)
 382                              read-derivation))
 383                          inputs)
 384                     (map derivation-input-sub-derivations inputs)))))))
 385
 386 (define (%read-derivation drv-port)
 387   ;; Actually read derivation from DRV-PORT.
 388
 389   (define comma (string->symbol ","))
 390
 391   (define (ununquote x)
 392     (match x
 393       (('unquote x) (ununquote x))
 394       ((x ...)      (map ununquote x))
 395       (_            x)))
 396
 397   (define (outputs->alist x)
 398     (fold-right (lambda (output result)
 399                   (match output
 400                     ((name path "" "")
 401                      (alist-cons name
 402                                  (make-derivation-output path #f #f #f)
 403                                  result))
 404                     ((name path hash-algo hash)
 405                      ;; fixed-output
 406                      (let* ((rec? (string-prefix? "r:" hash-algo))
 407                             (algo (string->symbol
 408                                    (if rec?
 409                                        (string-drop hash-algo 2)
 410                                        hash-algo)))
 411                             (hash (base16-string->bytevector hash)))
 412                        (alist-cons name
 413                                    (make-derivation-output path algo
 414                                                            hash rec?)
 415                                    result)))))
 416                 '()
 417                 x))
 418
 419   (define (make-input-drvs x)
 420     (fold-right (lambda (input result)
 421                   (match input
 422                     ((path (sub-drvs ...))
 423                      (cons (make-derivation-input path sub-drvs)
 424                            result))))
 425                 '()
 426                 x))
 427
 428   ;; The contents of a derivation are typically ASCII, but choosing
 429   ;; UTF-8 allows us to take the fast path for Guile's `scm_getc'.
 430   (set-port-encoding! drv-port "UTF-8")
 431
 432   (let loop ((exp    (read drv-port))
 433              (result '()))
 434     (match exp
 435       ((? eof-object?)
 436        (let ((result (reverse result)))
 437          (match result
 438            (('Derive ((outputs ...) (input-drvs ...)
 439                       (input-srcs ...)
 440                       (? string? system)
 441                       (? string? builder)
 442                       ((? string? args) ...)
 443                       ((var value) ...)))
 444             (make-derivation (outputs->alist outputs)
 445                              (make-input-drvs input-drvs)
 446                              input-srcs
 447                              system builder args
 448                              (fold-right alist-cons '() var value)
 449                              (port-filename drv-port)))
 450            (_
 451             (error "failed to parse derivation" drv-port result)))))
 452       ((? (cut eq? <> comma))
 453        (loop (read drv-port) result))
 454       (_
 455        (loop (read drv-port)
 456              (cons (ununquote exp) result))))))
 457
 458 (define %derivation-cache
 459   ;; Maps derivation file names to <derivation> objects.
 460   ;; XXX: This is redundant with 'atts-cache' in the store.
 461   (make-weak-value-hash-table 200))
 462
 463 (define (read-derivation drv-port)
 464   "Read the derivation from DRV-PORT and return the corresponding
 465 <derivation> object."
 466   ;; Memoize that operation because `%read-derivation' is quite expensive,
 467   ;; and because the same argument is read more than 15 times on average
 468   ;; during something like (package-derivation s gdb).
 469   (let ((file (port-filename drv-port)))
 470     (or (and file (hash-ref %derivation-cache file))
 471         (let ((drv (%read-derivation drv-port)))
 472           (hash-set! %derivation-cache file drv)
 473           drv))))
 474
 475 (define-inlinable (write-sequence lst write-item port)
 476   ;; Write each element of LST with WRITE-ITEM to PORT, separating them with a
 477   ;; comma.
 478   (match lst
 479     (()
 480      #t)
 481     ((prefix (... ...) last)
 482      (for-each (lambda (item)
 483                  (write-item item port)
 484                  (display "," port))
 485                prefix)
 486      (write-item last port))))
 487
 488 (define-inlinable (write-list lst write-item port)
 489   ;; Write LST as a derivation list to PORT, using WRITE-ITEM to write each
 490   ;; element.
 491   (display "[" port)
 492   (write-sequence lst write-item port)
 493   (display "]" port))
 494
 495 (define-inlinable (write-tuple lst write-item port)
 496   ;; Same, but write LST as a tuple.
 497   (display "(" port)
 498   (write-sequence lst write-item port)
 499   (display ")" port))
 500
 501 (define (write-derivation drv port)
 502   "Write the ATerm-like serialization of DRV to PORT.  See Section 2.4 of
 503 Eelco Dolstra's PhD dissertation for an overview of a previous version of
 504 that form."
 505
 506   ;; Make sure we're using the faster implementation.
 507   (define format simple-format)
 508
 509   (define (write-string-list lst)
 510     (write-list lst write port))
 511
 512   (define (write-output output port)
 513     (match output
 514      ((name . ($ <derivation-output> path hash-algo hash recursive?))
 515       (write-tuple (list name path
 516                          (if hash-algo
 517                              (string-append (if recursive? "r:" "")
 518                                             (symbol->string hash-algo))
 519                              "")
 520                          (or (and=> hash bytevector->base16-string)
 521                              ""))
 522                    write
 523                    port))))
 524
 525   (define (write-input input port)
 526     (match input
 527       (($ <derivation-input> path sub-drvs)
 528        (display "(\"" port)
 529        (display path port)
 530        (display "\"," port)
 531        (write-string-list sub-drvs)
 532        (display ")" port))))
 533
 534   (define (write-env-var env-var port)
 535     (match env-var
 536       ((name . value)
 537        (display "(" port)
 538        (write name port)
 539        (display "," port)
 540        (write value port)
 541        (display ")" port))))
 542
 543   ;; Assume all the lists we are writing are already sorted.
 544   (match drv
 545     (($ <derivation> outputs inputs sources
 546         system builder args env-vars)
 547      (display "Derive(" port)
 548      (write-list outputs write-output port)
 549      (display "," port)
 550      (write-list inputs write-input port)
 551      (display "," port)
 552      (write-string-list sources)
 553      (simple-format port ",\"~a\",\"~a\"," system builder)
 554      (write-string-list args)
 555      (display "," port)
 556      (write-list env-vars write-env-var port)
 557      (display ")" port))))
 558
 559 (define derivation->string
 560   (mlambda (drv)
 561     "Return the external representation of DRV as a string."
 562     (with-fluids ((%default-port-encoding "UTF-8"))
 563       (call-with-output-string
 564         (cut write-derivation drv <>)))))
 565
 566 (define* (derivation->output-path drv #:optional (output "out"))
 567   "Return the store path of its output OUTPUT.  Raise a
 568 '&derivation-missing-output-error' condition if OUTPUT is not an output of
 569 DRV."
 570   (let ((output* (assoc-ref (derivation-outputs drv) output)))
 571     (if output*
 572         (derivation-output-path output*)
 573         (raise (condition (&derivation-missing-output-error
 574                            (derivation drv)
 575                            (output output)))))))
 576
 577 (define (derivation->output-paths drv)
 578   "Return the list of name/path pairs of the outputs of DRV."
 579   (map (match-lambda
 580         ((name . output)
 581          (cons name (derivation-output-path output))))
 582        (derivation-outputs drv)))
 583
 584 (define derivation-path->output-path
 585   ;; This procedure is called frequently, so memoize it.
 586   (let ((memoized (mlambda (path output)
 587                     (derivation->output-path (call-with-input-file path
 588                                                read-derivation)
 589                                              output))))
 590     (lambda* (path #:optional (output "out"))
 591       "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store
 592 path of its output OUTPUT."
 593       (memoized path output))))
 594
 595 (define (derivation-path->output-paths path)
 596   "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the
 597 list of name/path pairs of its outputs."
 598   (derivation->output-paths (call-with-input-file path read-derivation)))
 599
 600 \f
 601 ;;;
 602 ;;; Derivation primitive.
 603 ;;;
 604
 605 (define (compressed-hash bv size)                 ; `compressHash'
 606   "Given the hash stored in BV, return a compressed version thereof that fits
 607 in SIZE bytes."
 608   (define new (make-bytevector size 0))
 609   (define old-size (bytevector-length bv))
 610   (let loop ((i 0))
 611     (if (= i old-size)
 612         new
 613         (let* ((j (modulo i size))
 614                (o (bytevector-u8-ref new j)))
 615           (bytevector-u8-set! new j
 616                               (logxor o (bytevector-u8-ref bv i)))
 617           (loop (+ 1 i))))))
 618
 619 (define derivation-path->base16-hash
 620   (mlambda (file)
 621     "Return a string containing the base16 representation of the hash of the
 622 derivation at FILE."
 623     (call-with-input-file file
 624       (compose bytevector->base16-string
 625                derivation-hash
 626                read-derivation))))
 627
 628 (define derivation-hash            ; `hashDerivationModulo' in derivations.cc
 629   (mlambda (drv)
 630     "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
 631     (match drv
 632       (($ <derivation> ((_ . ($ <derivation-output> path
 633                                                     (? symbol? hash-algo) (? bytevector? hash)
 634                                                     (? boolean? recursive?)))))
 635        ;; A fixed-output derivation.
 636        (sha256
 637         (string->utf8
 638          (string-append "fixed:out:"
 639                         (if recursive? "r:" "")
 640                         (symbol->string hash-algo)
 641                         ":" (bytevector->base16-string hash)
 642                         ":" path))))
 643       (($ <derivation> outputs inputs sources
 644                        system builder args env-vars)
 645        ;; A regular derivation: replace the path of each input with that
 646        ;; input's hash; return the hash of serialization of the resulting
 647        ;; derivation.
 648        (let* ((inputs (map (match-lambda
 649                              (($ <derivation-input> path sub-drvs)
 650                               (let ((hash (derivation-path->base16-hash path)))
 651                                 (make-derivation-input hash sub-drvs))))
 652                            inputs))
 653               (drv    (make-derivation outputs
 654                                        (sort (coalesce-duplicate-inputs inputs)
 655                                              derivation-input<?)
 656                                        sources
 657                                        system builder args env-vars
 658                                        #f)))
 659
 660          ;; XXX: At this point this remains faster than `port-sha256', because
 661          ;; the SHA256 port's `write' method gets called for every single
 662          ;; character.
 663          (sha256
 664           (string->utf8 (derivation->string drv))))))))
 665
 666 (define (store-path type hash name)               ; makeStorePath
 667   "Return the store path for NAME/HASH/TYPE."
 668   (let* ((s (string-append type ":sha256:"
 669                            (bytevector->base16-string hash) ":"
 670                            (%store-prefix) ":" name))
 671          (h (sha256 (string->utf8 s)))
 672          (c (compressed-hash h 20)))
 673     (string-append (%store-prefix) "/"
 674                    (bytevector->nix-base32-string c) "-"
 675                    name)))
 676
 677 (define (output-path output hash name)            ; makeOutputPath
 678   "Return an output path for OUTPUT (the name of the output as a string) of
 679 the derivation called NAME with hash HASH."
 680   (store-path (string-append "output:" output) hash
 681               (if (string=? output "out")
 682                   name
 683                   (string-append name "-" output))))
 684
 685 (define* (fixed-output-path name hash
 686                             #:key
 687                             (output "out")
 688                             (hash-algo 'sha256)
 689                             (recursive? #t))
 690   "Return an output path for the fixed output OUTPUT defined by HASH of type
 691 HASH-ALGO, of the derivation NAME.  RECURSIVE? has the same meaning as for
 692 'add-to-store'."
 693   (if (and recursive? (eq? hash-algo 'sha256))
 694       (store-path "source" hash name)
 695       (let ((tag (string-append "fixed:" output ":"
 696                                 (if recursive? "r:" "")
 697                                 (symbol->string hash-algo) ":"
 698                                 (bytevector->base16-string hash) ":")))
 699         (store-path (string-append "output:" output)
 700                     (sha256 (string->utf8 tag))
 701                     name))))
 702
 703 (define* (derivation store name builder args
 704                      #:key
 705                      (system (%current-system)) (env-vars '())
 706                      (inputs '()) (outputs '("out"))
 707                      hash hash-algo recursive?
 708                      references-graphs
 709                      allowed-references disallowed-references
 710                      leaked-env-vars local-build?
 711                      (substitutable? #t))
 712   "Build a derivation with the given arguments, and return the resulting
 713 <derivation> object.  When HASH and HASH-ALGO are given, a
 714 fixed-output derivation is created---i.e., one whose result is known in
 715 advance, such as a file download.  If, in addition, RECURSIVE? is true, then
 716 that fixed output may be an executable file or a directory and HASH must be
 717 the hash of an archive containing this output.
 718
 719 When REFERENCES-GRAPHS is true, it must be a list of file name/store path
 720 pairs.  In that case, the reference graph of each store path is exported in
 721 the build environment in the corresponding file, in a simple text format.
 722
 723 When ALLOWED-REFERENCES is true, it must be a list of store items or outputs
 724 that the derivation's outputs may refer to.  Likewise, DISALLOWED-REFERENCES,
 725 if true, must be a list of things the outputs may not refer to.
 726
 727 When LEAKED-ENV-VARS is true, it must be a list of strings denoting
 728 environment variables that are allowed to \"leak\" from the daemon's
 729 environment to the build environment.  This is only applicable to fixed-output
 730 derivations--i.e., when HASH is true.  The main use is to allow variables such
 731 as \"http_proxy\" to be passed to derivations that download files.
 732
 733 When LOCAL-BUILD? is true, declare that the derivation is not a good candidate
 734 for offloading and should rather be built locally.  This is the case for small
 735 derivations where the costs of data transfers would outweigh the benefits.
 736
 737 When SUBSTITUTABLE? is false, declare that substitutes of the derivation's
 738 output should not be used."
 739   (define (add-output-paths drv)
 740     ;; Return DRV with an actual store path for each of its output and the
 741     ;; corresponding environment variable.
 742     (match drv
 743       (($ <derivation> outputs inputs sources
 744           system builder args env-vars)
 745        (let* ((drv-hash (derivation-hash drv))
 746               (outputs  (map (match-lambda
 747                               ((output-name . ($ <derivation-output>
 748                                                  _ algo hash rec?))
 749                                (let ((path
 750                                       (if hash
 751                                           (fixed-output-path name hash
 752                                                              #:hash-algo algo
 753                                                              #:output output-name
 754                                                              #:recursive? rec?)
 755                                           (output-path output-name
 756                                                        drv-hash name))))
 757                                  (cons output-name
 758                                        (make-derivation-output path algo
 759                                                                hash rec?)))))
 760                              outputs)))
 761          (make-derivation outputs inputs sources system builder args
 762                           (map (match-lambda
 763                                 ((name . value)
 764                                  (cons name
 765                                        (or (and=> (assoc-ref outputs name)
 766                                                   derivation-output-path)
 767                                            value))))
 768                                env-vars)
 769                           #f)))))
 770
 771   (define (user+system-env-vars)
 772     ;; Some options are passed to the build daemon via the env. vars of
 773     ;; derivations (urgh!).  We hide that from our API, but here is the place
 774     ;; where we kludgify those options.
 775     (let ((env-vars `(,@(if local-build?
 776                             `(("preferLocalBuild" . "1"))
 777                             '())
 778                       ,@(if (not substitutable?)
 779                             `(("allowSubstitutes" . "0"))
 780                             '())
 781                       ,@(if allowed-references
 782                             `(("allowedReferences"
 783                                . ,(string-join allowed-references)))
 784                             '())
 785                       ,@(if disallowed-references
 786                             `(("disallowedReferences"
 787                                . ,(string-join disallowed-references)))
 788                             '())
 789                       ,@(if leaked-env-vars
 790                             `(("impureEnvVars"
 791                                . ,(string-join leaked-env-vars)))
 792                             '())
 793                       ,@env-vars)))
 794       (match references-graphs
 795         (((file . path) ...)
 796          (let ((value (map (cut string-append <> " " <>)
 797                            file path)))
 798            ;; XXX: This all breaks down if an element of FILE or PATH contains
 799            ;; white space.
 800            `(("exportReferencesGraph" . ,(string-join value " "))
 801              ,@env-vars)))
 802         (#f
 803          env-vars))))
 804
 805   (define (env-vars-with-empty-outputs env-vars)
 806     ;; Return a variant of ENV-VARS where each OUTPUTS is associated with an
 807     ;; empty string, even outputs that do not appear in ENV-VARS.
 808     (let ((e (map (match-lambda
 809                    ((name . val)
 810                     (if (member name outputs)
 811                         (cons name "")
 812                         (cons name val))))
 813                   env-vars)))
 814       (fold (lambda (output-name env-vars)
 815               (if (assoc output-name env-vars)
 816                   env-vars
 817                   (append env-vars `((,output-name . "")))))
 818             e
 819             outputs)))
 820
 821   (define input->derivation-input
 822     (match-lambda
 823       (((? derivation? drv))
 824        (make-derivation-input (derivation-file-name drv) '("out")))
 825       (((? derivation? drv) sub-drvs ...)
 826        (make-derivation-input (derivation-file-name drv) sub-drvs))
 827       (((? direct-store-path? input))
 828        (make-derivation-input input '("out")))
 829       (((? direct-store-path? input) sub-drvs ...)
 830        (make-derivation-input input sub-drvs))
 831       ((input . _)
 832        (let ((path (add-to-store store (basename input)
 833                                  #t "sha256" input)))
 834          (make-derivation-input path '())))))
 835
 836   ;; Note: lists are sorted alphabetically, to conform with the behavior of
 837   ;; C++ `std::map' in Nix itself.
 838
 839   (let* ((outputs    (map (lambda (name)
 840                             ;; Return outputs with an empty path.
 841                             (cons name
 842                                   (make-derivation-output "" hash-algo
 843                                                           hash recursive?)))
 844                           (sort outputs string<?)))
 845          (inputs     (sort (coalesce-duplicate-inputs
 846                             (map input->derivation-input
 847                                  (delete-duplicates inputs)))
 848                            derivation-input<?))
 849          (env-vars   (sort (env-vars-with-empty-outputs
 850                             (user+system-env-vars))
 851                            (lambda (e1 e2)
 852                              (string<? (car e1) (car e2)))))
 853          (drv-masked (make-derivation outputs
 854                                       (filter (compose derivation-path?
 855                                                        derivation-input-path)
 856                                               inputs)
 857                                       (filter-map (lambda (i)
 858                                                     (let ((p (derivation-input-path i)))
 859                                                       (and (not (derivation-path? p))
 860                                                            p)))
 861                                                   inputs)
 862                                       system builder args env-vars #f))
 863          (drv        (add-output-paths drv-masked)))
 864
 865     (let* ((file (add-text-to-store store (string-append name ".drv")
 866                                     (derivation->string drv)
 867                                     (map derivation-input-path inputs)))
 868            (drv* (set-field drv (derivation-file-name) file)))
 869       (hash-set! %derivation-cache file drv*)
 870       drv*)))
 871
 872 (define* (map-derivation store drv mapping
 873                          #:key (system (%current-system)))
 874   "Given MAPPING, a list of pairs of derivations, return a derivation based on
 875 DRV where all the 'car's of MAPPING have been replaced by its 'cdr's,
 876 recursively."
 877   (define (substitute str initial replacements)
 878     (fold (lambda (path replacement result)
 879             (string-replace-substring result path
 880                                       replacement))
 881           str
 882           initial replacements))
 883
 884   (define (substitute-file file initial replacements)
 885     (define contents
 886       (with-fluids ((%default-port-encoding #f))
 887         (call-with-input-file file read-string)))
 888
 889     (let ((updated (substitute contents initial replacements)))
 890       (if (string=? updated contents)
 891           file
 892           ;; XXX: permissions aren't preserved.
 893           (add-text-to-store store (store-path-package-name file)
 894                              updated))))
 895
 896   (define input->output-paths
 897     (match-lambda
 898      (((? derivation? drv))
 899       (list (derivation->output-path drv)))
 900      (((? derivation? drv) sub-drvs ...)
 901       (map (cut derivation->output-path drv <>)
 902            sub-drvs))
 903      ((file)
 904       (list file))))
 905
 906   (let ((mapping (fold (lambda (pair result)
 907                          (match pair
 908                            (((? derivation? orig) . replacement)
 909                             (vhash-cons (derivation-file-name orig)
 910                                         replacement result))
 911                            ((file . replacement)
 912                             (vhash-cons file replacement result))))
 913                        vlist-null
 914                        mapping)))
 915     (define rewritten-input
 916       ;; Rewrite the given input according to MAPPING, and return an input
 917       ;; in the format used in 'derivation' calls.
 918       (mlambda (input loop)
 919         (match input
 920           (($ <derivation-input> path (sub-drvs ...))
 921            (match (vhash-assoc path mapping)
 922              ((_ . (? derivation? replacement))
 923               (cons replacement sub-drvs))
 924              ((_ . replacement)
 925               (list replacement))
 926              (#f
 927               (let* ((drv (loop (call-with-input-file path read-derivation))))
 928                 (cons drv sub-drvs))))))))
 929
 930     (let loop ((drv drv))
 931       (let* ((inputs       (map (cut rewritten-input <> loop)
 932                                 (derivation-inputs drv)))
 933              (initial      (append-map derivation-input-output-paths
 934                                        (derivation-inputs drv)))
 935              (replacements (append-map input->output-paths inputs))
 936
 937              ;; Sources typically refer to the output directories of the
 938              ;; original inputs, INITIAL.  Rewrite them by substituting
 939              ;; REPLACEMENTS.
 940              (sources      (map (lambda (source)
 941                                   (match (vhash-assoc source mapping)
 942                                     ((_ . replacement)
 943                                      replacement)
 944                                     (#f
 945                                      (substitute-file source
 946                                                       initial replacements))))
 947                                 (derivation-sources drv)))
 948
 949              ;; Now augment the lists of initials and replacements.
 950              (initial      (append (derivation-sources drv) initial))
 951              (replacements (append sources replacements))
 952              (name         (store-path-package-name
 953                             (string-drop-right (derivation-file-name drv)
 954                                                4))))
 955         (derivation store name
 956                     (substitute (derivation-builder drv)
 957                                 initial replacements)
 958                     (map (cut substitute <> initial replacements)
 959                          (derivation-builder-arguments drv))
 960                     #:system system
 961                     #:env-vars (map (match-lambda
 962                                      ((var . value)
 963                                       `(,var
 964                                         . ,(substitute value initial
 965                                                        replacements))))
 966                                     (derivation-builder-environment-vars drv))
 967                     #:inputs (append (map list sources) inputs)
 968                     #:outputs (derivation-output-names drv)
 969                     #:hash (match (derivation-outputs drv)
 970                              ((($ <derivation-output> _ algo hash))
 971                               hash)
 972                              (_ #f))
 973                     #:hash-algo (match (derivation-outputs drv)
 974                                   ((($ <derivation-output> _ algo hash))
 975                                    algo)
 976                                   (_ #f)))))))
 977
 978 \f
 979 ;;;
 980 ;;; Store compatibility layer.
 981 ;;;
 982
 983 (define* (build-derivations store derivations
 984                             #:optional (mode (build-mode normal)))
 985   "Build DERIVATIONS, a list of <derivation> objects or .drv file names, using
 986 the specified MODE."
 987   (build-things store (map (match-lambda
 988                             ((? string? file) file)
 989                             ((and drv ($ <derivation>))
 990                              (derivation-file-name drv)))
 991                            derivations)
 992                 mode))
 993
 994 \f
 995 ;;;
 996 ;;; Guile-based builders.
 997 ;;;
 998
 999 (define (parent-directories file-name)
1000   "Return the list of parent dirs of FILE-NAME, in the order in which an
1001 `mkdir -p' implementation would make them."
1002   (let ((not-slash (char-set-complement (char-set #\/))))
1003     (reverse
1004      (fold (lambda (dir result)
1005              (match result
1006                (()
1007                 (list dir))
1008                ((prev _ ...)
1009                 (cons (string-append prev "/" dir)
1010                       result))))
1011            '()
1012            (remove (cut string=? <> ".")
1013                    (string-tokenize (dirname file-name) not-slash))))))
1014
1015 (define* (imported-files store files              ;deprecated
1016                          #:key (name "file-import")
1017                          (system (%current-system))
1018                          (guile (%guile-for-build)))
1019   "Return a derivation that imports FILES into STORE.  FILES must be a list
1020 of (FINAL-PATH . FILE-NAME) pairs; each FILE-NAME is read from the file
1021 system, imported, and appears under FINAL-PATH in the resulting store path."
1022   (let* ((files   (map (match-lambda
1023                         ((final-path . file-name)
1024                          (list final-path
1025                                (add-to-store store (basename final-path) #f
1026                                              "sha256" file-name))))
1027                        files))
1028          (builder
1029           `(begin
1030              (mkdir %output) (chdir %output)
1031              ,@(append-map (match-lambda
1032                             ((final-path store-path)
1033                              (append (match (parent-directories final-path)
1034                                        (() '())
1035                                        ((head ... tail)
1036                                         (append (map (lambda (d)
1037                                                        `(false-if-exception
1038                                                          (mkdir ,d)))
1039                                                      head)
1040                                                 `((or (file-exists? ,tail)
1041                                                       (mkdir ,tail))))))
1042                                      `((symlink ,store-path ,final-path)))))
1043                            files))))
1044     (build-expression->derivation store name builder
1045                                   #:system system
1046                                   #:inputs files
1047                                   #:guile-for-build guile
1048                                   #:local-build? #t)))
1049
1050 ;; The "file not found" error condition.
1051 (define-condition-type &file-search-error &error
1052   file-search-error?
1053   (file     file-search-error-file-name)
1054   (path     file-search-error-search-path))
1055
1056 (define search-path*
1057   ;; A memoizing version of 'search-path' so 'imported-modules' does not end
1058   ;; up looking for the same files over and over again.
1059   (mlambda (path file)
1060     "Search for FILE in PATH and memoize the result.  Raise a
1061 '&file-search-error' condition if it could not be found."
1062     (or (search-path path file)
1063         (raise (condition
1064                 (&file-search-error (file file)
1065                                     (path path)))))))
1066
1067 (define (module->source-file-name module)
1068   "Return the file name corresponding to MODULE, a Guile module name (a list
1069 of symbols.)"
1070   (string-append (string-join (map symbol->string module) "/")
1071                  ".scm"))
1072
1073 (define* (%imported-modules store modules         ;deprecated
1074                             #:key (name "module-import")
1075                             (system (%current-system))
1076                             (guile (%guile-for-build))
1077                             (module-path %load-path))
1078   "Return a derivation that contains the source files of MODULES, a list of
1079 module names such as `(ice-9 q)'.  All of MODULES must be in the MODULE-PATH
1080 search path."
1081   ;; TODO: Determine the closure of MODULES, build the `.go' files,
1082   ;; canonicalize the source files through read/write, etc.
1083   (let ((files (map (lambda (m)
1084                       (let ((f (module->source-file-name m)))
1085                         (cons f (search-path* module-path f))))
1086                     modules)))
1087     (imported-files store files #:name name #:system system
1088                     #:guile guile)))
1089
1090 (define* (%compiled-modules store modules         ;deprecated
1091                             #:key (name "module-import-compiled")
1092                             (system (%current-system))
1093                             (guile (%guile-for-build))
1094                             (module-path %load-path))
1095   "Return a derivation that builds a tree containing the `.go' files
1096 corresponding to MODULES.  All the MODULES are built in a context where
1097 they can refer to each other."
1098   (let* ((module-drv (%imported-modules store modules
1099                                         #:system system
1100                                         #:guile guile
1101                                         #:module-path module-path))
1102          (module-dir (derivation->output-path module-drv))
1103          (files      (map (lambda (m)
1104                             (let ((f (string-join (map symbol->string m)
1105                                                   "/")))
1106                               (cons (string-append f ".go")
1107                                     (string-append module-dir "/" f ".scm"))))
1108                       modules)))
1109     (define builder
1110       `(begin
1111          (use-modules (system base compile))
1112          (let ((out (assoc-ref %outputs "out")))
1113            (mkdir out)
1114            (chdir out))
1115
1116          (set! %load-path
1117                (cons ,module-dir %load-path))
1118
1119          ,@(map (match-lambda
1120                  ((output . input)
1121                   (let ((make-parent-dirs (map (lambda (dir)
1122                                                  `(unless (file-exists? ,dir)
1123                                                     (mkdir ,dir)))
1124                                                (parent-directories output))))
1125                    `(begin
1126                       ,@make-parent-dirs
1127                       (compile-file ,input
1128                                     #:output-file ,output
1129                                     #:opts %auto-compilation-options)))))
1130                 files)))
1131
1132     (build-expression->derivation store name builder
1133                                   #:inputs `(("modules" ,module-drv))
1134                                   #:system system
1135                                   #:guile-for-build guile
1136                                   #:local-build? #t)))
1137
1138 (define* (build-expression->derivation store name exp ;deprecated
1139                                        #:key
1140                                        (system (%current-system))
1141                                        (inputs '())
1142                                        (outputs '("out"))
1143                                        hash hash-algo recursive?
1144                                        (env-vars '())
1145                                        (modules '())
1146                                        guile-for-build
1147                                        references-graphs
1148                                        allowed-references
1149                                        disallowed-references
1150                                        local-build? (substitutable? #t))
1151   "Return a derivation that executes Scheme expression EXP as a builder
1152 for derivation NAME.  INPUTS must be a list of (NAME DRV-PATH SUB-DRV)
1153 tuples; when SUB-DRV is omitted, \"out\" is assumed.  MODULES is a list
1154 of names of Guile modules from the current search path to be copied in
1155 the store, compiled, and made available in the load path during the
1156 execution of EXP.
1157
1158 EXP is evaluated in an environment where %OUTPUT is bound to the main
1159 output path, %OUTPUTS is bound to a list of output/path pairs, and where
1160 %BUILD-INPUTS is bound to an alist of string/output-path pairs made from
1161 INPUTS.  Optionally, ENV-VARS is a list of string pairs specifying the
1162 name and value of environment variables visible to the builder.  The
1163 builder terminates by passing the result of EXP to `exit'; thus, when
1164 EXP returns #f, the build is considered to have failed.
1165
1166 EXP is built using GUILE-FOR-BUILD (a derivation).  When GUILE-FOR-BUILD is
1167 omitted or is #f, the value of the `%guile-for-build' fluid is used instead.
1168
1169 See the `derivation' procedure for the meaning of REFERENCES-GRAPHS,
1170 ALLOWED-REFERENCES, DISALLOWED-REFERENCES, LOCAL-BUILD?, and SUBSTITUTABLE?."
1171   (define guile-drv
1172     (or guile-for-build (%guile-for-build)))
1173
1174   (define guile
1175     (string-append (derivation->output-path guile-drv)
1176                    "/bin/guile"))
1177
1178   (define module-form?
1179     (match-lambda
1180      (((or 'define-module 'use-modules) _ ...) #t)
1181      (_ #f)))
1182
1183   (define source-path
1184     ;; When passed an input that is a source, return its path; otherwise
1185     ;; return #f.
1186     (match-lambda
1187      ((_ (? derivation?) _ ...)
1188       #f)
1189      ((_ path _ ...)
1190       (and (not (derivation-path? path))
1191            path))))
1192
1193   (let* ((prologue `(begin
1194                       ,@(match exp
1195                           ((_ ...)
1196                            ;; Module forms must appear at the top-level so
1197                            ;; that any macros they export can be expanded.
1198                            (filter module-form? exp))
1199                           (_ `(,exp)))
1200
1201                       (define %output (getenv "out"))
1202                       (define %outputs
1203                         (map (lambda (o)
1204                                (cons o (getenv o)))
1205                              ',outputs))
1206                       (define %build-inputs
1207                         ',(map (match-lambda
1208                                 ((name drv . rest)
1209                                  (let ((sub (match rest
1210                                               (() "out")
1211                                               ((x) x))))
1212                                    (cons name
1213                                          (cond
1214                                           ((derivation? drv)
1215                                            (derivation->output-path drv sub))
1216                                           ((derivation-path? drv)
1217                                            (derivation-path->output-path drv
1218                                                                          sub))
1219                                           (else drv))))))
1220                                inputs))
1221
1222                       ,@(if (null? modules)
1223                             '()
1224                             ;; Remove our own settings.
1225                             '((unsetenv "GUILE_LOAD_COMPILED_PATH")))
1226
1227                       ;; Guile sets it, but remove it to avoid conflicts when
1228                       ;; building Guile-using packages.
1229                       (unsetenv "LD_LIBRARY_PATH")))
1230          (builder  (add-text-to-store store
1231                                       (string-append name "-guile-builder")
1232
1233                                       ;; Explicitly use UTF-8 for determinism,
1234                                       ;; and also because UTF-8 output is faster.
1235                                       (with-fluids ((%default-port-encoding
1236                                                      "UTF-8"))
1237                                         (call-with-output-string
1238                                          (lambda (port)
1239                                            (write prologue port)
1240                                            (write
1241                                             `(exit
1242                                               ,(match exp
1243                                                  ((_ ...)
1244                                                   (remove module-form? exp))
1245                                                  (_ `(,exp))))
1246                                             port))))
1247
1248                                       ;; The references don't really matter
1249                                       ;; since the builder is always used in
1250                                       ;; conjunction with the drv that needs
1251                                       ;; it.  For clarity, we add references
1252                                       ;; to the subset of INPUTS that are
1253                                       ;; sources, avoiding references to other
1254                                       ;; .drv; otherwise, BUILDER's hash would
1255                                       ;; depend on those, even if they are
1256                                       ;; fixed-output.
1257                                       (filter-map source-path inputs)))
1258
1259          (mod-drv  (and (pair? modules)
1260                         (%imported-modules store modules
1261                                            #:guile guile-drv
1262                                            #:system system)))
1263          (mod-dir  (and mod-drv
1264                         (derivation->output-path mod-drv)))
1265          (go-drv   (and (pair? modules)
1266                         (%compiled-modules store modules
1267                                            #:guile guile-drv
1268                                            #:system system)))
1269          (go-dir   (and go-drv
1270                         (derivation->output-path go-drv))))
1271     (derivation store name guile
1272                 `("--no-auto-compile"
1273                   ,@(if mod-dir `("-L" ,mod-dir) '())
1274                   ,builder)
1275
1276                 #:system system
1277
1278                 #:inputs `((,(or guile-for-build (%guile-for-build)))
1279                            (,builder)
1280                            ,@(map cdr inputs)
1281                            ,@(if mod-drv `((,mod-drv) (,go-drv)) '()))
1282
1283                 ;; When MODULES is non-empty, shamelessly clobber
1284                 ;; $GUILE_LOAD_COMPILED_PATH.
1285                 #:env-vars (if go-dir
1286                                `(("GUILE_LOAD_COMPILED_PATH" . ,go-dir)
1287                                  ,@(alist-delete "GUILE_LOAD_COMPILED_PATH"
1288                                                  env-vars))
1289                                env-vars)
1290
1291                 #:hash hash #:hash-algo hash-algo
1292                 #:recursive? recursive?
1293                 #:outputs outputs
1294                 #:references-graphs references-graphs
1295                 #:allowed-references allowed-references
1296                 #:disallowed-references disallowed-references
1297                 #:local-build? local-build?
1298                 #:substitutable? substitutable?)))
1299
1300 \f
1301 ;;;
1302 ;;; Monadic interface.
1303 ;;;
1304
1305 (define built-derivations
1306   (store-lift build-derivations))
1307
1308 (define raw-derivation
1309   (store-lift derivation))