[bug#42048] [PATCH 5/6] guix describe: Display channel introductions and add 'channels-sans-intro'.

["Ludovic Courtès" <ludo@gnu.org>]

* guix/scripts/describe.scm (%available-formats): Add "channels-sans-intro".
(channel->sexp): Add #:include-introduction?.  Emit CHANNEL's intro if
INCLUDE-INTRODUCTION? is true and CHANNEL has an introduction.
(channel->json): Include CHANNEL's introduction, if any.
(channel->recutils): Likewise.
(display-profile-info): Add 'channels-sans-intro' case.
* doc/guix.texi (Invoking guix describe): Add introduction in example.
Add 'channels-sans-intro' case.
---
 doc/guix.texi             | 13 ++++++++-
 guix/scripts/describe.scm | 56 ++++++++++++++++++++++++++++++++-------
 2 files changed, 58 insertions(+), 11 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index a4bb52bb24..fcf67bd718 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4613,7 +4613,12 @@ $ guix describe -f channels
         (name 'guix)
         (url "https://git.savannah.gnu.org/git/guix.git")
         (commit
-          "e0fa68c7718fffd33d81af415279d6ddb518f727")))
+          "e0fa68c7718fffd33d81af415279d6ddb518f727")
+        (introduction
+          (make-channel-introduction
+            "9edb3f66fd807b096b48283debdcddccfea34bad"
+            (openpgp-fingerprint
+              "BBB0 2DDF 2CEA F6A8 0D1D  E643 A2A0 6DF2 A33A 54FA")))))
 @end example
 
 @noindent
@@ -4639,6 +4644,12 @@ produce human-readable output;
 produce a list of channel specifications that can be passed to @command{guix
 pull -C} or installed as @file{~/.config/guix/channels.scm} (@pxref{Invoking
 guix pull});
+@item channels-sans-intro
+like @code{channels}, but omit the @code{introduction} field; use it to
+produce a channel specification suitable for Guix version 1.1.0 or
+earlier---the @code{introduction} field has to do with channel
+authentication (@pxref{Channels, Channel Authentication}) and is not
+supported by these older versions;
 @item json
 @cindex JSON
 produce a list of channel specifications in JSON format;
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index 7a2dbc453a..39e096a9a4 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -26,9 +26,11 @@
   #:use-module (guix scripts)
   #:use-module (guix describe)
   #:use-module (guix profiles)
+  #:autoload   (guix openpgp) (openpgp-format-fingerprint)
   #:use-module (git)
   #:use-module (json)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
   #:autoload   (ice-9 pretty-print) (pretty-print)
@@ -42,7 +44,8 @@
 ;;;
 ;;; Command-line options.
 ;;;
-(define %available-formats '("human" "channels" "json" "recutils"))
+(define %available-formats
+  '("human" "channels" "channels-sans-intro" "json" "recutils"))
 
 (define (list-formats)
   (display (G_ "The available formats are:\n"))
@@ -109,21 +112,50 @@ Display information about the channels currently in use.\n"))
        (_
         (warning (G_ "'GUIX_PACKAGE_PATH' is set but it is not captured~%")))))))
 
-(define (channel->sexp channel)
-  `(channel
-    (name ',(channel-name channel))
-    (url ,(channel-url channel))
-    (commit ,(channel-commit channel))))
+(define* (channel->sexp channel #:key (include-introduction? #t))
+  (let ((intro (and include-introduction?
+                    (channel-introduction channel))))
+    `(channel
+      (name ',(channel-name channel))
+      (url ,(channel-url channel))
+      (commit ,(channel-commit channel))
+      ,@(if intro
+            `((introduction (make-channel-introduction
+                             ,(channel-introduction-first-signed-commit intro)
+                             (openpgp-fingerprint
+                              ,(openpgp-format-fingerprint
+                                (channel-introduction-first-commit-signer
+                                 intro))))))
+            '()))))
 
 (define (channel->json channel)
-  (scm->json-string `((name . ,(channel-name channel))
-                      (url . ,(channel-url channel))
-                      (commit . ,(channel-commit channel)))))
+  (scm->json-string
+   (let ((intro (channel-introduction channel)))
+     `((name . ,(channel-name channel))
+       (url . ,(channel-url channel))
+       (commit . ,(channel-commit channel))
+       ,@(if intro
+             `((introduction
+                . ((commit . ,(channel-introduction-first-signed-commit
+                               intro))
+                   (signer . ,(openpgp-format-fingerprint
+                               (channel-introduction-first-commit-signer
+                                intro))))))
+             '())))))
 
 (define (channel->recutils channel port)
+  (define intro
+    (channel-introduction channel))
+
   (format port "name: ~a~%" (channel-name channel))
   (format port "url: ~a~%" (channel-url channel))
-  (format port "commit: ~a~%" (channel-commit channel)))
+  (format port "commit: ~a~%" (channel-commit channel))
+  (when intro
+    (format port "introductioncommit: ~a~%"
+            (channel-introduction-first-signed-commit intro))
+    (format port "introductionsigner: ~a~%"
+            (openpgp-format-fingerprint
+             (channel-introduction-first-commit-signer intro)))))
 
 (define (display-checkout-info fmt)
   "Display information about the current checkout according to FMT, a symbol
@@ -181,6 +213,10 @@ in the format specified by FMT."
      (display-profile-content profile number))
     ('channels
      (pretty-print `(list ,@(map channel->sexp channels))))
+    ('channels-sans-intro
+     (pretty-print `(list ,@(map (cut channel->sexp <>
+                                      #:include-introduction? #f)
+                                 channels))))
     ('json
      (format #t "[~a]~%" (string-join (map channel->json channels) ",")))
     ('recutils
-- 
2.26.2