02/06: publish: Introduce 'actual-compression'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 905ae5276d22b600079eaaa2032fbf5bd435331e
Author: Ludovic Courtès <address@hidden>
Date:   Mon Apr 17 23:11:28 2017 +0200

    publish: Introduce 'actual-compression'.
    
    * guix/scripts/publish.scm (actual-compression): New procedure.
    (narinfo-string): Use it.
---
 guix/scripts/publish.scm | 11 ++++++++---
 1 file changed, 8 insertions(+), 3 deletions(-)

diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index d8ac72f..111cb29 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -110,6 +110,13 @@ Publish ~a over HTTP.\n") %store-directory)
   ;; Since we compress on the fly, default to fast compression.
   (compression 'gzip 3))
 
+(define (actual-compression item requested)
+  "Return the actual compression used for ITEM, which may be %NO-COMPRESSION
+if ITEM is already compressed."
+  (if (compressed-file? item)
+      %no-compression
+      requested))
+
 (define %options
   (list (option '(#\h "help") #f #f
                 (lambda _
@@ -218,9 +225,7 @@ compression disabled~%"))
 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."
   (let* ((path-info  (query-path-info store store-path))
-         (compression (if (compressed-file? store-path)
-                          %no-compression
-                          compression))
+         (compression (actual-compression store-path compression))
          (url        (encode-and-join-uri-path
                       `(,@(split-and-decode-uri-path nar-path)
                         ,@(match compression