04/04: Set builds derivation output details set id if information available

[Christopher Baines]

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

commit 788571f53f7d4ec8b46a48f05dec73ec7d46453f
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Fri Jul 8 13:48:08 2022 +0100

    Set builds derivation output details set id if information available
    
    The build event information can now contain the derivation outputs, as well 
as
    the name of the derivation. This allows the Guix Data Service to join builds
    up with derivations, even if it doesn't know about the derivation being 
built.
---
 guix-data-service/model/build.scm                 | 26 +++++++++++++++++-
 guix-data-service/web/build-server/controller.scm | 32 +++++++++++++++++------
 2 files changed, 49 insertions(+), 9 deletions(-)

diff --git a/guix-data-service/model/build.scm 
b/guix-data-service/model/build.scm
index d6f911b..92d4969 100644
--- a/guix-data-service/model/build.scm
+++ b/guix-data-service/model/build.scm
@@ -23,6 +23,7 @@
   #:use-module (json)
   #:use-module (guix-data-service database)
   #:use-module (guix-data-service model utils)
+  #:use-module (guix-data-service model derivation)
   #:use-module (guix-data-service model system)
   #:export (select-build-stats
             select-builds-with-context
@@ -470,7 +471,10 @@ WHERE derivations.file_name = $1"
     (_
      #f)))
 
-(define (insert-builds conn build-server-id derivation-file-names
+(define (insert-builds conn
+                       build-server-id
+                       derivation-file-names
+                       derivation-output-details-lists
                        build-server-build-ids)
   (let ((build-ids
          (insert-missing-data-and-return-all-ids
@@ -487,6 +491,26 @@ WHERE derivations.file_name = $1"
                build-server-build-ids)
           #:delete-duplicates? #t)))
 
+    (for-each
+     (lambda (build-id derivation-output-details)
+       (and=>
+        derivation-output-details
+        (lambda (details)
+          (let ((derivation-output-details-set-id
+                 
(derivation-output-details-ids->derivation-output-details-set-id
+                  conn
+                  (derivation-output-details->derivation-output-details-ids
+                   conn
+                   details))))
+            (exec-query
+             conn
+             "
+UPDATE builds SET derivation_output_details_set_id = $1 WHERE id = $2"
+             (list (number->string derivation-output-details-set-id)
+                   (number->string build-id)))))))
+     build-ids
+     derivation-output-details-lists)
+
     (exec-query
      conn
      (string-append
diff --git a/guix-data-service/web/build-server/controller.scm 
b/guix-data-service/web/build-server/controller.scm
index a91a1b0..73b105f 100644
--- a/guix-data-service/web/build-server/controller.scm
+++ b/guix-data-service/web/build-server/controller.scm
@@ -120,14 +120,30 @@
   (define (handle-derivation-events conn items)
     (unless (null? items)
       (let ((build-ids
-             (insert-builds conn
-                            build-server-id
-                            (map (lambda (item)
-                                   (assoc-ref item "derivation"))
-                                 items)
-                            (map (lambda (item)
-                                   (assoc-ref item "build_id"))
-                                 items))))
+             (insert-builds
+              conn
+              build-server-id
+              (map (lambda (item)
+                     (assoc-ref item "derivation"))
+                   items)
+              (map (lambda (item)
+                     (and=>
+                      (assoc-ref item "derivation_outputs")
+                      (lambda (outputs)
+                        (map
+                         (lambda (output)
+                           `((path           . ,(assoc-ref output "output"))
+                             (hash_algorithm
+                              . ,(or (assoc-ref output "hash_algorithm")
+                                     NULL))
+                             (hash           . ,(or (assoc-ref output "hash")
+                                                    NULL))
+                             (recursive      . ,(assoc-ref output 
"recursive"))))
+                         (vector->list outputs)))))
+                   items)
+              (map (lambda (item)
+                     (assoc-ref item "build_id"))
+                   items))))
         (insert-build-statuses
          conn
          build-ids