[bug#45104] pull: Add a "with-substitutes" option.

[Mathieu Othacehe <othacehe@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 397 bytes --]


Hello,

When "guix pull" is run before the CI server is done baking substitutes,
the user may need to build some derivations, which can be long on
low-end hardware.

This patch adds an option to "guix pull" so that it updates to the
latest commit with available substitutes.

This work is still in progress, but I'd like to gather some impressions
on that before going further.

Thanks,

Mathieu

[-- Attachment #2: 0001-scripts-pull-Add-with-substitutes-option.patch --]
[-- Type: text/x-diff, Size: 4196 bytes --]

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))
 
 \f
@@ -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))))))))
 
+\f
+;;;
+;;; 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)))
+
 \f
 ;;;
 ;;; 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