diff --git a/Makefile.am b/Makefile.am index 3cf1db3..bf4cefe 100644 --- a/Makefile.am +++ b/Makefile.am @@ -81,10 +81,11 @@ SOURCES = \ guix-data-service/data-deletion.scm \ guix-data-service/jobs.scm \ guix-data-service/jobs/load-new-guix-revision.scm \ - guix-data-service/model/build-server.scm \ - guix-data-service/model/build-server-token-seed.scm \ - guix-data-service/model/build-status.scm \ guix-data-service/model/blocked-builds.scm \ + guix-data-service/model/build-background-processing-queue.scm \ + guix-data-service/model/build-server-token-seed.scm \ + guix-data-service/model/build-server.scm \ + guix-data-service/model/build-status.scm \ guix-data-service/model/build.scm \ guix-data-service/model/channel-instance.scm \ guix-data-service/model/channel-news.scm \ diff --git a/guix-data-service/model/build-background-processing-queue.scm b/guix-data-service/model/build-background-processing-queue.scm new file mode 100644 index 0000000..ab9affa --- /dev/null +++ b/guix-data-service/model/build-background-processing-queue.scm @@ -0,0 +1,53 @@ +;;; Guix Data Service -- Information about Guix over time +;;; Copyright © 2019 Christopher Baines +;;; +;;; This program is free software: you can redistribute it and/or +;;; modify it under the terms of the GNU Affero General Public License +;;; as published by the Free Software Foundation, either version 3 of +;;; the License, or (at your option) any later version. +;;; +;;; This program is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the GNU Affero General Public +;;; License along with this program. If not, see +;;; . + +(define-module (guix-data-service model build-background-processing-queue) + #:use-module (squee) + #:export (insert-background-processing-entries-for-build-ids + delete-background-processing-entries-for-build-ids + select-background-processing-build-ids)) + +(define (insert-background-processing-entries-for-build-ids conn + build-ids) + (exec-query + conn + (string-append + " +INSERT INTO build_background_processing_queue (build_id) VALUES (" + (string-join (map number->string build-ids) + ",") + ") ON CONFLICT DO NOTHING"))) + +(define (delete-background-processing-entries-for-build-ids conn + build-ids) + (for-each + (lambda (build-id) + (exec-query + conn + " +DELETE FROM build_background_processing_queue WHERE build_id = $1" + (list (number->string build-id)))) + build-ids)) + +(define (select-background-processing-build-ids conn) + (map + (lambda (row) + (string->number (car row))) + (exec-query + conn + " +SELECT build_id FROM build_background_processing_queue"))) diff --git a/guix-data-service/model/build-status.scm b/guix-data-service/model/build-status.scm index 4a2a801..bbf079f 100644 --- a/guix-data-service/model/build-status.scm +++ b/guix-data-service/model/build-status.scm @@ -23,6 +23,7 @@ #:export (build-statuses build-status-strings select-build-statuses-by-build-id + select-latest-build-status-by-build-id insert-build-status insert-build-statuses)) @@ -52,6 +53,15 @@ WHERE builds.build_server_id = $1 AND (exec-query conn query (list (number->string build-server-id) (number->string build-id)))) +(define (select-latest-build-status-by-build-id conn build-id) + (define query + " +SELECT timestamp, status +FROM latest_build_status +WHERE build_id = $1") + + (exec-query conn query (list (number->string build-id)))) + (define (insert-build-status conn build-id timestamp status) (insert-build-statuses conn diff --git a/guix-data-service/web/build-server/controller.scm b/guix-data-service/web/build-server/controller.scm index 473cc61..356935f 100644 --- a/guix-data-service/web/build-server/controller.scm +++ b/guix-data-service/web/build-server/controller.scm @@ -38,6 +38,7 @@ #:use-module (guix-data-service model build-server) #:use-module (guix-data-service model build-status) #:use-module (guix-data-service model blocked-builds) + #:use-module (guix-data-service model build-background-processing-queue) #:use-module (guix-data-service model nar) #:use-module (guix-data-service model build-server-token-seed) #:use-module (guix-data-service web util) @@ -234,10 +235,19 @@ build-ids '("succeeded") (lambda (ids) + (with-resource-from-pool (reserved-connection-pool) conn + (with-postgresql-transaction + conn + (lambda (conn) + (insert-background-processing-entries-for-build-ids conn + ids)))) (spawn-fiber-for-handler (lambda (conn) + ;; This won't happen if the data service is restarted (handle-removing-blocking-build-entries-for-successful-builds - conn ids))) + conn ids) + + (delete-background-processing-entries-for-build-ids conn ids))) (request-query-of-build-server-substitutes build-server-id ids))) @@ -247,18 +257,32 @@ build-ids '("scheduled") (lambda (ids) + (with-resource-from-pool (reserved-connection-pool) conn + (with-postgresql-transaction + conn + (lambda (conn) + (insert-background-processing-entries-for-build-ids conn + ids)))) (spawn-fiber-for-handler (lambda (conn) - (handle-blocked-builds-entries-for-scheduled-builds conn ids))))) + (handle-blocked-builds-entries-for-scheduled-builds conn ids) + (delete-background-processing-entries-for-build-ids conn ids))))) (with-build-ids-for-status items build-ids '("failed" "failed-dependency" "canceled") (lambda (ids) + (with-resource-from-pool (reserved-connection-pool) conn + (with-postgresql-transaction + conn + (lambda (conn) + (insert-background-processing-entries-for-build-ids conn + ids)))) (spawn-fiber-for-handler (lambda (conn) - (handle-populating-blocked-builds-for-build-failures conn ids))))))) + (handle-populating-blocked-builds-for-build-failures conn ids) + (delete-background-processing-entries-for-build-ids conn ids))))))) (if (any-invalid-query-parameters? parsed-query-parameters) (render-json diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm index f4430d2..9782bd7 100644 --- a/guix-data-service/web/server.scm +++ b/guix-data-service/web/server.scm @@ -42,7 +42,10 @@ #:use-module (guix-data-service web util) #:use-module (guix-data-service web render) #:use-module (guix-data-service web view html) + #:use-module (guix-data-service model build-status) + #:use-module (guix-data-service model blocked-builds) #:use-module (guix-data-service model guix-revision-package-derivation) + #:use-module (guix-data-service model build-background-processing-queue) #:export (%guix-data-service-metrics-registry start-guix-data-service-web-server)) @@ -239,6 +242,44 @@ port. Also, the port used can be changed by passing the --port option.\n" resource-pool-checkout-failures-metric #:label-values `((pool_name . ,pool-name)))))))) + (spawn-fiber + (lambda () + (while (not (check-startup-completed startup-completed)) + (sleep 1)) + + (call-with-resource-from-pool (background-connection-pool) + (lambda (conn) + (let ((build-ids + (select-background-processing-build-ids conn))) + (unless (null? build-ids) + (simple-format #t "processing ~A builds from the background queue\n" + (length build-ids))) + (for-each + (lambda (build-id) + (let ((status (select-latest-build-status-by-build-id + conn + build-id))) + (cond + ((string=? status "succeeded") + (handle-removing-blocking-build-entries-for-successful-builds + conn + (list build-id))) + ((string=? status "scheduled") + (handle-blocked-builds-entries-for-scheduled-builds + conn + (list build-id))) + ((member status '("failed" + "failed-dependency" + "canceled")) + (handle-populating-blocked-builds-for-build-failures + conn + (list build-id))))) + (delete-background-processing-entries-for-build-ids + conn + build-id)) + build-ids))))) + #:parallel? #t) + (spawn-fiber (lambda () (while (not (check-startup-completed startup-completed)) diff --git a/sqitch/deploy/build_background_processing_queue.sql b/sqitch/deploy/build_background_processing_queue.sql new file mode 100644 index 0000000..b71f841 --- /dev/null +++ b/sqitch/deploy/build_background_processing_queue.sql @@ -0,0 +1,9 @@ +-- Deploy guix-data-service:build_background_processing_queue to pg + +BEGIN; + +CREATE TABLE build_background_processing_queue ( + build_id integer PRIMARY KEY REFERENCES builds (id) +); + +COMMIT; diff --git a/sqitch/revert/build_background_processing_queue.sql b/sqitch/revert/build_background_processing_queue.sql new file mode 100644 index 0000000..eb54e74 --- /dev/null +++ b/sqitch/revert/build_background_processing_queue.sql @@ -0,0 +1,7 @@ +-- Revert guix-data-service:build_background_processing_queue from pg + +BEGIN; + +-- XXX Add DDLs here. + +COMMIT; diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan index 666f6de..c5469e8 100644 --- a/sqitch/sqitch.plan +++ b/sqitch/sqitch.plan @@ -100,3 +100,4 @@ git_repositories_poll_interval 2023-10-08T20:36:09Z Chris # Add gi git_repositories_job_priority 2024-03-07T09:39:27Z Chris # Add git_repositories.job_priority build_server_build_id_index 2024-09-07T17:42:28Z Chris # Add index on builds.build_server_build_id alter_build_servers_id_default 2024-12-15T20:48:51Z Chris # Alter build_servers id default +build_background_processing_queue 2025-05-14T14:18:14Z Chris # Add build_background_processing_queue diff --git a/sqitch/verify/build_background_processing_queue.sql b/sqitch/verify/build_background_processing_queue.sql new file mode 100644 index 0000000..3db13fd --- /dev/null +++ b/sqitch/verify/build_background_processing_queue.sql @@ -0,0 +1,7 @@ +-- Verify guix-data-service:build_background_processing_queue on pg + +BEGIN; + +-- XXX Add verifications here. + +ROLLBACK;