publish: Add support for zstd compression.

* guix/scripts/publish.scm (compress-nar)[write-compressed-file]: New
procedure.
Use it for 'gzip' and 'lzip'.  Add 'zstd.
(nar-response-port, string->compression-type): Add case for 'zstd'.
* tests/publish.scm (zstd-supported?): New procedure.
("/nar/zstd/*"): New test.
* doc/guix.texi (Invoking guix publish): Document zstd compression.
(Base Services): Add cross-reference to the above node.

3 files changed, 49 insertions, 20 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index f38e018dff..92ea87d6b7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12348,17 +12348,23 @@ server socket is open and the signing key has been read.
 @item --compression[=@var{method}[:@var{level}]]
 @itemx -C [@var{method}[:@var{level}]]
 Compress data using the given @var{method} and @var{level}.  @var{method} is
-one of @code{lzip} and @code{gzip}; when @var{method} is omitted, @code{gzip}
-is used.
+one of @code{lzip}, @code{zstd}, and @code{gzip}; when @var{method} is
+omitted, @code{gzip} is used.
 
 When @var{level} is zero, disable compression.  The range 1 to 9 corresponds
 to different compression levels: 1 is the fastest, and 9 is the best
 (CPU-intensive).  The default is 3.
 
-Usually, @code{lzip} compresses noticeably better than @code{gzip} for a small
-increase in CPU usage; see
-@uref{https://nongnu.org/lzip/lzip_benchmark.html,benchmarks on the lzip Web
-page}.
+Usually, @code{lzip} compresses noticeably better than @code{gzip} for a
+small increase in CPU usage; see
+@uref{https://nongnu.org/lzip/lzip_benchmark.html,benchmarks on the lzip
+Web page}.  However, @code{lzip} achieves low decompression throughput
+(on the order of 50@tie{}MiB/s on modern hardware), which can be a
+bottleneck for someone who downloads over a fast network connection.
+
+The compression ratio of @code{zstd} is between that of @code{lzip} and
+that of @code{gzip}; its main advantage is a
+@uref{https://facebook.github.io/zstd/,high decompression speed}.
 
 Unless @option{--cache} is used, compression occurs on the fly and
 the compressed streams are not
@@ -15400,7 +15406,9 @@ at level 7 and gzip at level 9, write:
 @end lisp
 
 Level 9 achieves the best compression ratio at the expense of increased CPU
-usage, whereas level 1 achieves fast compression.
+usage, whereas level 1 achieves fast compression.  @xref{Invoking guix
+publish}, for more information on the available compression methods and
+the tradeoffs involved.
 
 An empty list disables compression altogether.
 
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 5a865c838d..fa85088ed0 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -56,6 +56,8 @@
   #:use-module (zlib)
   #:autoload   (lzlib) (call-with-lzip-output-port
                         make-lzip-output-port)
+  #:autoload   (zstd)  (call-with-zstd-output-port
+                        make-zstd-output-port)
   #:use-module (guix cache)
   #:use-module (guix ui)
   #:use-module (guix scripts)
@@ -588,23 +590,22 @@ requested using POOL."
   (define nar
     (nar-cache-file cache item #:compression compression))
 
+  (define (write-compressed-file call-with-compressed-output-port)
+    ;; Note: the file port gets closed along with the compressed port.
+    (call-with-compressed-output-port (open-output-file (string-append nar ".tmp"))
+      (lambda (port)
+        (write-file item port))
+      #:level (compression-level compression))
+    (rename-file (string-append nar ".tmp") nar))
+
   (mkdir-p (dirname nar))
   (match (compression-type compression)
     ('gzip
-     ;; Note: the file port gets closed along with the gzip port.
-     (call-with-gzip-output-port (open-output-file (string-append nar ".tmp"))
-       (lambda (port)
-         (write-file item port))
-       #:level (compression-level compression)
-       #:buffer-size %default-buffer-size)
-     (rename-file (string-append nar ".tmp") nar))
+     (write-compressed-file call-with-gzip-output-port))
     ('lzip
-     ;; Note: the file port gets closed along with the lzip port.
-     (call-with-lzip-output-port (open-output-file (string-append nar ".tmp"))
-       (lambda (port)
-         (write-file item port))
-       #:level (compression-level compression))
-     (rename-file (string-append nar ".tmp") nar))
+     (write-compressed-file call-with-lzip-output-port))
+    ('zstd
+     (write-compressed-file call-with-zstd-output-port))
     ('none
      ;; Cache nars even when compression is disabled so that we can
      ;; guarantee the TTL (see <https://bugs.gnu.org/28664>.)
@@ -871,6 +872,9 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
     (($ <compression> 'lzip level)
      (make-lzip-output-port (response-port response)
                             #:level level))
+    (($ <compression> 'zstd level)
+     (make-zstd-output-port (response-port response)
+                            #:level level))
     (($ <compression> 'none)
      (response-port response))
     (#f
@@ -953,6 +957,7 @@ blocking."
   (match string
     ("gzip" 'gzip)
     ("lzip" 'lzip)
+    ("zstd" 'zstd)
     (_      #f)))
 
 (define (effective-compression requested-type compressions)
diff --git a/tests/publish.scm b/tests/publish.scm
index cafd0f13a2..52101876b5 100644
--- a/tests/publish.scm
+++ b/tests/publish.scm
@@ -38,6 +38,7 @@
   #:use-module ((guix pki) #:select (%public-key-file %private-key-file))
   #:use-module (zlib)
   #:use-module (lzlib)
+  #:autoload   (zstd) (call-with-zstd-input-port)
   #:use-module (web uri)
   #:use-module (web client)
   #:use-module (web response)
@@ -54,6 +55,9 @@
 (define %store
   (open-connection-for-tests))
 
+(define (zstd-supported?)
+  (resolve-module '(zstd) #t #f #:ensure #f))
+
 (define %reference (add-text-to-store %store "ref" "foo"))
 
 (define %item (add-text-to-store %store "item" "bar" (list %reference)))
@@ -237,6 +241,18 @@ References: ~%"
          (cut restore-file <> temp)))
      (call-with-input-file temp read-string))))
 
+(unless (zstd-supported?) (test-skip 1))
+(test-equal "/nar/zstd/*"
+  "bar"
+  (call-with-temporary-output-file
+   (lambda (temp port)
+     (let ((nar (http-get-port
+                 (publish-uri
+                  (string-append "/nar/zstd/" (basename %item))))))
+       (call-with-zstd-input-port nar
+         (cut restore-file <> temp)))
+     (call-with-input-file temp read-string))))
+
 (test-equal "/*.narinfo with compression"
   `(("StorePath" . ,%item)
     ("URL" . ,(string-append "nar/gzip/" (basename %item)))