02/06: services: nar-herder: Add cached compression support.

[guix-commits]

cbaines pushed a commit to branch master
in repository guix.

commit 9a5533c653522a4fbba61c3ea17ff6fa0f96af9f
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Fri Feb 3 15:18:44 2023 +0100

    services: nar-herder: Add cached compression support.
    
    * gnu/services/guix.scm (<nar-herder-cached-compression-configuration>): New
    record type.
    (nar-herder-configuration-cached-compressions,
    nar-herder-configuration-cached-compression-min-uses,
    nar-herder-configuration-cached-compression-workers,
    nar-herder-configuration-cached-compression-nar-source,
    nar-herder-cached-compression-configuration,
    nar-herder-cached-compression-configuration?,
    nar-herder-cached-compression-configuration-type,
    nar-herder-cached-compression-configuration-level,
    nar-herder-cached-compression-configuration-directory,
    nar-herder-cached-compression-configuration-directory-max-size): New
    procedures.
    * doc/guix.texi (Guix Services): Document this.
---
 doc/guix.texi         | 36 ++++++++++++++++++++++
 gnu/services/guix.scm | 85 +++++++++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 118 insertions(+), 3 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 64873db00b..d69be8586e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -36836,6 +36836,42 @@ advertised.
 Log level to use, specify a log level like @code{'INFO} to stop logging
 individual requests.
 
+@item @code{cached-compressions} (default: @code{'()})
+Activate generating cached nars with different compression details from
+the stored nars.  This is a list of
+nar-herder-cached-compression-configuration records.
+
+@item @code{min-uses} (default: @code{3})
+When cached-compressions are enabled, generate cached nars when at least
+this number of requests are made for a nar.
+
+@item @code{workers} (default: @code{2})
+Number of cached nars to generate at a time.
+
+@item @code{nar-source} (default: @code{#f})
+Location to fetch nars from when computing cached compressions.  By
+default, the storage location will be used.
+
+@end table
+@end deftp
+
+@deftp {Data Type} nar-herder-cached-compression-configuration
+Data type representing the cached compression configuration.
+
+@table @asis
+@item @code{type}
+Type of compression to use, e.g. @code{'zstd}.
+
+@item @code{workers} (default: @code{#f})
+Level of the compression to use.
+
+@item @code{directory} (default: @code{#f})
+Location to store the cached nars.  If unspecified, they will be stored
+in /var/cache/nar-herder/nar/TYPE.
+
+@item @code{directory-max-size} (default: @code{#f})
+Maximum size in bytes of the directory.
+
 @end table
 @end deftp
 
diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm
index 65bf0b5a7f..2dfedc553e 100644
--- a/gnu/services/guix.scm
+++ b/gnu/services/guix.scm
@@ -126,7 +126,18 @@
             nar-herder-configuration-storage
             nar-herder-configuration-storage-limit
             nar-herder-configuration-storage-nar-removal-criteria
-            nar-herder-configuration-log-level))
+            nar-herder-configuration-log-level
+            nar-herder-configuration-cached-compressions
+            nar-herder-configuration-cached-compression-min-uses
+            nar-herder-configuration-cached-compression-workers
+            nar-herder-configuration-cached-compression-nar-source
+
+            nar-herder-cached-compression-configuration
+            nar-herder-cached-compression-configuration?
+            nar-herder-cached-compression-configuration-type
+            nar-herder-cached-compression-configuration-level
+            nar-herder-cached-compression-configuration-directory
+            nar-herder-cached-compression-configuration-directory-max-size))
 
 ;;;; Commentary:
 ;;;
@@ -828,17 +839,67 @@ ca-certificates.crt file in the system profile."
   (negative-ttl  nar-herder-configuration-negative-ttl
                  (default #f))
   (log-level     nar-herder-configuration-log-level
-                 (default 'DEBUG)))
+                 (default 'DEBUG))
+  (cached-compressions
+   nar-herder-configuration-cached-compressions
+   (default '()))
+  (cached-compression-min-uses
+   nar-herder-configuration-cached-compression-min-uses
+   (default 3))
+  (cached-compression-workers
+   nar-herder-configuration-cached-compression-workers
+   (default 2))
+  (cached-compression-nar-source
+   nar-herder-configuration-cached-compression-nar-source
+   (default #f)))
 
+(define-record-type* <nar-herder-cached-compression-configuration>
+  nar-herder-cached-compression-configuration
+  make-nar-herder-cached-compression-configuration
+  nar-herder-cached-compression-configuration?
+  (type                nar-herder-cached-compression-configuration-type)
+  (level               nar-herder-cached-compression-configuration-level
+                       (default #f))
+  (directory           nar-herder-cached-compression-configuration-directory
+                       (default #f))
+  (directory-max-size
+   nar-herder-cached-compression-configuration-directory-max-size
+   (default #f)))
 
 (define (nar-herder-shepherd-services config)
+  (define (cached-compression-configuration->options cached-compression)
+    (match-record
+        cached-compression
+        <nar-herder-cached-compression-configuration>
+      (type level directory directory-max-size)
+
+      `(,(simple-format #f "--enable-cached-compression=~A~A"
+                        type
+                        (if level
+                            (simple-format #f ":~A" level)
+                            ""))
+        ,@(if directory
+              (list
+               (simple-format #f "--cached-compression-directory=~A=~A"
+                              type
+                              directory))
+              '())
+        ,@(if directory-max-size
+              (list
+               (simple-format #f 
"--cached-compression-directory-max-size=~A=~A"
+                              type
+                              directory-max-size))
+              '()))))
+
   (match-record config <nar-herder-configuration>
     (package user group
              mirror
              database database-dump
              host port
              storage storage-limit storage-nar-removal-criteria
-             ttl negative-ttl log-level)
+             ttl negative-ttl log-level
+             cached-compressions cached-compression-min-uses
+             cached-compression-workers cached-compression-nar-source)
 
     (unless (or mirror storage)
       (error "nar-herder: mirror or storage must be set"))
@@ -882,6 +943,24 @@ ca-certificates.crt file in the system profile."
                              '())
                       #$@(if log-level
                              (list (simple-format #f "--log-level=~A" 
log-level))
+                             '())
+                      #$@(append-map
+                          cached-compression-configuration->options
+                          cached-compressions)
+                      #$@(if cached-compression-min-uses
+                             (list (simple-format
+                                    #f "--cached-compression-min-uses=~A"
+                                    cached-compression-min-uses))
+                             '())
+                      #$@(if cached-compression-workers
+                             (list (simple-format
+                                    #f "--cached-compression-workers=~A"
+                                    cached-compression-workers))
+                             '())
+                      #$@(if cached-compression-nar-source
+                             (list (simple-format
+                                    #f "--cached-compression-nar-source=~A"
+                                    cached-compression-nar-source))
                              '()))
                 #:user #$user
                 #:group #$group