guix-jupyter-kernel.scm

;;; Guix-kernel -- Guix kernel for Jupyter
;;; Copyright (C) 2018 Evgeny Panfilov <epanfilov@gmail.com>
;;; Copyright (C) 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;; Copyright (C) 2018, 2019, 2020, 2021 Inria
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(use-modules (json parser)
             (json builder)
             (simple-zmq)
             (git)                                ;for 'git-error-message'
	     (srfi srfi-1)
             (srfi srfi-13)
             (srfi srfi-19)
             (srfi srfi-26)
             (srfi srfi-34)
             (srfi srfi-71)
             (rnrs bytevectors)
             (ice-9 match)
             (texinfo)
             (texinfo html)
             (guix build syscalls)
             (guix gexp)
             (guix store)
             (guix channels)
             (guix download)
             (guix derivations)
             (guix inferior)
             (guix monads)
             (guix profiles)
             ((guix i18n) #:select (P_))
             (gcrypt base16)
             (gcrypt hash)
             (jupyter messages)
             (jupyter kernels)
             (jupyter servers)
             (jupyter guile)
             (guix jupyter logging)
             (guix jupyter proxy)
             (guix jupyter kernel)
             (guix jupyter environment))

;;
;; Container tools.
;;

(define container-context (zmq-create-context))

(define %store-property
  ;; Key used to access the <store-connection> in <proxy-state>.
  (list 'store 'property))

(define (proxy-state-store state)
  "Return the <store-connection> associated with STATE."
  (proxy-state-property state %store-property))

(define %default-environment-property
  ;; Key used to access the name of the default environment.
  (list 'environment 'property))

(define (proxy-state-default-environment state)
  "Return the name of the default execution environment or #f."
  (proxy-state-property state %default-environment-property))

(define (set-proxy-state-default-environment state name)
  "Use NAME as the default environment."
  (set-proxy-state-property state %default-environment-property
                            name))

(define %inferior-property
  ;; Property to access the inferior associated with this proxy.
  (list 'inferior 'property))

(define (proxy-state-inferior state)
  "Return the inferior associated with STATE, or #f if there is none."
  (proxy-state-property state %inferior-property))

(define (set-proxy-state-inferior state inferior)
  "Associate STATE with INFERIOR and return the new proxy state.  If there
was already an inferior associated with STATE, close it."
  (let ((previous (proxy-state-inferior state)))
    (when previous
      ;; XXX: 'close-inferior' sometimes isn't enough and it ends up being
      ;; blocked in waitpid(2) (from 'close-pipe') while the inferior is
      ;; stuck in read(2).  Thus, forcefully terminate PREVIOUS beforehand.
      ;; This leads to an 'inferior-eval' exception because the inferior
      ;; doesn't respond, which we catch.
      (false-if-exception
       (inferior-eval '(primitive-exit 0) previous))

      (close-inferior previous))

    (set-proxy-state-property state %inferior-property
                              inferior)))

(define (ensure-proxy-state-inferior state)
  "Return a new state based on STATE that has an associated inferior."
  (if (proxy-state-inferior state)
      state
      (set-proxy-state-inferior state (open-default-inferior))))

;;
;; Handlers.
;;

;; Unknown request type, ignore it.
(define (ignore-request kernel kind message state)
  state)

;; Send kernel-info.
(define (reply-kernel-info-request kernel kind message state)
  (let ((body (scm->json-string
               (kernel-info-reply->json %kernel-info-reply))))
    (send-message kernel (reply message "kernel_info_reply" body))

    ;; Send an IOPub message as expected by Notebook 6.3.0 (failing to do
    ;; that, it "nudges" the kernel by re-sending "kernel_info_request"
    ;; messages).
    (pub-idle kernel message))
  state)

(define (manifest->shtml manifest name)
  "Return SHTML representing the contents of MANIFEST."
  `(div
    (h3 (@ (style "color: green;"))
        "Preparing environment " (tt ,name) " with these packages:")
    (ul ,@(map (lambda (entry)
                 `(li (tt ,(manifest-entry-name entry)
                          " " ,(manifest-entry-version entry))))
               (manifest-entries manifest)))))

