[bug#52555] [PATCH v4 4/7] publish: Add ERIS URN to narinfo.

[pukkamustard <pukkamustard@posteo.net>]

* guix/scripts/publish.scm (bake-narinfo+nar): Encode store item using ERIS.
  (show-help, %options): Add '--eris'.
  (guix-publish): Honor '--eris'.
* gnu/packages/package-management.scm (guix): Add guile-eris to native-inputs.
* guix/eris.scm: New file.
* Makefile.am (MODULES): Add new file.
---
 Makefile.am                         |  1 +
 configure.ac                        |  5 ++
 gnu/packages/package-management.scm |  1 +
 guix/eris.scm                       | 73 +++++++++++++++++++++++++++++
 guix/scripts/publish.scm            | 51 ++++++++++++++------
 5 files changed, 117 insertions(+), 14 deletions(-)
 create mode 100644 guix/eris.scm

diff --git a/Makefile.am b/Makefile.am
index b64dcaa77c..86da4560e4 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -136,6 +136,7 @@ MODULES =					\
   guix/least-authority.scm			\
   guix/read-print.scm				\
   guix/ipfs.scm					\
+  guix/eris.scm					\
   guix/platform.scm                             \
   guix/platforms/arm.scm                        \
   guix/platforms/avr.scm                        \
diff --git a/configure.ac b/configure.ac
index ecbd596a34..7e25099c4c 100644
--- a/configure.ac
+++ b/configure.ac
@@ -173,6 +173,11 @@ GUILE_MODULE_AVAILABLE([have_guile_avahi], [(avahi)])
 AM_CONDITIONAL([HAVE_GUILE_AVAHI],
   [test "x$have_guile_avahi" = "xyes"])
 
+dnl Check for Guile-ERIS.
+GUILE_MODULE_AVAILABLE([have_guile_eris], [(eris)])
+AM_CONDITIONAL([HAVE_GUILE_ERIS],
+  [test "x$have_guile_eris" = "xyes"])
+
 dnl Guile-newt is used by the graphical installer.
 GUILE_MODULE_AVAILABLE([have_guile_newt], [(newt)])
 
diff --git a/gnu/packages/package-management.scm b/gnu/packages/package-management.scm
index 97ea41df66..9c0afb70dd 100644
--- a/gnu/packages/package-management.scm
+++ b/gnu/packages/package-management.scm
@@ -478,6 +478,7 @@ (define-public guix
                        ("guile-zstd" ,guile-zstd)
                        ("guile-ssh" ,guile-ssh)
                        ("guile-git" ,guile-git)
+                       ("guile-eris" ,guile-eris)
 
                        ;; XXX: Keep the development inputs here even though
                        ;; they're unnecessary, just so that 'guix environment
diff --git a/guix/eris.scm b/guix/eris.scm
new file mode 100644
index 0000000000..d98a9a62bd
--- /dev/null
+++ b/guix/eris.scm
@@ -0,0 +1,73 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 pukkamustard <pukkamustard@posteo.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix eris)
+
+  #:use-module (eris)
+  #:use-module (eris fs)
+  #:use-module (eris sqlite)
+  #:use-module (eris read-capability)
+
+  #:use-module (web uri)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-171)
+
+  #:export (%eris-store-url
+            eris-encode-store-item))
+
+(define %eris-store-url
+  (make-parameter
+   (getenv "ERIS_STORE_URL")
+   (lambda (val)
+     (cond
+      ((uri? val) val)
+      ((string? val) (string->uri val))
+      (else #f)))))
+
+(define %guix-eris-convergence-secret
+  (make-parameter %null-convergence-secret))
+
+(define (guix-eris-block-reducer)
+  "Returns an ERIS block reducer."
+  (if (uri? (%eris-store-url))
+      (match (uri-scheme (%eris-store-url))
+
+        ;; Store blocks in an SQLite database (see
+        ;; https://eris.codeberg.page/eer/sqlite.xml)
+        ('sqlite
+         (eris-sqlite-block-reducer (uri-path (%eris-store-url))))
+
+        ;; TODO
+        ;; ('coap+unix #f)
+        ;; ('coap+tcp #f)
+
+        (_ (error "Don't know how to handle ERIS store URL "
+                  (uri->string (%eris-store-url)))))
+
+      ;; If no ERIS store URL is provided we just compute the ERIS URN without
+      ;; storing the blocks anywhere. As dummy block-reducer we use `rcount` from
+      ;; SRFI-171 that counts the number of blocks.
+      rcount))
+
+(define* (eris-encode-store-item item)
+  "Encodes the store item ITEM using ERIS and returns the read capability as
+string."
+  (eris-read-capability->string
+   (eris-fs-encode item
+                   #:convergence-secret (%guix-eris-convergence-secret)
+                   #:block-reducer (guix-eris-block-reducer))))
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 4457be1fce..2e7138f3c7 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -53,6 +53,7 @@ (define-module (guix scripts publish)
   #:use-module (guix workers)
   #:use-module (guix store)
   #:use-module ((guix serialization) #:select (write-file))
+  #:use-module (guix eris)
   #:use-module (zlib)
   #:autoload   (lzlib) (call-with-lzip-output-port
                         make-lzip-output-port)
@@ -96,6 +97,8 @@ (define (show-help)
   (display (G_ "
       --cache-bypass-threshold=SIZE
                          serve store items below SIZE even when not cached"))
+  (display (G_ "
+      --eris[=STORE]     encode items using ERIS and publish blocks to STORE"))
   (display (G_ "
       --workers=N        use N workers to bake items"))
   (display (G_ "
@@ -218,6 +221,9 @@ (define %options
                 (lambda (opt name arg result)
                   (alist-cons 'workers (string->number* arg)
                               result)))
+        (option '("eris") #f #t
+                (lambda (opt name arg result)
+                  (alist-cons 'eris (or arg #t) result)))
         (option '("ttl") #t #f
                 (lambda (opt name arg result)
                   (let ((duration (string->duration arg)))
@@ -319,7 +325,8 @@ (define* (store-item->recutils store-item
 
 (define* (narinfo-string store store-path
                          #:key (compressions (list %no-compression))
-                         (nar-path "nar") (file-sizes '()))
+                         (nar-path "nar") (file-sizes '())
+                         eris-urn)
   "Generate a narinfo key/value string for STORE-PATH; an exception is raised
 if STORE-PATH is invalid.  Produce a URL that corresponds to COMPRESSION.  The
 narinfo is signed with KEY.  NAR-PATH specifies the prefix for nar URLs.
@@ -341,10 +348,10 @@ (define* (narinfo-string store store-path
                              "\
 StorePath: ~a
 NarHash: sha256:~a
-NarSize: ~d
+NarSize: ~d~@[~%ERIS: ~a~]
 References: ~a~%"
                              store-path
-                             hash size references))
+                             hash size eris-urn references))
          ;; Do not render a "Deriver" line if we are rendering info for a
          ;; derivation.  Also do not render a "System" line that would be
          ;; expensive to compute and is currently unused.
@@ -530,7 +537,7 @@ (define (bypass-cache? store item)
 (define* (render-narinfo/cached store request hash
                                 #:key ttl (compressions (list %no-compression))
                                 (nar-path "nar") negative-ttl
-                                cache pool)
+                                cache pool eris?)
   "Respond to the narinfo request for REQUEST.  If the narinfo is available in
 CACHE, then send it; otherwise, return 404 and \"bake\" that nar and narinfo
 requested using POOL."
@@ -575,7 +582,8 @@ (define* (render-narinfo/cached store request hash
                  (bake-narinfo+nar cache item
                                    #:ttl ttl
                                    #:compressions compressions
-                                   #:nar-path nar-path)))
+                                   #:nar-path nar-path
+                                   #:eris? eris?)))
 
              (when ttl
                (single-baker 'cache-cleanup
@@ -636,7 +644,8 @@ (define (compress-nar cache item compression)
 
 (define* (bake-narinfo+nar cache item
                            #:key ttl (compressions (list %no-compression))
-                           (nar-path "/nar"))
+                           (nar-path "/nar")
+                           (eris? #f))
   "Write the narinfo and nar for ITEM to CACHE."
   (define (compressed-nar-size compression)
     (let* ((nar  (nar-cache-file cache item #:compression compression))
@@ -644,7 +653,10 @@ (define* (bake-narinfo+nar cache item
       (and stat
            (cons compression (stat:size stat)))))
 
-  (let ((compression (actual-compressions item compressions)))
+  (let ((compression (actual-compressions item compressions))
+        (eris-urn (if eris?
+                      (eris-encode-store-item item)
+                      #f)))
 
     (for-each (cut compress-nar cache item <>) compressions)
 
@@ -662,7 +674,8 @@ (define* (bake-narinfo+nar cache item
                  (display (narinfo-string store item
                                           #:nar-path nar-path
                                           #:compressions compressions
-                                          #:file-sizes sizes)
+                                          #:file-sizes sizes
+                                          #:eris-urn eris-urn)
                           port)))
 
              ;; Make the cached narinfo world-readable, contrary to what
@@ -1060,7 +1073,8 @@ (define* (make-request-handler store
                                cache pool
                                narinfo-ttl narinfo-negative-ttl
                                (nar-path "nar")
-                               (compressions (list %no-compression)))
+                               (compressions (list %no-compression))
+                               (eris? #f))
   (define compression-type?
     string->compression-type)
 
@@ -1092,7 +1106,8 @@ (define* (make-request-handler store
                                       #:ttl narinfo-ttl
                                       #:negative-ttl narinfo-negative-ttl
                                       #:nar-path nar-path
-                                      #:compressions compressions)
+                                      #:compressions compressions
+                                      #:eris? eris?)
                (render-narinfo store request hash
                                #:ttl narinfo-ttl
                                #:negative-ttl narinfo-negative-ttl
@@ -1162,7 +1177,7 @@ (define* (run-publish-server socket store
                              advertise? port
                              (compressions (list %no-compression))
                              (nar-path "nar") narinfo-ttl narinfo-negative-ttl
-                             cache pool)
+                             cache pool eris?)
   (when advertise?
     (let ((name (service-name)))
       ;; XXX: Use a callback from Guile-Avahi here, as Avahi can pick a
@@ -1178,7 +1193,8 @@ (define* (run-publish-server socket store
                                     #:nar-path nar-path
                                     #:narinfo-ttl narinfo-ttl
                                     #:narinfo-negative-ttl narinfo-negative-ttl
-                                    #:compressions compressions)
+                                    #:compressions compressions
+                                    #:eris? eris?)
               concurrent-http-server
               `(#:socket ,socket)))
 
@@ -1262,6 +1278,7 @@ (define-command (guix-publish . args)
            (repl-port (assoc-ref opts 'repl))
            (cache     (assoc-ref opts 'cache))
            (workers   (assoc-ref opts 'workers))
+           (eris?     (assoc-ref opts 'eris))
 
            ;; Read the key right away so that (1) we fail early on if we can't
            ;; access them, and (2) we can then drop privileges.
@@ -1281,7 +1298,8 @@ (define-command (guix-publish . args)
                      (%private-key private-key)
                      (cache-bypass-threshold
                       (or (assoc-ref opts 'cache-bypass-threshold)
-                          (cache-bypass-threshold))))
+                          (cache-bypass-threshold)))
+                     (%eris-store-url (assoc-ref opts 'eris)))
         (if (eq? style 'systemd)
             (info (G_ "publishing (started via socket activation)~%"))
             (info (G_ "publishing ~a on ~a, port ~d~%")
@@ -1289,6 +1307,10 @@ (define-command (guix-publish . args)
                   (inet-ntop (sockaddr:fam address) (sockaddr:addr address))
                   (sockaddr:port address)))
 
+        (when (string? (assoc-ref opts 'eris))
+          (info (G_ "publishing ERIS blocks to ~a~%")
+                (assoc-ref opts 'eris)))
+
         (for-each (lambda (compression)
                     (info (G_ "using '~a' compression method, level ~a~%")
                           (compression-type compression)
@@ -1312,7 +1334,8 @@ (define-command (guix-publish . args)
                               #:nar-path nar-path
                               #:compressions compressions
                               #:narinfo-negative-ttl negative-ttl
-                              #:narinfo-ttl ttl))))))
+                              #:narinfo-ttl ttl
+                              #:eris? eris?))))))
 
 ;;; Local Variables:
 ;;; eval: (put 'single-baker 'scheme-indent-function 1)
-- 
2.41.0