From d15ba4f25c0dfcc6ea8e03982819e217d5bb35b9 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 29 Dec 2019 09:34:12 +0000
Subject: Serve narinfo files for derivation sources

---
 guix-data-service/web/nar/controller.scm | 57 ++++++++++++++++++++++++++++++++
 1 file changed, 57 insertions(+)

(limited to 'guix-data-service/web/nar')

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)))
-- 
cgit v1.2.3