cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Allow only fetching builds for a specific system

Browse source
This commit is contained in:
Christopher Baines 2020-11-01 22:49:49 +00:00
parent 2732ba8f68
commit f485423d5a
2 changed files with 56 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

53
guix-data-service/builds.scm
View file

@ -141,7 +141,8 @@ WHERE status IN ('started', 'scheduled')
(define verbose-output? (define verbose-output?
(make-parameter #f)) (make-parameter #f))
(define* (query-build-servers conn build-server-ids revision-commits (define* (query-build-servers conn build-server-ids systems
revision-commits
outputs outputs
#:key verbose?) #:key verbose?)
(cleanup-bad-build-data conn) (cleanup-bad-build-data conn)
@ -167,6 +168,7 @@ WHERE status IN ('started', 'scheduled')
(query-build-server conn (query-build-server conn
id id
url url
systems
revision-commits revision-commits
outputs)))) outputs))))
(lambda (key . args) (lambda (key . args)
@ -176,7 +178,7 @@ WHERE status IN ('started', 'scheduled')
key args))))))) key args)))))))
build-servers))))) build-servers)))))
(define (query-build-server conn id url revision-commits outputs) (define (query-build-server conn id url systems revision-commits outputs)
(define (fetch-derivation-output-details-set-id output) (define (fetch-derivation-output-details-set-id output)
(match (exec-query (match (exec-query
conn conn
@ -196,7 +198,7 @@ WHERE derivation_output_details.path = $1"
(() #f))) (() #f)))
(simple-format #t "\nFetching pending builds\n") (simple-format #t "\nFetching pending builds\n")
(process-pending-builds conn id revision-commits url) (process-pending-builds conn id systems revision-commits url)
(simple-format #t "\nFetching unseen derivations\n") (simple-format #t "\nFetching unseen derivations\n")
(process-derivation-outputs (process-derivation-outputs
conn id url conn id url
@ -209,6 +211,7 @@ WHERE derivation_output_details.path = $1"
outputs) outputs)
(select-derivation-outputs-with-no-known-build conn (select-derivation-outputs-with-no-known-build conn
id id
systems
revision-commits)))) revision-commits))))
(define* (insert-build-statuses-from-data conn build-server-id build-id data (define* (insert-build-statuses-from-data conn build-server-id build-id data
@ -267,9 +270,10 @@ WHERE derivation_output_details.path = $1"
stoptime) stoptime)
status-string))))))) status-string)))))))
(define (process-pending-builds conn build-server-id revision-commits url) (define (process-pending-builds conn build-server-id
systems revision-commits url)
(define pending-builds (define pending-builds
(select-pending-builds conn build-server-id revision-commits)) (select-pending-builds conn build-server-id systems revision-commits))
(simple-format #t "fetching the status of ~A pending builds\n" (simple-format #t "fetching the status of ~A pending builds\n"
(length pending-builds)) (length pending-builds))
@ -494,7 +498,7 @@ WHERE derivation_output_details.path = $1"
derivation-outputs) derivation-outputs)
#:batch-size 100)) #:batch-size 100))
(define (select-pending-builds conn build-server-id revision-commits) (define (select-pending-builds conn build-server-id systems revision-commits)
(define query (define query
(string-append (string-append
" "
@ -525,6 +529,15 @@ WHERE builds.build_server_id = $1 AND
(string-join (map quote-string revision-commits) ",") (string-join (map quote-string revision-commits) ",")
") ")
)")) )"))
(if systems
(string-append
"
AND derivations.system IN ("
(string-join
(map quote-string systems)
",")
")")
"")
" "
ORDER BY latest_build_status.status DESC, -- 'started' first ORDER BY latest_build_status.status DESC, -- 'started' first
latest_build_status.timestamp ASC latest_build_status.timestamp ASC
@ -586,6 +599,7 @@ LIMIT 30000"))
(define (select-derivation-outputs-with-no-known-build conn (define (select-derivation-outputs-with-no-known-build conn
build-server-id build-server-id
systems
revision-commits) revision-commits)
(define query (define query
;; Only select derivations that are in the package_derivations table, as ;; Only select derivations that are in the package_derivations table, as
@ -626,6 +640,15 @@ WHERE NOT EXISTS (
WHERE guix_revisions.commit IN (" WHERE guix_revisions.commit IN ("
(string-join (map quote-string revision-commits) ",") (string-join (map quote-string revision-commits) ",")
")")) ")"))
(if systems
(string-append
"
AND package_derivations.system IN ("
(string-join
(map quote-string systems)
",")
")")
"")
" "
UNION ALL UNION ALL
SELECT derivations_by_output_details_set.derivation_output_details_set_id SELECT derivations_by_output_details_set.derivation_output_details_set_id
@ -643,6 +666,15 @@ WHERE NOT EXISTS (
WHERE guix_revisions.commit IN (" WHERE guix_revisions.commit IN ("
(string-join (map quote-string revision-commits) ",") (string-join (map quote-string revision-commits) ",")
")")) ")"))
(if systems
(string-append
"
AND guix_revision_system_test_derivations.system IN ("
(string-join
(map quote-string systems)
",")
")")
"")
" "
UNION ALL UNION ALL
SELECT derivations_by_output_details_set.derivation_output_details_set_id SELECT derivations_by_output_details_set.derivation_output_details_set_id
@ -660,6 +692,15 @@ WHERE NOT EXISTS (
WHERE guix_revisions.commit IN (" WHERE guix_revisions.commit IN ("
(string-join (map quote-string revision-commits) ",") (string-join (map quote-string revision-commits) ",")
")")) ")"))
(if systems
(string-append
"
AND channel_instances.system IN ("
(string-join
(map quote-string systems)
",")
")")
"")
" "
) )
ORDER BY derivation_output_details_sets.id DESC, derivation_output_details.id ORDER BY derivation_output_details_sets.id DESC, derivation_output_details.id

9
scripts/guix-data-service-query-build-servers.in
View file

@ -36,6 +36,14 @@
(or (assoc-ref result 'build-server-ids) (or (assoc-ref result 'build-server-ids)
'())) '()))
(alist-delete 'build-server-ids result)))) (alist-delete 'build-server-ids result))))
(option '("system") #t #f
(lambda (opt name arg result)
(alist-cons
'systems
(cons arg
(or (assoc-ref result 'systems)
'()))
(alist-delete 'systems result))))
(option '("verbose") #f #f (option '("verbose") #f #f
(lambda (opt name _ result) (lambda (opt name _ result)
(alist-cons 'verbose #t result))))) (alist-cons 'verbose #t result)))))
@ -67,6 +75,7 @@
(lambda (conn) (lambda (conn)
(query-build-servers conn (query-build-servers conn
(assq-ref opts 'build-server-ids) (assq-ref opts 'build-server-ids)
(assq-ref opts 'systems)
(assq-ref opts 'revision-commits) (assq-ref opts 'revision-commits)
(assq-ref opts 'outputs) (assq-ref opts 'outputs)
#:verbose? (assq-ref opts 'verbose))))) #:verbose? (assq-ref opts 'verbose)))))