;; Implements the Nix .drv file format.
(define-library (zilch nix drv)
  (import
    (scheme base) (scheme case-lambda) (scheme write) (scheme file)
    (zilch lib hash) (zilch nix hash) (zilch nix path)
    (srfi 128) (srfi 132) (srfi 146)
    (chicken base) (chicken format))

  (export
    <derivation> derivation?
    derivation-name derivation-outputs derivation-input-drvs
    derivation-input-src derivation-system derivation-builder
    derivation-args derivation-env derivation-equal?
    derivation-meta set-derivation-meta!

    %derivation-compatible
    <derivation-output> derivation-output?
    derivation-output-path derivation-output-hash
    derivation-output-algo derivation-output-recursive
    derivation-output-placeholder? derivation-output-path-length
    drv-is-fod

    derivation-serialize derivation-path-references derivation-path derivation-read read-drv-path
    make-fixed-output-derivation make-input-addressed-derivation make-ca-derivation
    modulo-hash-drv-contents)

  (begin
    ;; If `#t`, `make-[..]-derivation` will output environment variables not used by Nix, but required for compatibility with Nix's output.
    ;; This adds `name`, `builder`, and `system` to the environment; as well as `outputHash`, `outputHashAlgo`,
    ;; and `outputHashMode` for fixed-output derivations.
    (define %derivation-compatible (make-parameter #t))

    ;; Describes the output path of a derivation, along with its hash and
    ;; whether or not it the hash is of the NAR file, if it is a content-addressed output.
    ;; The path can be read using `(derivation-output-path)`.
    ;;
    ;; - `(path #u8() "" #f)` is an input-addressed derivation output.
    ;; - `(path #f #f #f)` is an input-addressed derivation output.
    ;; - `(path hash-value hash-algo rec)` is a content-addressed derivation output.
    ;; - `(#f 'floating hash-algo rec)` is a floating content-addressed derivation output.
    (define-record-type <derivation-output>
      (make-derivation-output path hash algo recursive)
      derivation-output?
      (path derivation-output-path set-derivation-output-path!)
      (hash derivation-output-hash)
      (algo derivation-output-algo)
      (recursive derivation-output-recursive))

    (define-record-printer (<derivation-output> drvout out)
      (fprintf out "#<derivation-output ~s hash: ~s algo: ~s recursive: ~s>"
        (derivation-output-path drvout)
        (derivation-output-hash drvout)
        (derivation-output-algo drvout)
        (derivation-output-recursive drvout)))

    ;; Returns whether the `derivation-output-path` of this output is a placeholder (floating hash)
    (define (derivation-output-placeholder? drvout)
      (member (derivation-output-hash drvout) '(floating)))

    ;; Returns the final (post-placeholder substitution) length of a derivation's output.
    (define (derivation-output-path-length drv output-name)
      ; /nix/store/a0a3n97c93ckfg3a920aqnycxdznbbmi-module-output
      (+ (string-length (%store-dir)) 34 (string-length (derivation-name drv)) (if (string=? output-name "out") 0 (+ 1 (string-length output-name)))))

    ;; Internal use; stores the precalculated .drv path and modulo hash.
    (define-record-type <derivation-metadata>
      (make-derivation-metadata path modulo-hash is-deferred serialized meta)
      derivation-cached-data?
      (path derivation-metadata-path set-derivation-metadata-path!)
      (modulo-hash derivation-metadata-modulo-hash set-derivation-metadata-modulo-hash!)
      (is-deferred derivation-metadata-is-deferred set-derivation-metadata-is-deferred!)
      (serialized derivation-metadata-serialized set-derivation-metadata-serialized!)
      (meta derivation-metadata-meta set-derivation-metadata-meta!))

    ;; An arbitrary Scheme object stored in the `<derivation>`.
    (define (derivation-meta drv)
     (derivation-metadata-meta (derivation-metadata drv)))
    ;; Sets the object stored within the `<derivation>`.
    (define (set-derivation-meta! drv meta)
     (set-derivation-metadata-meta! (derivation-metadata drv) meta))

    (define-record-printer (<derivation-metadata> drv out)
      (fprintf out "#<derivation-metadata path: ~S, hash: ~S, deferred: ~S (has serialized? ~S)>"
        (derivation-metadata-path drv)
        (derivation-metadata-modulo-hash drv)
        (derivation-metadata-is-deferred drv)
        (not (not (derivation-metadata-serialized drv)))))

    ;; An entire derivation.
    ;;
    ;; - `outputs` is an alist of output name to `<derivation-output>` record.
    ;; - `input-drvs` is an alist of `<derivation>` to a (sorted) list of the outputs of said derivation that are depended on.
    ;;
    ;; `outputs`, `input-drvs`, `input-src`, and `env` are expected to be sorted.
    (define-record-type <derivation>
      (make-derivation name outputs input-drvs input-src system builder args env metadata)
      derivation?
      (name derivation-name)

      ; '(id . <derivation-output>)
      (outputs derivation-outputs)

      ; '(<derivation> . (first-output second-output ...))
      (input-drvs derivation-input-drvs)

      ; '(file-path file-path ...)
      (input-src derivation-input-src)
      (system derivation-system)
      (builder derivation-builder)
      (args derivation-args)
      (env derivation-env)

      (metadata derivation-metadata))

    (define is-printing-drv (make-parameter #f))
    (define-record-printer (<derivation> drv out)
      (define was-printing-drv (is-printing-drv))
      (parameterize ((is-printing-drv #t))
        (fprintf out "#<derivation ~s ~s inputs: ~s ~s, ~s ~s ~s ~s, metadata ~S>"
          (derivation-name drv)
          (derivation-outputs drv)
          (if was-printing-drv (map derivation-name (derivation-input-drvs drv)) (derivation-input-drvs drv))
          (derivation-input-src drv)
          (derivation-system drv)
          (derivation-builder drv)
          (derivation-args drv)
          (derivation-env drv)
          (derivation-metadata drv))))

    (define (write-delim-list start end fn val port)
      (write-char start port)
      (define is-first #t)
      (for-each
        (lambda (v)
          (cond (is-first (set! is-first #f))
                (else (write-char #\, port)))
          (fn v)) val)
      (write-char end port))

    (define (mask-outputs outputs)
      (map
        (lambda (l)
          (define left (car l))
          (define right (cdr l))
          (cons
            left
            (make-derivation-output
              ""
              (derivation-output-hash right)
              (derivation-output-algo right)
              (derivation-output-recursive right))))
        outputs))

    (define (mask-env env outputs)
      (map
        (lambda (l)
          (if (assoc (car l) outputs)
            (cons (car l) "")
            l))
        env))

    ;; Return a copy of the received `<derivation>`, but with the outputs masked out.
    (define (mask-derivation drv)
      (make-derivation
        (derivation-name drv)
        (mask-outputs (derivation-outputs drv))
        (derivation-input-drvs drv)
        (derivation-input-src drv)
        (derivation-system drv)
        (derivation-builder drv)
        (derivation-args drv)
        (mask-env (derivation-env drv) (derivation-outputs drv))
        (make-derivation-metadata #f #f #f #f #f)))

    ;; Returns whether this `<derivation>` is considered fixed-output by Nix or not.
    (define (drv-is-fod drv)
      (define outs (derivation-outputs drv))
      (define first-output (car outs))
      (define first-output-id (car first-output))
      (define first-output-is-hash (bytevector? (derivation-output-hash (cdr first-output))))
      (and (= (length outs) 1) (string=? first-output-id "out") first-output-is-hash))

    (define (env-pair< left right)
      (string<? (car left) (car right)))

    ;; Calculate the "modulo" contents of a derivation. The modulo hash of a derivation is used in the store paths of the outputs of said derivation.
    (define (modulo-hash-drv-contents drv)
      (cond
        ((drv-is-fod drv)
         (let ((out (cdar (derivation-outputs drv))))
          (string->utf8 (string-append "fixed:out:" (if (derivation-output-recursive out) "r:" "") (derivation-output-algo out) ":" (hex (derivation-output-hash out)) ":" (derivation-output-path out)))))
        (else
         (let ((remapped-input-drvs '())
               (output-port (open-output-bytevector))
               (is-deferred #f))
             ; TODO: this needs to merge output names too (depending on two distinct drvs with the same output hash requires merging their output names.)
             (for-each (lambda (l)
                        (let* ((new-hash (hex (modulo-hash-drv (car l)))))
                              (set! is-deferred (or is-deferred (derivation-metadata-is-deferred (derivation-metadata (car l)))))
                              (unless (assoc new-hash remapped-input-drvs) (set! remapped-input-drvs (cons (cons new-hash (cdr l)) remapped-input-drvs)))))
                       (derivation-input-drvs drv))
             (set! remapped-input-drvs (list-sort env-pair< remapped-input-drvs))
             (derivation-serialize drv output-port remapped-input-drvs)
             (get-output-bytevector output-port)))))

    ;; Modulo-hash a derivation. This returns a hash that will stay the same, as long as the only
    ;; changes made (transitively) are which variant of a fixed-output derivation is used. This is
    ;; what is used in the calculation of the output path of an input-addressed derivation.
    (define (modulo-hash-drv drv)
      (if (eq? (derivation-metadata-modulo-hash (derivation-metadata drv)) #f)
        (let ((hash (sha256 (modulo-hash-drv-contents drv))))
             (set-derivation-metadata-modulo-hash! (derivation-metadata drv) hash)
             hash)
        (derivation-metadata-modulo-hash (derivation-metadata drv))))

    ;; Creates a fixed-output derivation with specified parameters.
    (define (make-fixed-output-derivation name platform input-drvs input-srcs builder env hash-algo hash-value recursive)
      (define output-path (make-fixed-output-path recursive hash-algo hash-value name))
      (define output (make-derivation-output output-path hash-value hash-algo recursive))
      (define new-items `(("out" . ,output-path)))
      (when (%derivation-compatible)
            (set! new-items
                  `(("outputHash" . ,(hex hash-value))
                    ("outputHashAlgo" . ,hash-algo)
                    ("outputHashMode" . ,(if recursive "recursive" "flat"))
                    ("name" . ,name)
                    ("builder" . ,(car builder))
                    ("system" . ,platform)
                    . ,new-items)))
      (define environment (list-sort env-pair< (filter-environment env new-items)))
      (make-derivation name (list (cons "out" output)) input-drvs (list-sort string<? (filter-sources input-srcs)) platform (car builder) (cdr builder) environment (make-derivation-metadata #f #f #f #f #f)))

    (define (sanity-check-drv orig-drv)
      (define tmp-drv (mask-derivation orig-drv))
      (define modulo-hash (modulo-hash-drv tmp-drv))
      (define name (derivation-name orig-drv))
      (for-each
        (lambda (output)
          (unless (string=? (derivation-output-path (cdr output)) (make-output-path "sha256" modulo-hash (car output) name))
            (fprintf (current-error-port) "(failed derivation contents: ~S)\n" (utf8->string (call-with-port (open-output-bytevector) (lambda (p) (derivation-serialize tmp-drv p) (get-output-bytevector p)))))
            (error "Derivation output path mismatch: " (make-output-path "sha256" modulo-hash (car output) name) " vs " (derivation-output-path (cdr output)))))
        (derivation-outputs orig-drv)))

    (define (filter-environment env-list output)
      (for-each (lambda (kv) (unless (assoc (car kv) output string=?) (set! output (cons kv output)))) env-list)
      output)

    (define (filter-sources inputs)
      (define output '())
      (for-each (lambda (out) (unless (member out output string=?) (set! output (cons out output)))) inputs)
      output)

    ;; Creates an input-addressed derivation with specified parameters.
    (define (make-input-addressed-derivation name platform input-drvs input-srcs builder env outputs)
      (define compat-env (if (%derivation-compatible) `(("name" . ,name) ("builder" . ,(car builder)) ("system" . ,platform)) '()))
      (set! input-srcs (list-sort string<? (filter-sources input-srcs)))

      (define tmp-outputs (list-sort env-pair< (map (lambda (l) (cons l (make-derivation-output #f #f #f #f))) outputs)))
      (define tmp-env (list-sort env-pair< (filter-environment env (append compat-env (map (lambda (l) (cons l "")) outputs)))))

      (define tmp-drv (make-derivation name tmp-outputs input-drvs input-srcs platform (car builder) (cdr builder) tmp-env (make-derivation-metadata #f #f #f #f #f)))
      (define modulo-hash (modulo-hash-drv tmp-drv))
      (define is-deferred (derivation-metadata-is-deferred (derivation-metadata tmp-drv)))

      (define new-outputs (list-sort env-pair< (map (lambda (l) (cons l (make-derivation-output
                                                                         (if is-deferred #f (make-output-path "sha256" modulo-hash l name)) #f #f #f))) outputs)))
      (define new-env (list-sort env-pair< (filter-environment env (append compat-env (map (lambda (l) (cons l (make-output-path "sha256" modulo-hash l name))) outputs)))))

      (define drv (make-derivation name new-outputs input-drvs input-srcs platform (car builder) (cdr builder) new-env (make-derivation-metadata #f #f (derivation-metadata-is-deferred (derivation-metadata tmp-drv)) #f #f)))
      (sanity-check-drv drv)
      drv)

    ;; Creates a content-addressed derivation with specified parameters.
    (define (make-ca-derivation name platform input-drvs input-srcs builder nenv noutputs)
      (define compat-env (if (%derivation-compatible) `(("name" . ,name) ("builder" . ,(car builder)) ("system" . ,platform)) '()))

      (define outputs (list-sort env-pair< (map (lambda (l) (cons l (make-derivation-output
                                                                     #f 'floating "sha256" #t))) noutputs)))
      (define env (list-sort env-pair< (filter-environment nenv (append compat-env (map (lambda (l) (cons (car l) (make-placeholder (car l)))) outputs)))))

      (define drv (make-derivation name outputs input-drvs (list-sort string<? (filter-sources input-srcs)) platform (car builder) (cdr builder) env (make-derivation-metadata #f #f #t #f #f)))
      (define pathhash (string-copy (derivation-path drv) (+ 1 (string-length (%store-dir))) (+ 33 (string-length (%store-dir)))))
      (for-each (lambda (pair) (set-derivation-output-path! (cdr pair) (make-upstream-output-placeholder pathhash name (car pair)))) (derivation-outputs drv))
      drv)

    (define (write-derivation-output pair)
      (define output-name (car pair))
      (define output (cdr pair))
      (write-paren-list write-quoted-string
        (list output-name
          (if (member (derivation-output-hash output) '(floating)) "" (or (derivation-output-path output) ""))
          (string-append (if (derivation-output-recursive output) "r:" "") (or (derivation-output-algo output) ""))
          (cond
            ((bytevector? (derivation-output-hash output)) (hex (derivation-output-hash output)))
            ((eq? (derivation-output-hash output) 'floating) "")
            ((not (derivation-output-hash output)) "")
            (else (error "unknown derivation output hash type"))))))

    ;; Returns a sorted list of store paths that the `.drv` file of this derivation depends on.
    (define (derivation-path-references drv)
      (define input-drv-paths (map (lambda (l) (if (string? (car l)) (car l) (derivation-path (car l)))) (derivation-input-drvs drv)))
      (list-sort string<? (append input-drv-paths (derivation-input-src drv))))

    ;; Returns the store path belonging to this derivation's `.drv` file.
    (define (derivation-path drv)
      (if (eq? (derivation-metadata-path (derivation-metadata drv)) #f)
        (let ((drv-output-port (open-output-bytevector)))
             (derivation-serialize drv drv-output-port)
             (define path (make-text-path "sha256" (sha256 (get-output-bytevector drv-output-port)) (string-append (derivation-name drv) ".drv") (derivation-path-references drv)))
             (set-derivation-metadata-path! (derivation-metadata drv) path)
             path)
        (derivation-metadata-path (derivation-metadata drv))))

    ;; Equality comparison for a `<derivation>`. Checks whether the argument represent the same derivation, not just referential equality.
    (define (derivation-equal? left right)
      (define left-cached-path (derivation-metadata-path (derivation-metadata left)))
      (define right-cached-path (derivation-metadata-path (derivation-metadata right)))
      (define left-serialized (derivation-metadata-serialized (derivation-metadata left)))
      (define right-serialized (derivation-metadata-serialized (derivation-metadata right)))

      (or (eqv? left right)
          (and left-cached-path right-cached-path (string=? left-cached-path right-cached-path))
          (and left-serialized right-serialized (eqv? left-serialized right-serialized))
          (and
            (string=? (derivation-name left) (derivation-name right))
            (string=? (derivation-system left) (derivation-system right))
            (string=? (derivation-builder left) (derivation-builder right))
            (equal? (derivation-input-src left) (derivation-input-src right))
            (equal? (derivation-outputs left) (derivation-outputs right))
            (equal? (derivation-args left) (derivation-args right))
            (equal? (derivation-env left) (derivation-env right))
            (and
              (= (length (derivation-input-drvs left)) (length (derivation-input-drvs right)))
              (let ((eq #f))
                (for-each (lambda (l r) (and (equal? (cdr l) (cdr r)) (derivation-equal? (car l) (car r)))) (derivation-input-drvs left) (derivation-input-drvs right)))))))

    (define write-paren-list
      (case-lambda
        ((fn val) (write-delim-list #\( #\) fn val (current-output-port)))
        ((fn val port) (write-delim-list #\( #\) fn val port))))

    (define write-bracket-list
      (case-lambda
        ((fn val) (write-delim-list #\[ #\] fn val (current-output-port)))
        ((fn val port) (write-delim-list #\[ #\] fn val port))))

    (define write-quoted-string
      (case-lambda
        ((val) (write-quoted-string val (current-output-port)))
        ((val port) 
         (write-char #\" port)
         (do
           ((buf (if (string? val) (string->utf8 val) val))
            (start 0)
            (i 0 (+ i 1)))
           ((= i (bytevector-length buf)) (when (or (= start 0) (< start i)) (write-bytevector buf port start i)))
           (define x (bytevector-u8-ref buf i))
           (cond ((= x #x22) (when (< start i) (write-bytevector buf port start i)) (set! start (+ 1 i)) (write-string "\\\"" port))
                 ((= x #x5C) (when (< start i) (write-bytevector buf port start i)) (set! start (+ 1 i)) (write-string "\\\\" port))
                 ((= x #x0A) (when (< start i) (write-bytevector buf port start i)) (set! start (+ 1 i)) (write-string "\\n" port))
                 ((= x #x0D) (when (< start i) (write-bytevector buf port start i)) (set! start (+ 1 i)) (write-string "\\r" port))
                 ((= x #x09) (when (< start i) (write-bytevector buf port start i)) (set! start (+ 1 i)) (write-string "\\t" port))))
         (write-char #\" port))))

    (define (read-static-string strval port)
      (define read-data (read-string (string-length strval) port))
      (unless (string=? read-data strval) (error (string-append "Expected `" strval "', got `" read-data "'"))))

    (define (parse-hash-algo hashstr)
      (cond
        ((< (string-length hashstr) 2) (cons hashstr #f))
        ((string=? (string-copy hashstr 0 2) "r:")
         (cons (string-copy hashstr 2) #t))
        (else (cons hashstr #f))))

    (define (read-paren-list fn port)
      (read-static-string "(" port)
      (do ((tail '())) ((= (peek-u8 port) #x29) (read-u8 port) (reverse tail))
          (set! tail (cons (fn) tail))
          (when (= (peek-u8 port) #x2C) (read-u8 port))))

    (define (read-bracket-list fn port)
      (read-static-string "[" port)
      (do ((tail '())) ((= (peek-u8 port) #x5D) (read-u8 port) (reverse tail))
          (set! tail (cons (fn) tail))
          (when (= (peek-u8 port) #x2C) (read-u8 port))))

    (define (drv-name-from-path path)
      (do ((i 0 (+ i 1)))
          ((or (= i (string-length path)) (char=? (string-ref path i) #\-)) (string-copy path (+ i 1) (- (string-length path) 4)))))

    (define read-drv-paths (mapping (make-default-comparator)))

    ;; Reads a .drv file from the passed in path, and caches it for
    ;; later reuse.
    (define (read-drv-path path)
      (define already-read (mapping-ref/default read-drv-paths path #f))
      (if already-read
          already-read
          (let* ((read-val (call-with-port (open-input-file path) (lambda (port) (derivation-read port (drv-name-from-path path)))))
                 (new-path (derivation-path read-val)))
           (unless (string=? new-path path) (error (string-append "derivation path mismatch: " path " orig, " new-path " new")))
           (unless (drv-is-fod read-val) (sanity-check-drv read-val))
           (set! read-drv-paths (mapping-set! read-drv-paths path read-val))
           read-val)))


    (define (dehex strval)
      (do ((outval (make-bytevector (/ (string-length strval) 2)))
           (i 0 (+ i 1)))
          ((= i (bytevector-length outval)) outval)
          (bytevector-u8-set! outval i (string->number (string-copy strval (* i 2) (* (+ i 1) 2)) 16))))

    (define (read-quoted-string port)
      (read-static-string "\"" port)
      (do ((buf (make-bytevector 32)) (cap 32) (len 0))
          ((= (peek-u8 port) #x22) (read-u8 port) (utf8->string (bytevector-copy buf 0 len)))

          (define val (read-u8 port))
          (when (= val #x5C)
            (set! val (read-u8 port))
            (cond
              ((= val #x6E) (set! val #x0A))
              ((= val #x72) (set! val #x0D))
              ((= val #x74) (set! val #x09))))
          (when (= len cap)
            (let ((newbuf (make-bytevector (* 2 cap))))
                (bytevector-copy! newbuf 0 buf)
                (set! buf newbuf)
                (set! cap (bytevector-length newbuf))))
          (bytevector-u8-set! buf len val)
          (set! len (+ 1 len))))

    ;; Reads a `<derivation>` from the `port`. If `read-drv-path` is set, will be used to read dependencies of this derivation,
    ;; rather than the default of reading from the local Nix store.
    (define derivation-read
      (case-lambda
        ((port name) (derivation-read port name read-drv-path))
        ((port name read-drv)
         (read-static-string "Derive(" port); )
         (define drv-outputs
           (read-bracket-list
             (lambda ()
               (define data (read-paren-list (lambda () (read-quoted-string port)) port))
               (define path (cadr data))
               (define output-name (car data))
               (define hash-algo-recursive (parse-hash-algo (list-ref data 2)))
               (define hash-value-hex (list-ref data 3))
               (if (string=? hash-value-hex "")
                   (cons output-name (make-derivation-output path #f #f #f))
                   (cons output-name (make-derivation-output path (dehex hash-value-hex) (car hash-algo-recursive) (cdr hash-algo-recursive))))) port))
         (read-static-string "," port)
         (define input-drvs
           (read-bracket-list
             (lambda ()
               (read-static-string "(" port)
               (define drv (read-drv (read-quoted-string port)))
               (read-static-string "," port)
               (define outputs (read-bracket-list (lambda () (read-quoted-string port)) port))
               (read-static-string ")" port)
               (cons drv outputs)) port))
         (read-static-string "," port)
         (define input-srcs (read-bracket-list (lambda () (read-quoted-string port)) port))
         (read-static-string "," port)
         (define system (read-quoted-string port))
         (read-static-string "," port)
         (define builder-argv0 (read-quoted-string port))
         (read-static-string "," port)
         (define builder-args (read-bracket-list (lambda () (read-quoted-string port)) port))
         (read-static-string "," port)
         (define environ (read-bracket-list (lambda () (define data (read-paren-list (lambda () (read-quoted-string port)) port)) (cons (car data) (cadr data))) port))
         (read-static-string ")" port)
         (make-derivation name drv-outputs input-drvs input-srcs system builder-argv0 builder-args environ (make-derivation-metadata #f #f #f #f #f)))))

    (define (derivation-serialize-internal drv port masked)
      (parameterize ((current-output-port port))
        (write-string "Derive(")
        (write-bracket-list write-derivation-output (derivation-outputs drv))
        (write-u8 #x2C)
        (write-bracket-list
          (lambda (l)
            (write-u8 #x28)
            (write-quoted-string (if (string? (car l)) (car l) (derivation-path (car l))))
            (write-u8 #x2C)
            (write-bracket-list write-quoted-string (cdr l))
            (write-u8 #x29)) masked)
        (write-u8 #x2C)
        (write-bracket-list write-quoted-string  (derivation-input-src drv))
        (write-u8 #x2C)
        (write-quoted-string (derivation-system drv))
        (write-u8 #x2C)
        (write-quoted-string (derivation-builder drv))
        (write-u8 #x2C)
        (write-bracket-list write-quoted-string (derivation-args drv))
        (write-u8 #x2C)
        (write-bracket-list (lambda (l) (write-paren-list write-quoted-string (list (car l) (cdr l)))) (derivation-env drv))
        (write-u8 #x29)))

    ;; Writes the derivation to the specified port, or `(current-output-port)` if none is supplied.
    ;; If `masked` is set, writes the derivation using it as `input-drvs` value, rather than the one stored in the `<derivation>`.
    ;; This is used for generating the modulo-hashed derivation.
    (define derivation-serialize
      (case-lambda
        ((drv) (derivation-serialize drv (current-output-port)))
        ((drv port)
         (if (derivation-metadata-serialized (derivation-metadata drv))
             (write-bytevector (derivation-metadata-serialized (derivation-metadata drv)) port)
             (call-with-port (open-output-bytevector)
               (lambda (nport)
                 (derivation-serialize-internal drv nport (derivation-input-drvs drv))
                 (set-derivation-metadata-serialized! (derivation-metadata drv) (get-output-bytevector nport))
                 (write-bytevector (get-output-bytevector nport) port)))))
        ((drv port masked)
         (derivation-serialize-internal drv port masked))))))