aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--guix-data-service/builds.scm4
-rw-r--r--guix-data-service/model/build-server.scm21
-rw-r--r--guix-data-service/substitutes.scm2
-rw-r--r--guix-data-service/web/build-server/html.scm6
-rw-r--r--guix-data-service/web/build/controller.scm2
-rw-r--r--guix-data-service/web/repository/controller.scm12
-rw-r--r--guix-data-service/web/revision/controller.scm23
-rw-r--r--scripts/guix-data-service-manage-build-servers.in2
-rw-r--r--sqitch/deploy/build_servers_lookup_builds.sql7
-rw-r--r--sqitch/revert/build_servers_lookup_builds.sql7
-rw-r--r--sqitch/sqitch.plan1
-rw-r--r--sqitch/verify/build_servers_lookup_builds.sql7
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 <mail@cbaines.net> # Create an index on narinfo_fetch_records
load_new_guix_revision_jobs_make_commits_unique 2020-03-27T21:38:42Z Christopher Baines <mail@cbaines.net> # Make load_new_guix_revision_jobs commits unique
remove_odd_package_derivations 2020-04-24T20:36:06Z Christopher Baines <mail@cbaines.net> # Remove odd package derivations
+build_servers_lookup_builds 2020-05-24T15:18:09Z Christopher Baines <mail@cbaines.net> # 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;
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-21 14:40:32 +0000