mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
465 lines
16 KiB
Scheme
465 lines
16 KiB
Scheme
;;; Guix Data Service -- Information about Guix over time
|
|
;;; Copyright © 2022 Christopher Baines <mail@cbaines.net>
|
|
;;;
|
|
;;; 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
|
|
;;; <http://www.gnu.org/licenses/>.
|
|
|
|
(define-module (guix-data-service model blocked-builds)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-71)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (squee)
|
|
#:use-module (json)
|
|
#:use-module (guix-data-service database)
|
|
#:use-module (guix-data-service utils)
|
|
#:use-module (guix-data-service model utils)
|
|
#:use-module (guix-data-service model system)
|
|
#:use-module (guix-data-service model guix-revision)
|
|
#:use-module (guix-data-service model guix-revision-package-derivation)
|
|
#:use-module (guix-data-service model build)
|
|
#:export (handle-blocked-builds-entries-for-scheduled-builds
|
|
handle-populating-blocked-builds-for-build-failures
|
|
handle-removing-blocking-build-entries-for-successful-builds
|
|
|
|
backfill-blocked-builds
|
|
|
|
select-blocking-builds))
|
|
|
|
(define (select-blocked-derivation-output-details-set-ids-for-blocking-build
|
|
conn
|
|
build-server-id
|
|
blocking-derivation-output-details-set-id)
|
|
(define query
|
|
"
|
|
WITH RECURSIVE all_derivations(id, file_name) AS (
|
|
(
|
|
SELECT derivations.id, derivations.file_name
|
|
FROM derivations
|
|
INNER JOIN derivations_by_output_details_set
|
|
ON derivations.id = derivations_by_output_details_set.derivation_id
|
|
WHERE derivation_output_details_set_id = $2
|
|
LIMIT 1
|
|
)
|
|
UNION
|
|
SELECT derivations.id, derivations.file_name
|
|
FROM all_derivations
|
|
INNER JOIN derivation_outputs
|
|
ON all_derivations.id = derivation_outputs.derivation_id
|
|
INNER JOIN derivation_inputs
|
|
ON derivation_outputs.id = derivation_inputs.derivation_output_id
|
|
INNER JOIN derivations
|
|
ON derivation_inputs.derivation_id = derivations.id
|
|
)
|
|
SELECT DISTINCT builds.derivation_output_details_set_id
|
|
FROM all_derivations
|
|
INNER JOIN derivations_by_output_details_set
|
|
ON all_derivations.id = derivations_by_output_details_set.derivation_id
|
|
INNER JOIN builds
|
|
ON builds.build_server_id = $1
|
|
AND builds.derivation_output_details_set_id
|
|
= derivations_by_output_details_set.derivation_output_details_set_id
|
|
INNER JOIN latest_build_status
|
|
ON builds.id = latest_build_status.build_id
|
|
AND status = 'scheduled'")
|
|
|
|
(exec-query conn
|
|
query
|
|
(list build-server-id
|
|
blocking-derivation-output-details-set-id)))
|
|
|
|
(define (select-blocking-builds-for-build-id conn build-id build-server-id)
|
|
(define query
|
|
"
|
|
WITH RECURSIVE all_derivations(id, file_name) AS (
|
|
SELECT derivations.id, derivations.file_name
|
|
FROM derivations
|
|
WHERE id IN (
|
|
-- Look up by the builds.derivation_output_details_set_id, since that'll
|
|
-- work even if the derivation for the build isn't known.
|
|
SELECT derivation_id
|
|
FROM derivations_by_output_details_set
|
|
INNER JOIN builds
|
|
ON builds.derivation_output_details_set_id
|
|
= derivations_by_output_details_set.derivation_output_details_set_id
|
|
WHERE builds.id = $1
|
|
)
|
|
UNION
|
|
SELECT derivations.id, derivations.file_name
|
|
FROM all_derivations
|
|
INNER JOIN derivation_inputs
|
|
ON all_derivations.id = derivation_inputs.derivation_id
|
|
INNER JOIN derivation_outputs
|
|
ON derivation_inputs.derivation_output_id = derivation_outputs.id
|
|
INNER JOIN derivations
|
|
ON derivation_outputs.derivation_id = derivations.id
|
|
)
|
|
SELECT derivations_by_output_details_set.derivation_output_details_set_id
|
|
FROM all_derivations
|
|
INNER JOIN derivations_by_output_details_set
|
|
ON all_derivations.id = derivations_by_output_details_set.derivation_id
|
|
INNER JOIN builds
|
|
ON derivations_by_output_details_set.derivation_output_details_set_id =
|
|
builds.derivation_output_details_set_id
|
|
AND builds.build_server_id = $2
|
|
INNER JOIN latest_build_status
|
|
ON builds.id = latest_build_status.build_id
|
|
AND latest_build_status.status IN (
|
|
'failed', 'canceled', 'failed-dependency',
|
|
'failed-other'
|
|
)
|
|
WHERE NOT EXISTS (
|
|
SELECT 1
|
|
FROM builds AS successful_builds
|
|
INNER JOIN latest_build_status AS successful_builds_latest_build_status
|
|
ON successful_builds.id = successful_builds_latest_build_status.build_id
|
|
WHERE successful_builds.derivation_output_details_set_id =
|
|
builds.derivation_output_details_set_id
|
|
AND successful_builds.build_server_id = $2
|
|
AND successful_builds_latest_build_status.status IN ('succeeded', 'scheduled')
|
|
)")
|
|
|
|
(exec-query conn
|
|
query
|
|
(list (number->string build-id)
|
|
build-server-id)))
|
|
|
|
(define %created-partitions
|
|
'())
|
|
|
|
(define (insert-blocked-builds conn build-server-id data)
|
|
(unless (null? data)
|
|
(unless (member build-server-id %created-partitions)
|
|
(exec-query
|
|
conn
|
|
(string-append
|
|
"
|
|
CREATE TABLE IF NOT EXISTS blocked_builds_build_server_"
|
|
build-server-id "
|
|
PARTITION OF blocked_builds FOR VALUES IN ("
|
|
build-server-id
|
|
")"))
|
|
|
|
(set! %created-partitions
|
|
(cons build-server-id
|
|
%created-partitions)))
|
|
|
|
(exec-query
|
|
conn
|
|
(string-append
|
|
"
|
|
INSERT INTO blocked_builds (
|
|
build_server_id,
|
|
blocked_derivation_output_details_set_id,
|
|
blocking_derivation_output_details_set_id
|
|
)
|
|
VALUES "
|
|
(string-join
|
|
(map (match-lambda
|
|
((b c)
|
|
(simple-format #f "(~A, ~A, ~A)"
|
|
build-server-id
|
|
b
|
|
c)))
|
|
data)
|
|
", ")
|
|
"
|
|
ON CONFLICT DO NOTHING")
|
|
'()))
|
|
|
|
#t)
|
|
|
|
(define (handle-blocked-builds-entries-for-scheduled-builds conn build-ids)
|
|
(define (get-build-details build-id)
|
|
(define query
|
|
"
|
|
SELECT build_server_id, derivation_output_details_set_id
|
|
FROM builds
|
|
WHERE id = $1")
|
|
|
|
(exec-query conn query (list (number->string build-id))))
|
|
|
|
(define delete-query
|
|
(string-append
|
|
"
|
|
DELETE FROM blocked_builds
|
|
WHERE EXISTS (
|
|
SELECT 1
|
|
FROM builds
|
|
WHERE builds.id IN (" (string-join
|
|
(map number->string build-ids)
|
|
", ")
|
|
")
|
|
AND EXISTS (
|
|
SELECT 1
|
|
FROM latest_build_status
|
|
WHERE latest_build_status.build_id = builds.id
|
|
AND latest_build_status.status = 'scheduled'
|
|
)
|
|
AND blocked_builds.build_server_id = builds.build_server_id
|
|
AND blocked_builds.blocking_derivation_output_details_set_id
|
|
= builds.derivation_output_details_set_id
|
|
)"))
|
|
|
|
;; Insert entries for each build if it's blocked
|
|
(for-each
|
|
(lambda (build-id)
|
|
(match (get-build-details build-id)
|
|
(((build-server-id blocked-derivation-output-details-set-id))
|
|
(let ((blocking-derivation-output-details-set-ids
|
|
(select-blocking-builds-for-build-id conn build-id build-server-id)))
|
|
|
|
(unless (null? blocking-derivation-output-details-set-ids)
|
|
(insert-blocked-builds
|
|
conn
|
|
build-server-id
|
|
(map
|
|
(lambda (blocking-derivation-output-details-set-id)
|
|
(list blocked-derivation-output-details-set-id
|
|
blocking-derivation-output-details-set-id))
|
|
blocking-derivation-output-details-set-ids)))))))
|
|
build-ids)
|
|
|
|
;; This build being scheduled might unblock other builds, so delete the
|
|
;; associated entries
|
|
(exec-query conn delete-query '())
|
|
|
|
#t)
|
|
|
|
(define (handle-populating-blocked-builds-for-build-failures conn build-ids)
|
|
(define build-build-server-id-and-derivation-output-details-set-ids-query
|
|
(string-append
|
|
"
|
|
SELECT builds.build_server_id, builds.derivation_output_details_set_id
|
|
FROM builds
|
|
INNER JOIN latest_build_status
|
|
ON latest_build_status.build_id = builds.id
|
|
-- This should only be run on builds that have failed, but double check here
|
|
AND status IN ('failed', 'failed-dependency', 'failed-other', 'canceled')
|
|
WHERE builds.id IN ("
|
|
(string-join (map number->string build-ids) ", ")
|
|
")
|
|
AND builds.derivation_output_details_set_id IS NOT NULL
|
|
AND NOT EXISTS (
|
|
SELECT 1
|
|
FROM builds AS builds_for_same_output
|
|
INNER JOIN latest_build_status AS builds_for_same_output_latest_build_status
|
|
ON builds_for_same_output.id
|
|
= builds_for_same_output_latest_build_status.build_id
|
|
AND builds_for_same_output_latest_build_status.status IN ('succeeded', 'scheduled')
|
|
WHERE builds_for_same_output.derivation_output_details_set_id
|
|
= builds.derivation_output_details_set_id
|
|
)"))
|
|
|
|
(for-each
|
|
(match-lambda
|
|
((build-server-id blocking-derivation-output-details-set-id)
|
|
(let ((blocked-derivation-output-details-set-ids
|
|
(select-blocked-derivation-output-details-set-ids-for-blocking-build
|
|
conn
|
|
build-server-id
|
|
blocking-derivation-output-details-set-id)))
|
|
(insert-blocked-builds
|
|
conn
|
|
build-server-id
|
|
(map
|
|
(lambda (blocked-derivation-output-details-set-id)
|
|
(list blocked-derivation-output-details-set-id
|
|
blocking-derivation-output-details-set-id))
|
|
blocked-derivation-output-details-set-ids)))))
|
|
(exec-query
|
|
conn
|
|
build-build-server-id-and-derivation-output-details-set-ids-query
|
|
'())))
|
|
|
|
(define (handle-removing-blocking-build-entries-for-successful-builds conn build-ids)
|
|
(define query
|
|
(string-append
|
|
"
|
|
DELETE FROM blocked_builds
|
|
WHERE EXISTS (
|
|
SELECT 1
|
|
FROM builds
|
|
WHERE builds.id IN (" (string-join
|
|
(map number->string build-ids)
|
|
", ")
|
|
")
|
|
AND EXISTS (
|
|
SELECT 1
|
|
FROM latest_build_status
|
|
WHERE latest_build_status.build_id = builds.id
|
|
AND latest_build_status.status = 'succeeded'
|
|
)
|
|
AND blocked_builds.build_server_id = builds.build_server_id
|
|
AND blocked_builds.blocking_derivation_output_details_set_id
|
|
= builds.derivation_output_details_set_id
|
|
)"))
|
|
|
|
(exec-query conn query '()))
|
|
|
|
(define (backfill-blocked-builds conn)
|
|
(define query
|
|
"
|
|
SELECT build_id
|
|
FROM latest_build_status
|
|
INNER JOIN builds
|
|
ON latest_build_status.build_id = builds.id
|
|
WHERE status IN ('failed', 'failed-dependency', 'failed-other', 'canceled')
|
|
AND NOT EXISTS (
|
|
SELECT 1
|
|
FROM builds AS other_builds
|
|
INNER JOIN latest_build_status AS other_latest_build_status
|
|
ON other_builds.id = other_latest_build_status.build_id
|
|
WHERE other_builds.derivation_output_details_set_id =
|
|
builds.derivation_output_details_set_id
|
|
AND other_latest_build_status.status IN ('succeeded', 'scheduled')
|
|
)
|
|
AND NOT EXISTS (
|
|
SELECT 1
|
|
FROM blocked_builds
|
|
WHERE blocking_derivation_output_details_set_id = builds.derivation_output_details_set_id
|
|
)")
|
|
|
|
(let ((build-ids
|
|
(map car (exec-query conn query '()))))
|
|
(chunk-for-each!
|
|
(lambda (ids)
|
|
(with-time-logging "processing chunk"
|
|
(with-postgresql-transaction
|
|
conn
|
|
(lambda (conn)
|
|
(exec-query
|
|
conn
|
|
"LOCK TABLE blocked_builds IN SHARE MODE")
|
|
|
|
(handle-populating-blocked-builds-for-build-failures
|
|
conn
|
|
(map string->number ids))))))
|
|
200
|
|
build-ids)))
|
|
|
|
(define* (select-blocking-builds conn revision-commit
|
|
#:key build-server-ids
|
|
system target
|
|
limit)
|
|
(define query
|
|
(string-append
|
|
(or
|
|
(get-sql-to-select-package-and-related-derivations-for-revision
|
|
conn
|
|
(commit->revision-id conn revision-commit)
|
|
#:system-id (system->system-id conn system)
|
|
#:target target)
|
|
(string-append
|
|
"
|
|
WITH RECURSIVE all_derivations AS (
|
|
(
|
|
SELECT derivation_id
|
|
FROM package_derivations
|
|
INNER JOIN guix_revision_package_derivations
|
|
ON package_derivations.id
|
|
= guix_revision_package_derivations.package_derivation_id
|
|
WHERE revision_id = " (commit->revision-id conn revision-commit)
|
|
(if system
|
|
(simple-format
|
|
#f "
|
|
AND system_id = ~A\n"
|
|
(system->system-id conn system))
|
|
"")
|
|
(if target
|
|
(simple-format
|
|
#f "
|
|
AND target = ~A\n"
|
|
(quote-string target))
|
|
"")
|
|
"
|
|
)
|
|
UNION
|
|
SELECT derivation_outputs.derivation_id
|
|
FROM all_derivations
|
|
INNER JOIN derivation_inputs
|
|
ON all_derivations.derivation_id = derivation_inputs.derivation_id
|
|
INNER JOIN derivation_outputs
|
|
ON derivation_inputs.derivation_output_id = derivation_outputs.id
|
|
)"))
|
|
", all_derivation_output_details_set_ids AS (
|
|
SELECT derivations_by_output_details_set.*
|
|
FROM derivations_by_output_details_set
|
|
WHERE derivation_id IN (
|
|
SELECT derivation_id FROM all_derivations
|
|
)
|
|
), blocked_build_counts AS (
|
|
SELECT blocking_derivation_output_details_set_id, COUNT(*)
|
|
FROM blocked_builds
|
|
WHERE blocked_derivation_output_details_set_id IN
|
|
(
|
|
SELECT derivation_output_details_set_id
|
|
FROM all_derivation_output_details_set_ids
|
|
)
|
|
GROUP BY 1
|
|
)
|
|
SELECT derivations.file_name,
|
|
blocked_build_counts.count,
|
|
(
|
|
SELECT JSON_AGG(
|
|
json_build_object(
|
|
'build_server_id', builds.build_server_id,
|
|
'build_server_build_id', builds.build_server_build_id,
|
|
'status', latest_build_status.status,
|
|
'timestamp', latest_build_status.timestamp,
|
|
'build_for_equivalent_derivation',
|
|
builds.derivation_file_name != derivations.file_name
|
|
)
|
|
ORDER BY latest_build_status.timestamp
|
|
)
|
|
FROM builds
|
|
INNER JOIN latest_build_status
|
|
ON builds.id = latest_build_status.build_id
|
|
WHERE builds.derivation_output_details_set_id =
|
|
blocked_build_counts.blocking_derivation_output_details_set_id"
|
|
(if (and build-server-ids
|
|
(not (null? build-server-ids)))
|
|
(string-append
|
|
"
|
|
AND builds.build_server_id IN ("
|
|
(string-join build-server-ids ", ")
|
|
")")
|
|
"")
|
|
"
|
|
) AS builds
|
|
FROM blocked_build_counts
|
|
INNER JOIN all_derivation_output_details_set_ids
|
|
ON blocked_build_counts.blocking_derivation_output_details_set_id
|
|
= all_derivation_output_details_set_ids.derivation_output_details_set_id
|
|
INNER JOIN derivations
|
|
ON all_derivation_output_details_set_ids.derivation_id
|
|
= derivations.id
|
|
ORDER BY 2 DESC"
|
|
(if limit
|
|
(string-append
|
|
"
|
|
LIMIT " (number->string limit))
|
|
"")))
|
|
|
|
(map
|
|
(match-lambda
|
|
((derivation_file_name blocked_build_count builds)
|
|
`((derivation_file_name . ,derivation_file_name)
|
|
(blocked_build_count . ,blocked_build_count)
|
|
(builds
|
|
. ,(if (or (and (string? builds) (string-null? builds))
|
|
(eq? #f builds))
|
|
#()
|
|
(json-string->scm builds))))))
|
|
(exec-query conn query)))
|