(define* (reply-for-environment kernel message
                                #:key name manifest (count 0))
  "Send KERNEL a reply to MESSAGE saying that we're preparing environment
NAME with MANIFEST."
  (reply-shtml kernel message
               (manifest->shtml manifest name)
               count))

(define* (reply-for-environment-kernel kernel message
                                       #:key name specs (count 0))
  "Send KERNEL a reply to MESSAGE saying that we found the kernel SPECS."
  (send-message kernel
                (reply message "execute_result"
                       (scm->json-string
                        `(("data"     .
                           (("text/html"
                             . ,(sxml->xml-string
                                 `(div
                                   "Running "
                                   ,(kernel-specs-display-name specs)
                                   " kernel.")))))
                          ("metadata" . ())
                          ("execution_count" . ,count))))
                #:kernel-socket kernel-iopub))

(define (channels->shtml channels)
  "Return SHTML representing CHANNELS."
  `(p (table
       ,@(map (lambda (channel)
                `(tr (tc (a (@ (href ,(channel-url channel)))
                            (code ,(channel-name channel))))
                     (tc (code ,(if (channel-commit channel)
                                    (channel-commit-hyperlink channel)
                                    (channel-branch channel))))))
              channels))))

(define* (reply-for-channels kernel message channels
                             #:key profile (count 0))
  "Reply to MESSAGE, which comes from KERNEL, that we successfully switched
to CHANNELS in PROFILE."
  (let ((instances (if profile
                       (match (profile-channels profile)
                         (()  channels)
                         (lst lst))
                       channels)))
    (reply-shtml kernel message
                 `(div
                   (bold "Switched to these Guix channels:")
                   ,(channels->shtml instances))
                 count)))

(define* (search-inferior-packages inferior patterns
                                   #:key (max-results 20))
  "Return the list of name/version/synopsis tuples for the most relevant
packages matching PATTERNS, a list of string (possibly regexps).  Return at
most MAX-RESULTS elements."
  ;; Perform search in the inferior to reduce communication between the host
  ;; and the inferior, and to avoid allocating memory on both sides.
  (inferior-eval
   `(begin
      (use-modules ((guix ui) #:select (package-relevance))
                   (ice-9 regex)
                   (ice-9 match)
                   (srfi srfi-1)
                   (srfi srfi-26))

      (define regexps
        (map (cut make-regexp <> regexp/icase) ',patterns))

      (define (find-packages-by-description regexps)
        ;; XXX: Copied from (guix scripts package).
        (let ((matches (fold-packages
                        (lambda (package result)
                          (if (package-superseded package)
                              result
                              (match (package-relevance package regexps)
                                ((? zero?) result)
                                (score
                                 (cons (cons package score) result)))))
                        '())))
          (sort matches
                (lambda (m1 m2)
                  (match m1
                    ((package1 . score1)
                     (match m2
                       ((package2 . score2)
                        (if (= score1 score2)
                            (string>? (package-full-name package1)
                                      (package-full-name package2))
                            (> score1 score2))))))))))

      (let ((lst (find-packages-by-description regexps)))
        (map (match-lambda
               ((package . score)
                (list (package-name package) (package-version package)
                      (package-synopsis package))))
             (if (> (length lst) ,max-results)
                 (take lst ,max-results)
                 lst))))
   inferior))

(define* (reply-search-results kernel message inferior patterns
                               #:key (count 0))
  "Send to KERNEL a reply to MESSAGE showing search results for PATTERNS, a
list of regular expressions (strings)."
  (define (url package)
    (string-append "https://hpc.guix.info/package/" package))

  (define (ref package)
    `(a (@ (href ,(url package))) ,package))

  (define (synopsis->shtml synopsis)
    ;; 'texi-fragment->stexi' uses 'call-with-input-string', so make sure
    ;; those string ports are Unicode-capable.
    (with-fluids ((%default-port-encoding "UTF-8"))
      (and=> synopsis
             (compose stexi->shtml texi-fragment->stexi P_))))

  (catch 'regular-expression-syntax
    (lambda ()
      ;; Ensure PATTERNS are valid regexps.
      (for-each (cut make-regexp <> regexp/icase) patterns)

      (let ((lst (search-inferior-packages inferior patterns)))
        (reply-shtml kernel message
                     `(p (table
                          ,@(map (match-lambda
                                   ((name version synopsis)
                                    `(tr (td ,(ref name)) (td ,version)
                                         (td ,(synopsis->shtml synopsis)))))
                                 lst)))
                     count)))
    (lambda (key . args)
      (reply-shtml kernel message
                   `(div (@ (class "ansi-red-fg"))
                         "Invalid regular expression.")
                   count))))

(define* (reply-channel-description kernel message inferior
                                    #:key (count 0))
  "Reply to MESSAGE, which comes from KERNEL, with a description of the
channels currently used by INFERIOR."
  (let* ((profile  (inferior-eval '(begin
                                     (use-modules (guix describe))
                                     (current-profile))
                                  inferior))
         (channels (profile-channels profile)))
    (reply-shtml kernel message
                 `(div
                   (bold "Using these Guix channels:")
                   ,(channels->shtml channels))
                 count)))

(define* (reply-for-channel-failure kernel message channels error
                                    #:key (count 0))
  "Send KERNEL a reply saying we failed to switch to CHANNELS."
  (reply-shtml kernel message
               (string-append "Failed to switch to channels: "
                              (git-error-message error) ".")
               count))

(define (link/copy source target)
  "Make the file SOURCE available as TARGET, either by creating a hard link
or otherwise by copying it.  If TARGET already exists, delete it."
  (catch 'system-error
    (lambda ()
      (link source target))
    (lambda args
      (cond ((= EXDEV (system-error-errno args))
             (copy-file source target)
             (utime target 1 1 1 1))
            ((= EEXIST (system-error-errno args))
             (delete-file target)
             (link/copy source target))
            (else
             (apply throw args))))))

(define* (handle-download kernel kind message state
                          #:key
                          url (hash-algo "sha256") hash
                          (file (basename url)))
  "Handle a request to download FILE from URL, which should have the given
HASH of type HASH-ALGO."
  (define algo
    (lookup-hash-algorithm (string->symbol hash-algo)))

  (define hash/bv
    (false-if-exception (base16-string->bytevector hash)))

  (define count
    (proxy-state-execution-count state))

  (cond ((not algo)
         (reply-shtml kernel message
                      `(bold "Unknown hash algorithm.")
                      count)
         state)
        ((not hash/bv)
         (reply-shtml kernel message
                      `(bold "Invalid hexadecimal string.")
                      count)
         state)
        ((not (= (bytevector-length hash/bv) (hash-size algo)))
         (reply-shtml kernel message
                      '(bold "Invalid hash length.")
                      count)
         state)
        ((not (proxy-state-default-environment state))
         (reply-shtml kernel message
                      '(bold "No current environment to download to.")
                      count))
        (else
         (guard (c ((store-protocol-error? c)
                    (reply-shtml kernel message
                                 `(bold ,(store-protocol-error-message c))
                                 count)
                    state))
           (format/log "downloading from '~a'...~%" url)
           (let* ((store       (proxy-state-store state))
                  (item        (run-with-store store
                                 (mlet %store-monad
                                     ((drv (url-fetch url (string->symbol hash-algo)
                                                      hash/bv file)))
                                   (if (derivation? drv)
                                       (mbegin %store-monad
                                         (built-derivations (list drv))
                                         (return
                                          (derivation->output-path drv)))
                                       (return drv))))) ;plain file
                  (environment (proxy-state-default-environment state))
                  (target      (lookup-proxied environment state))
                  (home        (assq-ref (kernel-properties target) 'home)))
             (format/log "copying '~a' to '~a/~a'~%"
                         item home file)
             (link/copy item (string-append home "/" file))
             (reply-shtml kernel message
                          `(bold "File " (code ,file)
                                 " from "
                                 (a (@ (href ,url)) ,url)
                                 " is now available in environment "
                                 (code ,environment) ".")
                          count)
             (increment-execution-count state))))))

(define* (create-environment name specs state
                             #:key kernel message)
  "Spawn a new execution environment called NAME and containing SPECS, a list
of package specifications such as \"guile@2.2\".  Send appropriate messages
to KERNEL as a reply to MESSAGE, and return STATE suitably adjusted."
  (define manifest
    (specifications->manifest (proxy-state-inferior state)
                              specs))

  (define store
    (proxy-state-store state))

  (define counter
    (proxy-state-execution-count state))

  (format/log "creating new environment ~s~%" name)

  ;; Reply right away without waiting for the profile to be built.
  (reply-for-environment kernel message
                         #:name name
                         #:manifest manifest
                         #:count counter)

  (let ((profile (with-build-progress-report kernel message
                   (run-with-store store
                     (mlet %store-monad ((drv (profile-derivation manifest)))
                       (mbegin %store-monad
                         (built-derivations (list drv)) ;XXX: somewhat ugly
                         (return drv)))))))
    (match (available-kernel-specs (derivation->output-path profile)
                                   (list (string-append
                                          (derivation->output-path profile)
                                          "/share/jupyter")))
      ((specs)
       (let* ((container (run-with-store store
                           (spawn-kernel/container container-context
                                                   profile)))
              (state     (register-proxied name container state)))
         (monitor-client container)
         (reply-for-environment-kernel kernel message
                                       #:name name
                                       #:specs specs
                                       #:count counter)
         (set-proxy-state-default-environment (increment-execution-count state)
                                              name)))
      (()
       (reply-shtml kernel message
                    `(bold "No kernel found in environment "
                           (code ,name) "!")
                    counter)
       ;; TODO: Send "error".
       state)
      ((lst ...)
       (reply-shtml kernel message
                    `(div
                      (bold "Found " ,(length lst)
                            " kernels in environment "
                            (code ,name) ":")
                      (ul ,@(map (lambda (specs)
                                   `(li ,(kernel-specs-display-name specs)))
                                 lst))
                      "Which one should we use?  Please create an "
                      "environment containing exactly one kernel.")
                    counter)
       ;; TODO: Send "error".
       state))))


(define (execute-request-sans-magic message)
  "Return MESSAGE, an 'execute_request' message, with its \";;guix\" magic
stripped."
  (let* ((content  (json-string->scm (message-content message)))
         (code     (assoc-ref content "code"))
         (stripped (string-drop code
                                (or (string-index code #\newline)
                                    (string-length code)))))
    (set-message-content message
                         (scm->json-string
                          `(("code" . ,stripped)
                            ,@(alist-delete "code" content))))))

(define (reply-execute-request kernel kind message state)
  (let* ((request (json->execute-request (message-content message)))
         (code    (execute-request-code request))
         (line    (string-take code
                               (or (string-index code #\newline)
                                   (string-length code))))
         (count   (proxy-state-execution-count state)))
    (pub-busy kernel message)
    (match (string-tokenize line)
      ((";;guix" "environment" name "<-" specs ...)
       (guard (c ((package-not-found-error? c)
                  (let ((package (package-not-found-error-name c)))
                    (reply-shtml kernel message
                                 `(div (@ (class "ansi-red-fg"))
                                       "Package " (code ,package)
                                       " not found.")
                                count))
                  state)
                 ((output-not-found-error? c)
                  (let ((output  (output-not-found-error-output c))
                        (package (output-not-found-error-package c)))
                    (reply-shtml kernel message
                                 `(div (@ (class "ansi-red-fg"))
                                       "Output " (code ,output)
                                       " of package " (code ,package)
                                       " not found.")
                                 count)
                    state))
                 ((store-protocol-error? c)
                  (let ((string (store-protocol-error-message c)))
                    (reply-shtml kernel message
                                 `(div (@ (class "ansi-red-fg"))
                                       "Error: " ,string)
                                 count)
                    state)))
         (let ((state (ensure-proxy-state-inferior state)))
           (match (lookup-proxied name state)
             (#f
              (create-environment name specs state
                                  #:kernel kernel
                                  #:message message))
             ((? kernel? proxy)
              (format/log "terminating existing '~a' environment~%"
                          name)
              (unmonitor-client proxy)
              (terminate-proxied-kernel proxy)
              (create-environment name specs
                                  (unregister-proxied name state)
                                  #:kernel kernel
                                  #:message message))))))
      ((";;guix" "environment" name)
       (match (lookup-proxied name state)
         (#f
          (reply-shtml kernel message
                       `(bold "Unknown environment " (code ,name) ".")
                       count)
          (increment-execution-count state))
         ((? kernel? proxy)
          (format/log "evaluating code in container ~s (PID ~s)~%"
                      name (kernel-pid proxy))
          (send-message proxy (execute-request-sans-magic message))
          (let ((state (increment-execution-count state)))
            (set-proxy-state-default-environment state name)))))
      ((";;guix" "search" patterns ...)
       (let* ((state    (ensure-proxy-state-inferior state))
              (inferior (proxy-state-inferior state)))
         (reply-search-results kernel message inferior patterns
                               #:count count)
         (increment-execution-count state)))
      ((";;guix" "describe")
       (let* ((state    (ensure-proxy-state-inferior state))
              (inferior (proxy-state-inferior state)))
         (reply-channel-description kernel message
                                    (proxy-state-inferior state)
                                    #:count count)
         (increment-execution-count state)))
      ((";;guix" "pin" commit)
       (let ((count    (proxy-state-execution-count state))
             (channels (map (lambda (ch)
                              (if (guix-channel? ch)
                                  (channel (inherit ch)
                                           (commit commit))
                                  ch))
                            %default-channels)))
         (format/log "pinning to these channels: ~s~%" channels)
         (catch 'git-error
           (lambda ()
             (let* ((store    (proxy-state-store state))
                    (profile  (with-build-progress-report kernel message
                                (cached-channel-instance store channels)))
                    (inferior (open-inferior profile)))
               (reply-for-channels kernel message channels
                                   #:profile profile
                                   #:count count)
               (set-proxy-state-inferior (increment-execution-count state)
                                         inferior)))
           (lambda (key error . rest)
             (reply-for-channel-failure kernel message channels error
                                        #:count count)
             state))))
      ((";;guix" "download" url hash)
       (handle-download kernel kind message state
                        #:url url #:hash hash))
      ((";;guix" "download" url algo hash)
       (handle-download kernel kind message state
                        #:url url #:hash-algo algo #:hash hash))
      ((";;guix" "download" url algo hash "->" file)
       (handle-download kernel kind message state
                        #:url url #:hash-algo algo #:hash hash
                        #:file file))
      ((";;guix" _ ...)
       (reply-shtml kernel message
                    `(bold "Invalid " (code "guix") " magic.")
                    count)
       (increment-execution-count state))
      (_
       (match (proxy-state-default-environment state)
         ((? string? environment)
          (let ((proxied (lookup-proxied environment state)))
            (format/log "evaluating code in environment ~s (PID ~s)~%"
                        environment (kernel-pid proxied))
            (send-message proxied message #:kernel-socket kind)
            (increment-execution-count state)))
         (#f
          (reply-shtml kernel message
                       `(div "You have not selected an execution environment
yet.  You can create one by entering a “magic command” in a cell as follows:"
                             (p (code ";;guix environment my-environment <- \
python-ipykernel"))
                             "Subsequent cells will be executed by the "
                             "IPython kernel in this environment.")
                       count)
          state))))))

(define (environment-from-magic line)
  (match (string-tokenize line)
    ((";;guix" "environment" name) name)
    (_ #f)))

(define %magic-commands
  ;; The ";;guix" magic commands.
  '("describe" "download" "environment" "pin" "search"))

(define (reply-complete-request kernel kind message state)
  "Reply to a \"complete_request\" message--i.e., a completion request.
Return STATE."
  (define (send-completion-reply matches start end)
    (format/log "sending completion reply with ~a matches~%"
                (length matches))
    (send-message kernel
                  (reply message "complete_reply"
                         (scm->json-string
                          `(("matches" . ,(list->vector matches))
                            ("cursor_start" . ,start)
                            ("cursor_end" . ,end)
                            ("metadata" . ())
                            ("status" . "ok"))))
                  #:recipient (message-sender message)))

  (let* ((content   (json-string->scm (message-content message)))
         (code      (assoc-ref content "code"))
         (cursor    (assoc-ref content "cursor_pos"))
         (line-end  (or (string-index code #\newline)
                        (string-length code)))
         (first     (string-take code line-end)))
    (if (and (string-prefix? ";;guix" (string-trim first))
             (<= cursor line-end))

        ;; This is a completion request on a ";;guix" magic.
        (match (string-split (string-take first cursor) #\space)
          ((";;guix" command)
           (send-completion-reply (filter (cut string-prefix? command <>)
                                          %magic-commands)
                                  (- cursor (string-length command))
                                  cursor)
           state)
          ((";;guix" "environment" prefix)
           (match (proxy-state-proxied state)
             (((names . _) ...)
              (send-completion-reply (filter (cut string-prefix? prefix <>)
                                             names)
                                     (- cursor (string-length prefix))
                                     cursor)
              state)))
          ((";;guix" "environment" _ "<-" _ ... prefix)
           (let* ((state    (ensure-proxy-state-inferior state))
                  (inferior (proxy-state-inferior state)))
             (match (inferior-available-packages inferior)
               (((names . _) ...)
                (send-completion-reply (filter (cut string-prefix? prefix <>)
                                               names)
                                       (- cursor (string-length prefix))
                                       cursor)))
             state))
          (_
           (format/log "ignoring completion request~%")
           state))

        ;; Pass the completion request to one of the proxied kernels.
        (match (or (environment-from-magic first)
                   (proxy-state-default-environment state))
          ((? string? environment)
           (let ((proxied (lookup-proxied environment state)))
             (format/log "forwarding completion request to \
environment ~s (PID ~s)~%"
                         environment (kernel-pid proxied))
             (send-message proxied message #:kernel-socket kind)
             state))
          (#f
           (format/log "unknown target kernel for completion request~%")
           state)))))

(define (reply-inspect-request kernel kind message state)
  "Handle MESSAGE, an \"inspect_request\" message, possibly by forwarding it
to a proxied kernel.  Return STATE."
  (let* ((request   (json->inspect-request (message-content message)))
         (code      (inspect-request-code request))
         (cursor    (inspect-request-cursor-position request))
         (line-end  (or (string-index code #\newline)
                        (string-length code)))
         (first     (string-take code line-end)))
    (if (and (string-prefix? ";;guix" (string-trim first))
             (<= cursor line-end))
        (begin
          (format/log "ignoring inspection request on magic line~%")
          (send-message kernel
                        (reply message "inspect_reply"
                               (scm->json-string
                                (inspect-reply->json
                                 (inspect-reply (status 'ok) (found? #f)))))))

        ;; Pass the completion request to one of the proxied kernels.
        (match (or (environment-from-magic first)
                   (proxy-state-default-environment state))
          ((? string? environment)
           (let ((proxied (lookup-proxied environment state)))
             (format/log "forwarding inspection request to \
environment ~s (PID ~s)~%"
                         environment (kernel-pid proxied))
             (send-message proxied message #:kernel-socket kind)))
          (#f
           (format/log "unknown target kernel for completion request~%"))))
    state))

(define (shutdown kernel kind message state)
  (format/log "shutting down ~a containers~%"
              (proxy-state-proxied-number state))
  (leave-server-loop (terminate-proxied-kernels message state)))

;;
;; Dispatch route.
;;

(define dispatch-route
  `(("kernel_info_request" . ,reply-kernel-info-request)
    ("execute_request"     . ,reply-execute-request)
    ("shutdown_request"    . ,shutdown)
    ("complete_request"    . ,reply-complete-request)
    ("inspect_request"     . ,reply-inspect-request)
    ("comm_info_request"   . ,ignore-request)))

;;
;; Run.
;;


(define (exit-handler kernel)
  (lambda _
    (close-kernel kernel)
    (exit 1)))

;; Start!
(let ((kernel (call-with-input-file (car (last-pair (command-line)))
                connection-file->kernel)))
  (sigaction SIGTERM (exit-handler kernel))
  (sigaction SIGINT  (exit-handler kernel))

  (setvbuf (current-output-port) 'line)
  (setvbuf (current-error-port) 'line)

  (format/log "Guix kernel started (PID ~a)~%" (getpid))
  (with-store store
    ;; Enable "build traces" so we can use (guix status) to track build and
    ;; download events.
    (set-build-options store
                       #:print-build-trace #t
                       #:print-extended-build-trace? #t
                       #:multiplexed-build-output? #t)

    (serve-kernels (list kernel)
                   (proxy-request-handler dispatch-route)
                   (set-proxy-state-property (proxy-state kernel)
                                             %store-property store))))

;; Local Variables:
;; eval: (put 'with-build-progress-report 'scheme-indent-function 2)
;; End: