From d399f8dbb9e38a82241b9048b8b04758fae10005 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Mon, 7 Dec 2020 16:12:22 +0100
Subject: [PATCH] scripts: pull: Add "with-substitutes" option.

---
 guix/scripts/pull.scm | 38 +++++++++++++++++++++++++++++++++++---
 1 file changed, 35 insertions(+), 3 deletions(-)

diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 83cdc1d1eb..4609f8614e 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2013, 2014, 2015, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +21,7 @@
 
 (define-module (guix scripts pull)
   #:use-module ((guix ui) #:hide (display-profile-content))
+  #:use-module (guix ci)
   #:use-module (guix colors)
   #:use-module (guix utils)
   #:use-module ((guix status) #:select (with-status-verbosity))
@@ -64,6 +66,7 @@
   #:re-export (display-profile-content
                channel-commit-hyperlink)
   #:export (channel-list
+            find-lastest-commit-with-substitutes
             guix-pull))
 
 
@@ -169,6 +172,9 @@ Download and deploy the latest version of Guix.\n"))
                  (lambda (opt name arg result)
                    (alist-cons 'validate-pull warn-about-backward-updates
                                result)))
+         (option '("with-substitutes") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'with-substitutes? #t result)))
          (option '("disable-authentication") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'authenticate-channels? #f result)))
@@ -526,6 +532,26 @@ true, display what would be built without actually building it."
           (leave (G_ "while creating symlink '~a': ~a~%")
                  link (strerror (system-error-errno args))))))))
 
+
+;;;
+;;; Substitutes.
+;;;
+
+(define (find-lastest-commit-with-substitutes)
+  (let ((urls %default-substitute-urls))
+    (any (lambda (url)
+           (let* ((build (match (latest-builds url 1
+                                               #:job "guix.x86_64-linux"
+                                               #:status 0) ;success
+                           ((build) build)))
+                  (evaluation (evaluation url
+                                          (build-evaluation build)))
+                  (commit (match (evaluation-checkouts evaluation)
+                            ((checkout)
+                             (checkout-commit checkout)))))
+             commit))
+         urls)))
+
 
 ;;;
 ;;; Queries.
@@ -731,8 +757,9 @@ Use '~/.config/guix/channels.scm' instead."))
 
   (let ((ref (assoc-ref opts 'ref))
         (url (or (assoc-ref opts 'repository-url)
-                 (environment-variable))))
-    (if (or ref url)
+                 (environment-variable)))
+        (with-substitutes? (assoc-ref opts 'with-substitutes?)))
+    (if (or ref url with-substitutes?)
         (match (find guix-channel? channels)
           ((? channel? guix)
            ;; Apply '--url', '--commit', and '--branch' to the 'guix' channel.
@@ -745,7 +772,12 @@ Use '~/.config/guix/channels.scm' instead."))
                       (channel (inherit guix)
                                (url url) (commit #f) (branch branch)))
                      (#f
-                      (channel (inherit guix) (url url))))
+                      (let ((commit
+                             (and with-substitutes?
+                                  (find-lastest-commit-with-substitutes))))
+                        (channel (inherit guix)
+                                 (url url)
+                                 (commit commit)))))
                    (remove guix-channel? channels))))
           (#f                           ;no 'guix' channel, failure will ensue
            channels))
-- 
2.29.2