Serve narinfo files for derivation sources

2 files changed, 83 insertions, 0 deletions

diff --git a/guix-data-service/model/derivation.scm b/guix-data-service/model/derivation.scm
index f26102c..692b3fe 100644
--- a/guix-data-service/model/derivation.scm
+++ b/guix-data-service/model/derivation.scm
@@ -42,6 +42,7 @@
             select-derivation-references-by-derivation-id
             select-derivation-source-file-by-store-path
             select-derivation-source-file-nar-data-by-file-name
+            select-derivation-source-file-data-by-file-name-hash
             select-derivation-by-output-filename
             select-derivations-using-output
             select-derivations-in-revision
@@ -805,6 +806,31 @@ WHERE store_path = $1")
 
   (map car (exec-query conn query (list store-path))))
 
+(define (select-derivation-source-file-data-by-file-name-hash conn hash)
+  (match (exec-query
+          conn
+          "
+SELECT derivation_source_files.store_path,
+       derivation_source_file_nars.compression,
+       length(derivation_source_file_nars.data) AS compressed_size,
+       derivation_source_file_nars.hash_algorithm,
+       derivation_source_file_nars.hash,
+       derivation_source_file_nars.uncompressed_size
+FROM derivation_source_file_nars
+INNER JOIN derivation_source_files
+  ON derivation_source_file_nars.derivation_source_file_id =
+     derivation_source_files.id
+WHERE substring(derivation_source_files.store_path from 12 for 32) = $1"
+          (list hash))
+    (((store_path compression compressed_size hash_algorithm hash uncompressed_size))
+     (list store_path
+           compression
+           (string->number compressed_size)
+           hash_algorithm
+           hash
+           (string->number uncompressed_size)))
+    (() #f)))
+
 (define (select-derivation-source-file-nar-data-by-file-name conn file-name)
   (match (exec-query
           conn
diff --git a/guix-data-service/web/nar/controller.scm b/guix-data-service/web/nar/controller.scm
index 9c46eb5..b3c9f39 100644
--- a/guix-data-service/web/nar/controller.scm
+++ b/guix-data-service/web/nar/controller.scm
@@ -174,6 +174,22 @@
                                                nar-bytevector
                                                derivation-references)
                                port))))))
+   (and=> (select-derivation-source-file-data-by-file-name-hash conn
+                                                                hash)
+          (match-lambda
+            ((store-path compression compressed-size
+                         hash-algorithm hash uncompressed-size)
+             (list (build-response
+                    #:code 200
+                    #:headers '((content-type . (application/x-narinfo))))
+                   (lambda (port)
+                     (display (derivation-source-file-narinfo-string store-path
+                                                                     compression
+                                                                     compressed-size
+                                                                     hash-algorithm
+                                                                     hash
+                                                                     uncompressed-size)
+                              port))))))
    (not-found (request-uri request))))
 
 
@@ -217,3 +233,44 @@ References: ~a~%"
                  (string->utf8
                   (canonical-sexp->string (signed-string info)))))
         info)))
+
+(define* (derivation-source-file-narinfo-string store-item
+                                                compression
+                                                compressed-size
+                                                hash-algorithm
+                                                hash
+                                                uncompressed-size
+                                                #:key (nar-path "nar"))
+  (define (signed-string s)
+    (let* ((public-key (%narinfo-signing-public-key))
+           (hash (bytevector->hash-data (sha256 (string->utf8 s))
+                                        #:key-type (key-type public-key))))
+      (signature-sexp hash (%narinfo-signing-private-key) public-key)))
+
+  (let* ((info (format #f
+                             "\
+StorePath: ~a
+URL: ~a
+Compression: ~a
+FileSize: ~d
+NarHash: ~a:~a
+NarSize: ~d
+References: ~%"
+                             store-item
+                             (encode-and-join-uri-path
+                              (list nar-path
+                                    compression
+                                    (basename store-item)))
+                             compression
+                             compressed-size
+                             hash-algorithm
+                             hash
+                             uncompressed-size)))
+    (if (%narinfo-signing-private-key)
+        (format #f "~aSignature: 1;~a;~a~%"
+                info
+                (gethostname)
+                (base64-encode
+                 (string->utf8
+                  (canonical-sexp->string (signed-string info)))))
+        info)))