From d29e17855ddf86f97a88f04cb35c3204c50521d1 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 15 Dec 2019 21:52:30 +0000
Subject: WIP

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

(limited to 'guix-data-service/web/revision/controller.scm')

diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm
index bc49703..5cb9623 100644
--- a/guix-data-service/web/revision/controller.scm
+++ b/guix-data-service/web/revision/controller.scm
@@ -43,6 +43,7 @@
   #:use-module (guix-data-service model lint-checker)
   #:use-module (guix-data-service model lint-warning)
   #:use-module (guix-data-service model guix-revision)
+  #:use-module (guix-data-service model nar)
   #:use-module (guix-data-service web revision html)
   #:export (revision-controller
 
@@ -216,6 +217,15 @@
          (render-unknown-revision mime-types
                                   conn
                                   commit-hash)))
+    (('GET "revision" commit-hash "package-reproducibility")
+     (if (guix-commit-exists? conn commit-hash)
+         (render-revision-package-reproduciblity mime-types
+                                                 conn
+                                                 commit-hash
+                                                 #:path-base path)
+         (render-unknown-revision mime-types
+                                  conn
+                                  commit-hash)))
     (('GET "revision" commit-hash "builds")
      (if (guix-commit-exists? conn commit-hash)
          (let ((parsed-query-parameters
@@ -330,6 +340,25 @@
                 #:header-text header-text)
         #:extra-headers http-headers-for-unchanging-content)))))
 
+(define* (render-revision-package-reproduciblity mime-types
+                                                 conn
+                                                 commit-hash
+                                                 #:key path-base)
+  (let ((reproducibility-status
+         (peek (select-reproducibility-status-for-revision conn commit-hash))))
+    (case (most-appropriate-mime-type
+           '(application/json text/html)
+           mime-types)
+      ((application/json)
+       (render-json
+        '()))
+      (else
+       (render-html
+        #:sxml (view-revision-package-reproducibility
+                commit-hash
+                reproducibility-status
+                #:header-text '("Package reproducibility status")))))))
+
 (define (render-revision-news mime-types
                               conn
                               commit-hash
-- 
cgit v1.2.3