transformations: Add '--with-latest'.

* guix/upstream.scm (upstream-source-compiler): New procedure.
(%updaters): Set! it.
* guix/transformations.scm (transform-package-latest): New procedure.
(%transformations): Add 'with-latest'.
(%transformation-options, show-transformation-options-help/detailed):
Add '--with-latest'.
* tests/transformations.scm ("options->transformation, with-latest"):
New test.
* doc/guix.texi (Package Transformation Options): Document it.

2 files changed, 73 insertions, 4 deletions

diff --git a/guix/transformations.scm b/guix/transformations.scm
index 2385d3231e..4e9260350c 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,6 +25,9 @@
   #:autoload   (guix download) (download-to-store)
   #:autoload   (guix git-download) (git-reference? git-reference-url)
   #:autoload   (guix git) (git-checkout git-checkout? git-checkout-url)
+  #:autoload   (guix upstream) (package-latest-release*
+                                upstream-source-version
+                                upstream-source-signature-urls)
   #:use-module (guix utils)
   #:use-module (guix memoization)
   #:use-module (guix gexp)
@@ -511,6 +514,42 @@ additional patches."
         (rewrite obj)
         obj)))
 
+(define (transform-package-latest specs)
+  "Return a procedure that rewrites package graphs such that those in SPECS
+are replaced by their latest upstream version."
+  (define (package-with-latest-upstream p)
+    (let ((source (package-latest-release* p)))
+      (cond ((not source)
+             (warning
+              (G_ "could not determine latest upstream release of '~a'~%")
+              (package-name p))
+             p)
+            ((string=? (upstream-source-version source)
+                       (package-version p))
+             p)
+            (else
+             (unless (pair? (upstream-source-signature-urls source))
+               (warning (G_ "cannot authenticate source of '~a', version ~a~%")
+                        (package-name p)
+                        (upstream-source-version source)))
+
+             ;; TODO: Take 'upstream-source-input-changes' into account.
+             (package
+               (inherit p)
+               (version (upstream-source-version source))
+               (source source))))))
+
+  (define rewrite
+    (package-input-rewriting/spec
+     (map (lambda (spec)
+            (cons spec package-with-latest-upstream))
+          specs)))
+
+  (lambda (obj)
+    (if (package? obj)
+        (rewrite obj)
+        obj)))
+
 (define %transformations
   ;; Transformations that can be applied to things to build.  The car is the
   ;; key used in the option alist, and the cdr is the transformation
@@ -525,7 +564,8 @@ additional patches."
     (with-c-toolchain . ,transform-package-toolchain)
     (with-debug-info . ,transform-package-with-debug-info)
     (without-tests . ,transform-package-tests)
-    (with-patch  . ,transform-package-patches)))
+    (with-patch  . ,transform-package-patches)
+    (with-latest . ,transform-package-latest)))
 
 (define (transformation-procedure key)
   "Return the transformation procedure associated with KEY, a symbol such as
@@ -567,6 +607,8 @@ additional patches."
                   (parser 'without-tests))
           (option '("with-patch") #t #f
                   (parser 'with-patch))
+          (option '("with-latest") #t #f
+                  (parser 'with-latest))
 
           (option '("help-transform") #f #f
                   (lambda _
@@ -599,6 +641,9 @@ additional patches."
       --with-patch=PACKAGE=FILE
                          add FILE to the list of patches of PACKAGE"))
   (display (G_ "
+      --with-latest=PACKAGE
+                         use the latest upstream release of PACKAGE"))
+  (display (G_ "
       --with-c-toolchain=PACKAGE=TOOLCHAIN
                          build PACKAGE and its dependents with TOOLCHAIN"))
   (display (G_ "
diff --git a/guix/upstream.scm b/guix/upstream.scm
index a8ed1d81cd..accd8967d8 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -31,8 +31,8 @@
   #:use-module (guix base32)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:use-module ((guix derivations)
-                #:select (built-derivations derivation->output-path))
+  #:use-module ((guix derivations) #:select (built-derivations derivation->output-path))
+  #:autoload   (gcrypt hash) (port-sha256)
   #:use-module (guix monads)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
@@ -248,6 +248,9 @@ correspond to the same version."
                                        '()
                                        (importer-modules))))
 
+;; Tests need to mock this variable so mark it as "non-declarative".
+(set! %updaters %updaters)
+
 (define* (lookup-updater package
                          #:optional (updaters (force %updaters)))
   "Return an updater among UPDATERS that matches PACKAGE, or #f if none of
@@ -351,6 +354,27 @@ values: 'interactive' (default), 'always', and 'never'."
                         data url)
                #f)))))))
 
+(define-gexp-compiler (upstream-source-compiler (source <upstream-source>)
+                                                system target)
+  "Download SOURCE from its first URL and lower it as a fixed-output
+derivation that would fetch it."
+  (mlet* %store-monad ((url -> (first (upstream-source-urls source)))
+                       (signature
+                        -> (and=> (upstream-source-signature-urls source)
+                                  first))
+                       (tarball ((store-lift download-tarball) url signature)))
+    (unless tarball
+      (raise (formatted-message (G_ "failed to fetch source from '~a'")
+                                url)))
+
+    ;; Instead of returning TARBALL, return a fixed-output derivation that
+    ;; would be able to re-download it.  In practice, since TARBALL is already
+    ;; in the store, no extra download will happen, but having the derivation
+    ;; in store improves provenance tracking.
+    (let ((hash (call-with-input-file tarball port-sha256)))
+      (url-fetch url 'sha256 hash (store-path-package-name tarball)
+                 #:system system))))
+
 (define (find2 pred lst1 lst2)
   "Like 'find', but operate on items from both LST1 and LST2.  Return two
 values: the item from LST1 and the item from LST2 that match PRED."