branch master updated: Add a lookup_builds field to the build_servers table

[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 b6754c8  Add a lookup_builds field to the build_servers table
b6754c8 is described below

commit b6754c8a4c1135a803fa72fbf4208d46c301b105
Author: Christopher Baines <address@hidden>
AuthorDate: Sun May 24 17:02:53 2020 +0100

    Add a lookup_builds field to the build_servers table
    
    This is to allow for build servers where only the substitutes should be
    queried, and it shouldn't be assumed that they're running Cuirass.
---
 guix-data-service/builds.scm                      |  4 ++--
 guix-data-service/model/build-server.scm          | 21 +++++++++++++++------
 guix-data-service/substitutes.scm                 |  2 +-
 guix-data-service/web/build-server/html.scm       |  6 +++++-
 guix-data-service/web/build/controller.scm        |  2 +-
 guix-data-service/web/repository/controller.scm   | 12 ++----------
 guix-data-service/web/revision/controller.scm     | 23 ++++++-----------------
 scripts/guix-data-service-manage-build-servers.in |  2 +-
 sqitch/deploy/build_servers_lookup_builds.sql     |  7 +++++++
 sqitch/revert/build_servers_lookup_builds.sql     |  7 +++++++
 sqitch/sqitch.plan                                |  1 +
 sqitch/verify/build_servers_lookup_builds.sql     |  7 +++++++
 12 files changed, 55 insertions(+), 39 deletions(-)

diff --git a/guix-data-service/builds.scm b/guix-data-service/builds.scm
index 2c37885..c3421b9 100644
--- a/guix-data-service/builds.scm
+++ b/guix-data-service/builds.scm
@@ -135,11 +135,11 @@ initial connection on which HTTP requests are sent."
       (let ((build-servers (select-build-servers conn)))
         (for-each
          (match-lambda
-           ((id url lookup-all-derivations?)
+           ((id url lookup-all-derivations? lookup-builds?)
             (when (or (or (not build-servers)
                           (not build-server-ids))
                       (member id build-server-ids))
-              (when lookup-all-derivations?
+              (when lookup-builds?
                 (simple-format #t "\nQuerying ~A\n" url)
                 (catch #t
                   (lambda ()
diff --git a/guix-data-service/model/build-server.scm 
b/guix-data-service/model/build-server.scm
index 44b4b7d..a03410d 100644
--- a/guix-data-service/model/build-server.scm
+++ b/guix-data-service/model/build-server.scm
@@ -19,21 +19,23 @@
   #:use-module (ice-9 match)
   #:use-module (squee)
   #:export (select-build-servers
-            select-build-server))
+            select-build-server
+            select-build-server-urls-by-id))
 
 (define (select-build-servers conn)
   (define query
     "
-SELECT id, url, lookup_all_derivations
+SELECT id, url, lookup_all_derivations, lookup_builds
 FROM build_servers
 ORDER BY id")
 
   (map
    (match-lambda
-     ((id url lookup-all-derivations)
+     ((id url lookup-all-derivations lookup-builds)
       (list (string->number id)
             url
-            (string=? lookup-all-derivations "t"))))
+            (string=? lookup-all-derivations "t")
+            (string=? lookup-builds))))
    (exec-query conn query)))
 
 (define (select-build-server conn id)
@@ -46,6 +48,13 @@ WHERE id = $1")
   (match (exec-query conn query (list (number->string id)))
     (()
      #f)
-    (((url lookup_all_derivations))
+    (((url lookup_all_derivations lookup_builds))
      (list url
-           (string=? lookup_all_derivations "t")))))
+           (string=? lookup_all_derivations "t")
+           (string=? lookup_builds "t")))))
+
+(define (select-build-server-urls-by-id conn)
+  (map (match-lambda
+         ((id url lookup-all-derivations? lookup-builds?)
+          (cons id url)))
+       (select-build-servers conn)))
diff --git a/guix-data-service/substitutes.scm 
b/guix-data-service/substitutes.scm
index 6dd069e..b6c29f2 100644
--- a/guix-data-service/substitutes.scm
+++ b/guix-data-service/substitutes.scm
@@ -35,7 +35,7 @@
       (let ((build-servers (select-build-servers conn)))
         (for-each
          (match-lambda
-           ((id url lookup-all-derivations?)
+           ((id url lookup-all-derivations? lookup-builds?)
             (when (or (or (not build-servers)
                           (not build-server-ids))
                       (member id build-server-ids))
diff --git a/guix-data-service/web/build-server/html.scm 
b/guix-data-service/web/build-server/html.scm
index bb15e11..319ab79 100644
--- a/guix-data-service/web/build-server/html.scm
+++ b/guix-data-service/web/build-server/html.scm
@@ -103,7 +103,7 @@
         (h2 "Build servers")
         ,@(map
            (match-lambda
-             ((id url lookup-all-derivations?)
+             ((id url lookup-all-derivations? lookup-builds?)
               `(dl
                 (@ (class "dl-horizontal"))
                 (dt "URL")
@@ -112,6 +112,10 @@
                 (dt "Lookup all " (br) "derivations?")
                 (dd ,(if lookup-all-derivations?
                          "Yes"
+                         "No"))
+                (dt "Lookup " (br) "builds?")
+                (dd ,(if lookup-builds?
+                         "Yes"
                          "No")))))
            build-servers)))))))
 
diff --git a/guix-data-service/web/build/controller.scm 
b/guix-data-service/web/build/controller.scm
index e7d1399..a79d558 100644
--- a/guix-data-service/web/build/controller.scm
+++ b/guix-data-service/web/build/controller.scm
@@ -38,7 +38,7 @@
   (lambda (v)
     (let ((build-servers (select-build-servers conn)))
       (or (any (match-lambda
-                 ((id url lookup-all-derivations?)
+                 ((id url lookup-all-derivations? lookup-builds?)
                   (if (eq? (string->number v)
                            id)
                       id
diff --git a/guix-data-service/web/repository/controller.scm 
b/guix-data-service/web/repository/controller.scm
index 88739d5..0f8a5e7 100644
--- a/guix-data-service/web/repository/controller.scm
+++ b/guix-data-service/web/repository/controller.scm
@@ -295,11 +295,7 @@
                                             target
                                             package-name))
            (build-server-urls
-           (group-to-alist
-            (match-lambda
-              ((id url lookup-all-derivations)
-               (cons id url)))
-            (select-build-servers conn))))
+            (select-build-server-urls-by-id conn)))
       (case (most-appropriate-mime-type
              '(application/json text/html)
              mime-types)
@@ -364,11 +360,7 @@
                                         package-name
                                         output-name))
            (build-server-urls
-            (group-to-alist
-             (match-lambda
-               ((id url lookup-all-derivations)
-                (cons id url)))
-             (select-build-servers conn))))
+            (select-build-server-urls-by-id conn)))
       (case (most-appropriate-mime-type
              '(application/json text/html)
              mime-types)
diff --git a/guix-data-service/web/revision/controller.scm 
b/guix-data-service/web/revision/controller.scm
index 0dc6eb4..f5ed8f0 100644
--- a/guix-data-service/web/revision/controller.scm
+++ b/guix-data-service/web/revision/controller.scm
@@ -77,7 +77,7 @@
   (lambda (v)
     (let ((build-servers (select-build-servers conn)))
       (or (any (match-lambda
-                 ((id url lookup-all-derivations?)
+                 ((id url lookup-all-derivations? lookup-builds?)
                   (if (eq? (string->number v)
                            id)
                       id
@@ -454,11 +454,7 @@
   (let ((substitute-availability
          (select-package-output-availability-for-revision conn commit-hash))
         (build-server-urls
-         (group-to-alist
-          (match-lambda
-            ((id url lookup-all-derivations)
-             (cons id url)))
-          (select-build-servers conn))))
+         (select-build-server-urls-by-id conn)))
     (case (most-appropriate-mime-type
            '(application/json text/html)
            mime-types)
@@ -796,11 +792,7 @@
                    #:after-name (assq-ref query-parameters 'after_name)
                    #:include-builds? (member "builds" fields))))
              (build-server-urls
-              (group-to-alist
-               (match-lambda
-                 ((id url lookup-all-derivations)
-                  (cons id url)))
-               (select-build-servers conn)))
+              (select-build-server-urls-by-id conn))
              (show-next-page?
               (if all-results
                   #f
@@ -898,11 +890,7 @@
                #:limit-results limit-results
                #:after-path (assq-ref query-parameters 'after_path)))
              (build-server-urls
-              (group-to-alist
-               (match-lambda
-                 ((id url lookup-all-derivations)
-                  (cons id url)))
-               (select-build-servers conn)))
+              (select-build-server-urls-by-id conn))
              (show-next-page?
               (if all-results
                   #f
@@ -960,7 +948,8 @@
                                       (valid-targets->options
                                        (valid-targets conn))
                                       (map (match-lambda
-                                             ((id url lookup-all-derivations)
+                                             ((id url lookup-all-derivations
+                                                  lookup-builds)
                                               (cons url id)))
                                            (select-build-servers conn))
                                       (select-build-stats
diff --git a/scripts/guix-data-service-manage-build-servers.in 
b/scripts/guix-data-service-manage-build-servers.in
index b994e2b..0ca1706 100644
--- a/scripts/guix-data-service-manage-build-servers.in
+++ b/scripts/guix-data-service-manage-build-servers.in
@@ -54,7 +54,7 @@
    (lambda (conn)
      (for-each
       (match-lambda
-        ((id url lookup-all-derivations?)
+        ((id url lookup-all-derivations? lookup-builds?)
          (simple-format #t "\nBuild server: ~A (id: ~A)\n"
                         url
                         id)
diff --git a/sqitch/deploy/build_servers_lookup_builds.sql 
b/sqitch/deploy/build_servers_lookup_builds.sql
new file mode 100644
index 0000000..dc16602
--- /dev/null
+++ b/sqitch/deploy/build_servers_lookup_builds.sql
@@ -0,0 +1,7 @@
+-- Deploy guix-data-service:build_servers_lookup_builds to pg
+
+BEGIN;
+
+ALTER TABLE build_servers ADD COLUMN lookup_builds boolean NOT NULL DEFAULT 
TRUE;
+
+COMMIT;
diff --git a/sqitch/revert/build_servers_lookup_builds.sql 
b/sqitch/revert/build_servers_lookup_builds.sql
new file mode 100644
index 0000000..62f55a1
--- /dev/null
+++ b/sqitch/revert/build_servers_lookup_builds.sql
@@ -0,0 +1,7 @@
+-- Revert guix-data-service:build_servers_lookup_builds from pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan
index ab6ce17..6e73371 100644
--- a/sqitch/sqitch.plan
+++ b/sqitch/sqitch.plan
@@ -57,3 +57,4 @@ drop_package_versions_by_guix_revision_range 
2020-03-24T20:40:38Z Christopher Ba
 create_narinfo_fetch_records_index 2020-03-25T19:07:28Z Christopher Baines 
<address@hidden> # Create an index on narinfo_fetch_records
 load_new_guix_revision_jobs_make_commits_unique 2020-03-27T21:38:42Z 
Christopher Baines <address@hidden> # Make load_new_guix_revision_jobs commits 
unique
 remove_odd_package_derivations 2020-04-24T20:36:06Z Christopher Baines 
<address@hidden> # Remove odd package derivations
+build_servers_lookup_builds 2020-05-24T15:18:09Z Christopher Baines 
<address@hidden> # Add build_servers.lookup_builds
diff --git a/sqitch/verify/build_servers_lookup_builds.sql 
b/sqitch/verify/build_servers_lookup_builds.sql
new file mode 100644
index 0000000..7db4be7
--- /dev/null
+++ b/sqitch/verify/build_servers_lookup_builds.sql
@@ -0,0 +1,7 @@
+-- Verify guix-data-service:build_servers_lookup_builds on pg
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;