(use-modules (guix) (gnu packages)
             (guix scripts substitute)
             (guix grafts)
             (guix build utils)
             (srfi srfi-1)
             (ice-9 match)
             (ice-9 threads))

(define test-directory
  "/tmp/substitute-test")

(define packages
  ;; Subset of packages for which we request substitutes.
  (take (fold-packages cons '()) 200))

(define (spawn-substitution-thread input urls)
  "Spawn a 'guix substitute' thread that reads commands from INPUT and uses
URLS as the substitute servers."
  (call-with-new-thread
   (lambda ()
     (parameterize ((%reply-file-descriptor #f)
                    (current-input-port input))
       (setenv "_NIX_OPTIONS"
               (string-append "substitute-urls=" (string-join urls)))
       (let loop ()
         (format (current-error-port) "starting substituter~%")
         ;; Catch "no valid substitute" errors.
         (catch 'quit
           (lambda ()
             (guix-substitute "--substitute"))
           (const #f))
         (unless (eof-object? (peek-char input))
           (loop)))))))

(match (pipe)
  ((input . output)
   (let ((thread (spawn-substitution-thread input
                                            %default-substitute-urls)))
     ;; Remove the test directory.
     (when (file-exists? test-directory)
       (for-each make-file-writable
                 (find-files test-directory #:directories? #t))
       (delete-file-recursively test-directory))
     (mkdir-p test-directory)

     (parameterize ((%graft? #false))
       (with-store store
         ;; Ask for substitutes for PACKAGES.
         (for-each (lambda (package n)
                     (define item
                       (run-with-store store
                         (package-file package)))

                     (format output "substitute ~a ~a/~a~%"
                             item test-directory n))
                   packages
                   (iota (length packages))))
       (format #t "sent ~a substitution requests...~%"
               (length packages))
       (close-port output)

       ;; Wait for substitution to complete.
       (join-thread thread)))))