03/04: Include output information in the package page response

[Christopher Baines]

cbaines pushed a commit to branch master
in repository data-service.

commit 03327c0cc325ea432fac5fb55a19a0aa9ae4e93b
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Sun Nov 5 13:43:54 2023 +0000

    Include output information in the package page response
    
    As this will be useful for QA to say whether the package builds reproducibly
    or not.
---
 guix-data-service/model/derivation.scm        | 26 +++++++++++++++++
 guix-data-service/web/revision/controller.scm | 42 ++++++++++++++++++++++-----
 guix-data-service/web/revision/html.scm       |  2 +-
 3 files changed, 62 insertions(+), 8 deletions(-)

diff --git a/guix-data-service/model/derivation.scm 
b/guix-data-service/model/derivation.scm
index 98c2178..4efda3a 100644
--- a/guix-data-service/model/derivation.scm
+++ b/guix-data-service/model/derivation.scm
@@ -44,6 +44,7 @@
             select-derivation-by-file-name
             select-derivation-by-file-name-hash
             select-derivation-outputs-by-derivation-id
+            select-derivation-outputs-by-derivation-file-name
             select-derivation-sources-by-derivation-id
             select-derivation-references-by-derivation-id
             select-derivation-source-file-by-store-path
@@ -1158,6 +1159,31 @@ ORDER BY derivation_outputs.name"))
             (string=? recursive "t"))))
    (exec-query conn query (list (number->string id)))))
 
+(define (select-derivation-outputs-by-derivation-file-name conn file-name)
+  (define query
+    (string-append
+     "
+SELECT derivation_outputs.name, derivation_output_details.path,
+  derivation_output_details.hash_algorithm, derivation_output_details.hash,
+  derivation_output_details.recursive
+FROM derivation_outputs
+INNER JOIN derivation_output_details ON
+  derivation_outputs.derivation_output_details_id = 
derivation_output_details.id
+INNER JOIN derivations
+  ON derivation_outputs.derivation_id = derivations.id
+WHERE derivations.file_name = $1
+ORDER BY derivation_outputs.name"))
+
+  (map
+   (match-lambda
+     ((name path hash_algorithm hash recursive)
+      (list name
+            path
+            hash_algorithm
+            hash
+            (string=? recursive "t"))))
+   (exec-query conn query (list file-name))))
+
 (define (select-derivation-inputs-by-derivation-id conn id)
   (define query
     (string-append
diff --git a/guix-data-service/web/revision/controller.scm 
b/guix-data-service/web/revision/controller.scm
index f55b0e0..938f55c 100644
--- a/guix-data-service/web/revision/controller.scm
+++ b/guix-data-service/web/revision/controller.scm
@@ -927,11 +927,38 @@
                 locale)))
             (derivations
              (with-resource-from-pool (connection-pool) conn
-               (select-derivations-by-revision-name-and-version
-                conn
-                commit-hash
-                name
-                version)))
+               (map
+                (lambda (derivation-details)
+                  (append
+                   derivation-details
+                   (list
+                    (map
+                     (match-lambda
+                       ((name path hash-algorithm hash recursive?)
+                        `((name . ,name)
+                          (path . ,path)
+                          (hash_algorithm . ,hash-algorithm)
+                          (hash . ,hash)
+                          (recursive? . ,recursive?)
+                          (nars
+                           . ,(list->vector
+                               (map (match-lambda
+                                      ((hash-algorithm hash size
+                                                       urls signatures)
+                                       `((hash . ((algorithm . ,hash-algorithm)
+                                                  (value . ,hash)))
+                                         (size . ,size))))
+                                    (select-nars-for-output
+                                     conn
+                                     path)))))))
+                     (select-derivation-outputs-by-derivation-file-name
+                      conn
+                      (third derivation-details))))))
+                (select-derivations-by-revision-name-and-version
+                 conn
+                 commit-hash
+                 name
+                 version))))
             (git-repositories
              (with-resource-from-pool (connection-pool) conn
                (git-repositories-containing-commit conn
@@ -959,10 +986,11 @@
                  (home-page . ,home-page))))
           (derivations . ,(list->vector
                            (map (match-lambda
-                                  ((system target file-name status)
+                                  ((system target file-name status outputs)
                                    `((system . ,system)
                                      (target . ,target)
-                                     (derivation . ,file-name))))
+                                     (derivation . ,file-name)
+                                     (outputs . ,(list->vector outputs)))))
                                 derivations))))
         #:extra-headers http-headers-for-unchanging-content))
       (else
diff --git a/guix-data-service/web/revision/html.scm 
b/guix-data-service/web/revision/html.scm
index 0f1717e..6081c69 100644
--- a/guix-data-service/web/revision/html.scm
+++ b/guix-data-service/web/revision/html.scm
@@ -297,7 +297,7 @@
          (tbody
           ,@(map
              (match-lambda
-               ((system target file-name builds)
+               ((system target file-name builds outputs)
                 `(tr
                   (td (samp ,system))
                   (td (samp ,target))