branch master updated: Allow filtering package derivations based on build server builds

[Christopher Baines]

This is an automated email from the git hooks/post-receive script.

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

The following commit(s) were added to refs/heads/master by this push:
     new 6d403cb  Allow filtering package derivations based on build server 
builds
6d403cb is described below

commit 6d403cbc8d9b191ede4dc0a4d3bc7c81d17871ee
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Mon May 23 22:39:32 2022 +0100

    Allow filtering package derivations based on build server builds
    
    This means you can query for derivations where builds exist or don't exist 
on
    a given build server.
    
    I think this will come in useful when submitting builds from a Guix Data
    Service instance.
---
 guix-data-service/model/derivation.scm        | 52 +++++++++++++++++++++++++++
 guix-data-service/web/revision/controller.scm | 12 +++++++
 guix-data-service/web/revision/html.scm       | 16 +++++++++
 3 files changed, 80 insertions(+)

diff --git a/guix-data-service/model/derivation.scm 
b/guix-data-service/model/derivation.scm
index f09435e..a6a0944 100644
--- a/guix-data-service/model/derivation.scm
+++ b/guix-data-service/model/derivation.scm
@@ -191,6 +191,8 @@ ORDER BY systems.system DESC,
                                                  targets
                                                  minimum-builds
                                                  maximum-builds
+                                                 build-from-build-servers
+                                                 no-build-from-build-servers
                                                  limit-results
                                                  after-name
                                                  (include-builds? #t)
@@ -238,6 +240,30 @@ ORDER BY systems.system DESC,
 ) <= "
                (number->string maximum-builds)))
              '())
+       ,@(map
+          (lambda (build-server-id)
+            (string-append
+             "
+EXISTS(
+  SELECT 1
+  FROM builds
+  WHERE builds.derivation_output_details_set_id =
+        derivations_by_output_details_set.derivation_output_details_set_id
+    AND builds.build_server_id = " (number->string build-server-id) "
+)"))
+          (or build-from-build-servers '()))
+       ,@(map
+          (lambda (build-server-id)
+            (string-append
+             "
+NOT EXISTS(
+  SELECT 1
+  FROM builds
+  WHERE builds.derivation_output_details_set_id =
+        derivations_by_output_details_set.derivation_output_details_set_id
+    AND builds.build_server_id = " (number->string build-server-id) "
+)"))
+          (or no-build-from-build-servers '()))
        ,@(cond
           ((eq? build-status #f) '())
           ((eq? build-status 'failing)
@@ -382,6 +408,8 @@ ORDER BY derivations.file_name
                                                  targets
                                                  minimum-builds
                                                  maximum-builds
+                                                 build-from-build-servers
+                                                 no-build-from-build-servers
                                                  limit-results
                                                  after-name
                                                  (include-builds? #t)
@@ -429,6 +457,30 @@ ORDER BY derivations.file_name
 ) <= "
                (number->string maximum-builds)))
              '())
+       ,@(map
+          (lambda (build-server-id)
+            (string-append
+             "
+EXISTS(
+  SELECT 1
+  FROM builds
+  WHERE builds.derivation_output_details_set_id =
+        derivations_by_output_details_set.derivation_output_details_set_id
+    AND builds.build_server_id = " (number->string build-server-id) "
+)"))
+          (or build-from-build-servers '()))
+       ,@(map
+          (lambda (build-server-id)
+            (string-append
+             "
+NOT EXISTS(
+  SELECT 1
+  FROM builds
+  WHERE builds.derivation_output_details_set_id =
+        derivations_by_output_details_set.derivation_output_details_set_id
+    AND builds.build_server_id = " (number->string build-server-id) "
+)"))
+          (or no-build-from-build-servers '()))
        ,@(cond
           ((eq? build-status #f) '())
           ((eq? build-status 'failing)
diff --git a/guix-data-service/web/revision/controller.scm 
b/guix-data-service/web/revision/controller.scm
index 205f8ab..b1790be 100644
--- a/guix-data-service/web/revision/controller.scm
+++ b/guix-data-service/web/revision/controller.scm
@@ -206,6 +206,10 @@
                     (target ,parse-target #:multi-value)
                     (maximum_builds ,parse-number)
                     (minimum_builds ,parse-number)
+                    (build_from_build_server ,parse-number
+                                             #:multi-value)
+                    (no_build_from_build_server ,parse-number
+                                                #:multi-value)
                     (build_status   ,parse-derivation-build-status)
                     (field          ,identity #:multi-value
                                     #:default ("system" "target" "builds"))
@@ -1053,6 +1057,10 @@
                       #:targets (assq-ref query-parameters 'target)
                       #:maximum-builds (assq-ref query-parameters 
'maximum_builds)
                       #:minimum-builds (assq-ref query-parameters 
'minimum_builds)
+                      #:build-from-build-servers (assq-ref query-parameters
+                                                           
'build_from_build_server)
+                      #:no-build-from-build-servers (assq-ref query-parameters
+                                                              
'no_build_from_build_server)
                       #:build-status (and=> (assq-ref query-parameters
                                                       'build_status)
                                             string->symbol)
@@ -1066,6 +1074,10 @@
                       #:targets (assq-ref query-parameters 'target)
                       #:maximum-builds (assq-ref query-parameters 
'maximum_builds)
                       #:minimum-builds (assq-ref query-parameters 
'minimum_builds)
+                      #:build-from-build-servers (assq-ref query-parameters
+                                                           
'build_from_build_server)
+                      #:no-build-from-build-servers (assq-ref query-parameters
+                                                              
'no_build_from_build_server)
                       #:build-status (and=> (assq-ref query-parameters
                                                       'build_status)
                                             string->symbol)
diff --git a/guix-data-service/web/revision/html.scm 
b/guix-data-service/web/revision/html.scm
index 6b69e4a..013674d 100644
--- a/guix-data-service/web/revision/html.scm
+++ b/guix-data-service/web/revision/html.scm
@@ -1548,6 +1548,12 @@ figure {
       ("Failing" . "failing")
       ("Unknown" . "unknown")))
 
+  (define build-server-options
+    (map (match-lambda
+           ((id . url)
+            (cons url id)))
+         build-server-urls))
+
   (define field-options
     (map
      (lambda (field)
@@ -1606,6 +1612,16 @@ figure {
           ,(form-horizontal-control
             "Maximum builds" query-parameters
             #:help-text "Only show derivations with a maximum number of known 
builds.")
+          ,(form-horizontal-control
+            "Build from build server" query-parameters
+            #:options build-server-options
+            #:help-text ""
+            #:font-family "monospace")
+          ,(form-horizontal-control
+            "No build from build server" query-parameters
+            #:options build-server-options
+            #:help-text ""
+            #:font-family "monospace")
           ,(form-horizontal-control
             "Build status" query-parameters
             #:allow-selecting-multiple-options #f