guix: channels: Introduce "channel-with-substitutes-available".

* guix/channels.scm (find-latest-commit-with-substitutes,
channel-with-substitutes-available): New procedures.
* guix/scripts/pull.scm (guix-pull): Move "channel-list" call inside the
%current-system parameter scope.
* doc/guix.texi (Channels with substitutes): New section.

3 files changed, 90 insertions, 52 deletions

diff --git a/guix/channels.scm b/guix/channels.scm
index 0c84eed477..9ab8cd8749 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -20,6 +20,7 @@
 
 (define-module (guix channels)
   #:use-module (git)
+  #:use-module (guix ci)
   #:use-module (guix git)
   #:use-module (guix git-authenticate)
   #:use-module ((guix openpgp)
diff --git a/guix/ci.scm b/guix/ci.scm
index f429bf198f..95325b4bfe 100644
--- a/guix/ci.scm
+++ b/guix/ci.scm
@@ -19,9 +19,11 @@
 
 (define-module (guix ci)
   #:use-module (guix http-client)
+  #:use-module (guix utils)
   #:use-module (json)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
+  #:autoload   (guix channels) (channel)
   #:export (build-product?
             build-product-id
             build-product-type
@@ -52,7 +54,9 @@
             latest-builds
             evaluation
             latest-evaluations
-            evaluations-for-commit))
+            evaluations-for-commit
+
+            channel-with-substitutes-available))
 
 ;;; Commentary:
 ;;;
@@ -165,3 +169,35 @@ as one of their inputs."
                     (string=? (checkout-commit checkout) commit))
                   (evaluation-checkouts evaluation)))
           (latest-evaluations url limit)))
+
+(define (find-latest-commit-with-substitutes url)
+  "Return the latest commit with available substitutes for the Guix package
+definitions at URL.  Return false if no commit were found."
+  (let* ((job-name (string-append "guix." (%current-system)))
+         (build (match (latest-builds url 1
+                                      #:job job-name
+                                      #:status 0) ;success
+                  ((build) build)
+                  (_ #f)))
+         (evaluation (and build
+                          (evaluation url (build-evaluation build))))
+         (commit (and evaluation
+                      (match (evaluation-checkouts evaluation)
+                        ((checkout)
+                         (checkout-commit checkout))))))
+    commit))
+
+(define (channel-with-substitutes-available chan url)
+  "Return a channel inheriting from CHAN but which commit field is set to the
+latest commit with available substitutes for the Guix package definitions at
+URL.  The current system is taken into account.
+
+If no commit with available substitutes were found, the commit field is set to
+false and a warning message is printed."
+  (let ((commit (find-latest-commit-with-substitutes url)))
+    (unless commit
+      (warning (G_ "could not find available substitutes at ~a~%")
+               url))
+    (channel
+     (inherit chan)
+     (commit commit))))
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 83cdc1d1eb..4e0ab5d341 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -765,60 +765,61 @@ Use '~/.config/guix/channels.scm' instead."))
                                               #:argument-handler no-arguments))
             (substitutes? (assoc-ref opts 'substitutes?))
             (dry-run?     (assoc-ref opts 'dry-run?))
-            (channels     (channel-list opts))
             (profile      (or (assoc-ref opts 'profile) %current-profile))
             (current-channels (profile-channels profile))
             (validate-pull    (assoc-ref opts 'validate-pull))
             (authenticate?    (assoc-ref opts 'authenticate-channels?)))
-       (cond ((assoc-ref opts 'query)
-              (process-query opts profile))
-             ((assoc-ref opts 'generation)
-              (process-generation-change opts profile))
-             (else
-              (with-store store
-                (with-status-verbosity (assoc-ref opts 'verbosity)
-                  (parameterize ((%current-system (assoc-ref opts 'system))
-                                 (%graft? (assoc-ref opts 'graft?)))
-                    (with-build-handler (build-notifier #:use-substitutes?
-                                                        substitutes?
-                                                        #:verbosity
-                                                        (assoc-ref opts 'verbosity)
-                                                        #:dry-run? dry-run?)
-                      (set-build-options-from-command-line store opts)
-                      (ensure-default-profile)
-                      (honor-x509-certificates store)
-
-                      (let ((instances
-                             (latest-channel-instances store channels
-                                                       #:current-channels
-                                                       current-channels
-                                                       #:validate-pull
-                                                       validate-pull
-                                                       #:authenticate?
-                                                       authenticate?)))
-                        (format (current-error-port)
-                                (N_ "Building from this channel:~%"
-                                    "Building from these channels:~%"
-                                    (length instances)))
-                        (for-each (lambda (instance)
-                                    (let ((channel
-                                           (channel-instance-channel instance)))
-                                      (format (current-error-port)
-                                              "  ~10a~a\t~a~%"
-                                              (channel-name channel)
-                                              (channel-url channel)
-                                              (string-take
-                                               (channel-instance-commit instance)
-                                               7))))
-                                  instances)
-                        (parameterize ((%guile-for-build
-                                        (package-derivation
-                                         store
-                                         (if (assoc-ref opts 'bootstrap?)
-                                             %bootstrap-guile
-                                             (default-guile)))))
-                          (with-profile-lock profile
-                            (run-with-store store
-                              (build-and-install instances profile)))))))))))))))
+       (cond
+        ((assoc-ref opts 'query)
+         (process-query opts profile))
+        ((assoc-ref opts 'generation)
+         (process-generation-change opts profile))
+        (else
+         (with-store store
+           (with-status-verbosity (assoc-ref opts 'verbosity)
+             (parameterize ((%current-system (assoc-ref opts 'system))
+                            (%graft? (assoc-ref opts 'graft?)))
+               (with-build-handler (build-notifier #:use-substitutes?
+                                                   substitutes?
+                                                   #:verbosity
+                                                   (assoc-ref opts 'verbosity)
+                                                   #:dry-run? dry-run?)
+                 (set-build-options-from-command-line store opts)
+                 (ensure-default-profile)
+                 (honor-x509-certificates store)
+
+                 (let* ((channels (channel-list opts))
+                        (instances
+                         (latest-channel-instances store channels
+                                                   #:current-channels
+                                                   current-channels
+                                                   #:validate-pull
+                                                   validate-pull
+                                                   #:authenticate?
+                                                   authenticate?)))
+                   (format (current-error-port)
+                           (N_ "Building from this channel:~%"
+                               "Building from these channels:~%"
+                               (length instances)))
+                   (for-each (lambda (instance)
+                               (let ((channel
+                                      (channel-instance-channel instance)))
+                                 (format (current-error-port)
+                                         "  ~10a~a\t~a~%"
+                                         (channel-name channel)
+                                         (channel-url channel)
+                                         (string-take
+                                          (channel-instance-commit instance)
+                                          7))))
+                             instances)
+                   (parameterize ((%guile-for-build
+                                   (package-derivation
+                                    store
+                                    (if (assoc-ref opts 'bootstrap?)
+                                        %bootstrap-guile
+                                        (default-guile)))))
+                     (with-profile-lock profile
+                       (run-with-store store
+                         (build-and-install instances profile)))))))))))))))
 
 ;;; pull.scm ends here