branch wip-offload updated: tmp22

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch wip-offload
in repository guix-cuirass.

The following commit(s) were added to refs/heads/wip-offload by this push:
     new 2fe32a9  tmp22
2fe32a9 is described below

commit 2fe32a955e619c242c0e1562c2e7db55ca3a07a1
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Fri Dec 18 10:34:25 2020 +0100

    tmp22
---
 src/cuirass/remote-server.scm | 31 +++++++++++++++++++++++++++----
 1 file changed, 27 insertions(+), 4 deletions(-)

diff --git a/src/cuirass/remote-server.scm b/src/cuirass/remote-server.scm
index 109f2d0..45170a7 100644
--- a/src/cuirass/remote-server.scm
+++ b/src/cuirass/remote-server.scm
@@ -249,6 +249,8 @@ be used to reply to the worker."
 ;;; Fetch workers.
 ;;;
 
+(define %default-compression "gzip")
+
 (define (zmq-fetch-workers-endpoint)
   "inproc://fetch-workers")
 
@@ -270,7 +272,7 @@ be used to reply to the worker."
 
 (define (publish-nar-url publish-url store-hash)
   "Return the URL of STORE-HASH nar substitute on PUBLISH-URL."
-  (format #f "~a/nar/gzip/~a" publish-url store-hash))
+  (format #f "~a/nar/~a/~a" publish-url default-compression store-hash))
 
 (define (publish-narinfo-url publish-url store-hash)
   "Return the URL of STORE-HASH narinfo file on PUBLISH-URL."
@@ -280,11 +282,25 @@ be used to reply to the worker."
 
 (define (nar-path cache-directory output)
   "Return the path of the NAR file for OUTPUT in CACHE-DIRECTORY."
-  (string-append cache-directory "/" (basename output) ".nar"))
+  (string-append cache-directory "/"
+                 default-compression
+                 "/" (basename output) ".nar"))
 
 (define (narinfo-path cache-directory output)
   "Return the path of the NARINFO file for OUTPUT in CACHE-DIRECTORY."
-  (string-append cache-directory "/" (basename output) ".narinfo"))
+  (string-append cache-directory "/"
+                 default-compression
+                 "/" (basename output) ".narinfo"))
+
+(define (hash-path cache-directory store-hash)
+  (let ((hash (and=> (string-index store-hash #\-)
+                     (cut string-take store-hash <>))))
+    (string-append cache-directory "/hashes/" hash)))
+
+(define (write-hash cache-directory hash-file path)
+  (with-atomic-file-output hash-file
+    (lambda (port)
+      (display path port))))
 
 (define (log-path cache-directory output)
   (string-append cache-directory "/" (basename output) ".log"))
@@ -327,16 +343,23 @@ build server signature."
    (lambda (output)
      (let* ((path (derivation-output-path output))
             (store-hash (strip-store-prefix path))
+            (hash-file (hash-path cache-directory store-hash))
             (nar-file (nar-path cache-directory store-hash))
             (narinfo-file (narinfo-path cache-directory store-hash))
             (nar-url (publish-nar-url url store-hash))
             (narinfo-url (publish-narinfo-url url store-hash)))
+
        (unless (file-exists? nar-file)
+         (mkdir-p (dirname nar-file))
          (url-fetch nar-url nar-file))
 
        (unless (file-exists? narinfo-file)
          (url-fetch narinfo-url narinfo-file)
-         (sign-narinfo! narinfo-file))))
+         (sign-narinfo! narinfo-file))
+
+       (unless (file-exists? hash-file)
+         (mkdir-p (dirname hash-file))
+         (write-hash cache-directory hash-file path))))
    outputs))
 
 (define (download-log-file cache-directory derivation url)