Serve nar files for the derivation source files

2 files changed, 64 insertions, 27 deletions

diff --git a/guix-data-service/model/derivation.scm b/guix-data-service/model/derivation.scm
index 5e8e3cf..f26102c 100644
--- a/guix-data-service/model/derivation.scm
+++ b/guix-data-service/model/derivation.scm
@@ -41,6 +41,7 @@
             select-derivation-sources-by-derivation-id
             select-derivation-references-by-derivation-id
             select-derivation-source-file-by-store-path
+            select-derivation-source-file-nar-data-by-file-name
             select-derivation-by-output-filename
             select-derivations-using-output
             select-derivations-in-revision
@@ -804,6 +805,23 @@ WHERE store_path = $1")
 
   (map car (exec-query conn query (list store-path))))
 
+(define (select-derivation-source-file-nar-data-by-file-name conn file-name)
+  (match (exec-query
+          conn
+          "
+SELECT data
+FROM derivation_source_file_nars
+INNER JOIN derivation_source_files
+  ON derivation_source_file_nars.derivation_source_file_id =
+     derivation_source_files.id
+WHERE derivation_source_files.store_path = $1"
+          (list file-name))
+    (((data))
+     (base16-string->bytevector
+      ;; Drop \x from the start of the string
+      (string-drop data 2)))
+    (() #f)))
+
 (define (select-serialized-derivation-by-file-name conn derivation-file-name)
   (define (double-quote s)
     (string-append
diff --git a/guix-data-service/web/nar/controller.scm b/guix-data-service/web/nar/controller.scm
index 53419e0..781a01b 100644
--- a/guix-data-service/web/nar/controller.scm
+++ b/guix-data-service/web/nar/controller.scm
@@ -70,11 +70,16 @@
     (('GET "substitutes")
      (render-html
       #:sxml (view-substitutes (%narinfo-signing-public-key))))
-    (('GET "nar" derivation)
+    (('GET "nar" file-name)
      (render-nar request
                  mime-types
                  conn
-                 (string-append "/gnu/store/" derivation)))
+                 (string-append "/gnu/store/" file-name)))
+    (('GET "nar" "lzip" file-name)
+     (render-lzip-nar request
+                      mime-types
+                      conn
+                      (string-append "/gnu/store/" file-name)))
     (('GET (? .narinfo-suffix path))
      (let* ((hash (string-drop-right
                    path
@@ -126,31 +131,45 @@
 (define (render-nar request
                     mime-types
                     conn
-                    derivation-file-name)
-  (let ((derivation-text
-         (select-serialized-derivation-by-file-name
-          conn
-          derivation-file-name)))
-    (if derivation-text
-        (let ((derivation-bytevector
-               (string->bytevector derivation-text
-                                   "ISO-8859-1")))
-          (list (build-response
-                 #:code 200
-                 #:headers '((content-type . (application/x-nix-archive
-                                              (charset . "ISO-8859-1")))))
-                (lambda (port)
-                  (write-file-tree
-                   derivation-file-name
-                   port
-                   #:file-type+size
-                   (lambda (file)
-                     (values 'regular
-                             (bytevector-length derivation-bytevector)))
-                   #:file-port
-                   (lambda (file)
-                     (open-bytevector-input-port derivation-bytevector))))))
-        (not-found (request-uri request)))))
+                    file-name)
+  (or
+   (and=> (select-serialized-derivation-by-file-name conn
+                                                     file-name)
+          (lambda (derivation-text)
+            (let ((derivation-bytevector
+                   (string->bytevector derivation-text
+                                       "ISO-8859-1")))
+              (list (build-response
+                     #:code 200
+                     #:headers '((content-type . (application/x-nix-archive
+                                                  (charset . "ISO-8859-1")))))
+                    (lambda (port)
+                      (write-file-tree
+                      file-name
+                       port
+                       #:file-type+size
+                       (lambda (file)
+                         (values 'regular
+                                 (bytevector-length derivation-bytevector)))
+                       #:file-port
+                       (lambda (file)
+                         (open-bytevector-input-port derivation-bytevector))))))))
+   (not-found (request-uri request))))
+
+(define (render-lzip-nar request
+                         mime-types
+                         conn
+                         file-name)
+  (or
+   (and=> (select-derivation-source-file-nar-data-by-file-name conn file-name)
+          (lambda (data)
+            (list (build-response
+                   #:code 200
+                   #:headers '((content-type . (application/x-nix-archive
+                                                (charset . "ISO-8859-1")))))
+                  (lambda (port)
+                    (put-bytevector port data)))))
+   (not-found (request-uri request))))
 
 (define* (narinfo-string store-item
                          nar-bytevector