Add new models relating to builds and build servers

These will allow tracking what's going on with build servers.
This commit is contained in:
Christopher Baines 2019-03-06 22:54:07 +00:00
parent 8bef36a95e
commit 4d0d6f2e82
No known key found for this signature in database
GPG Key ID: 5E28A33B0B84F577
4 changed files with 133 additions and 1 deletions

View File

@ -31,8 +31,11 @@ assetsdir = $(datadir)/@PACKAGE@
SOURCES = \
guix-data-service/comparison.scm \
guix-data-service/config.scm \
guix-data-service/jobs/load-new-guix-revision.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-status.scm \
guix-data-service/model/build.scm \
guix-data-service/model/derivation.scm \
guix-data-service/model/guix-revision-package.scm \
guix-data-service/model/guix-revision.scm \

View File

@ -0,0 +1,9 @@
(define-module (guix-data-service model build-server)
#:use-module (squee)
#:export (select-build-servers))
(define (select-build-servers conn)
(exec-query conn
(string-append
"SELECT id, url, lookup_all_derivations "
"FROM build_servers")))

View File

@ -0,0 +1,36 @@
(define-module (guix-data-service model build-status)
#:use-module (squee)
#:export (build-statuses
insert-build-status))
(define build-statuses
'((-2 . "scheduled")
(-1 . "started")
(0 . "succeeded")
(1 . "failed")
(2 . "failed-dependency")
(3 . "failed-other")
(4 . "canceled")))
(define (insert-build-status conn internal-build-id
starttime stoptime status)
(exec-query conn
(string-append
"INSERT INTO build_status "
"(internal_build_id, starttime, stoptime, status) "
"VALUES "
"(" internal-build-id ", "
(if (eq? starttime 0)
"NULL"
(string-append "to_timestamp("
(number->string starttime)
")"))
", "
(if (eq? stoptime 0)
"NULL"
(string-append "to_timestamp("
(number->string stoptime)
")"))
", "
"'" status "'"
")")))

View File

@ -0,0 +1,84 @@
(define-module (guix-data-service model build)
#:use-module (squee)
#:export (select-build-stats
select-builds-with-context
select-build-by-build-server-and-id
insert-build
ensure-build-exists))
(define (select-build-stats conn)
(define query
(string-append
"SELECT latest_build_status.status AS build_status, COUNT(*) "
"FROM derivations "
"FULL OUTER JOIN builds ON builds.derivation_id = derivations.id "
"FULL OUTER JOIN "
"(SELECT DISTINCT ON (internal_build_id) * FROM build_status "
"ORDER BY internal_build_id, status_fetched_at DESC"
") AS latest_build_status "
"ON builds.internal_id = latest_build_status.internal_build_id "
"GROUP BY (builds.id IS NULL), latest_build_status.status "
"ORDER BY build_status"))
(exec-query conn query))
(define (select-builds-with-context conn)
(define query
(string-append
"SELECT builds.id, build_servers.url, derivations.file_name, "
"latest_build_status.status_fetched_at, latest_build_status.starttime, "
"latest_build_status.stoptime, latest_build_status.status "
"FROM builds "
"INNER JOIN build_servers ON build_servers.id = builds.build_server_id "
"INNER JOIN derivations ON derivations.id = builds.derivation_id "
"INNER JOIN "
"(SELECT DISTINCT ON (internal_build_id) * "
"FROM build_status "
"ORDER BY internal_build_id, status_fetched_at DESC"
") AS latest_build_status "
"ON latest_build_status.internal_build_id = builds.internal_id "
"ORDER BY latest_build_status.status_fetched_at DESC "
"LIMIT 100"))
(exec-query conn query))
(define (select-build-by-build-server-and-id
conn build-server-id id)
(exec-query conn
(string-append
"SELECT internal_id, id, build_server_id, "
"derivation_id, timestamp "
"FROM builds "
"WHERE build_server_id = $1 AND id = $2")
(list build-server-id
(number->string id))))
(define (insert-build conn id build-server-id derivation-id timestamp)
(caar
(exec-query conn
(string-append
"INSERT INTO builds "
"(id, build_server_id, derivation_id, timestamp) "
"VALUES "
"($1, $2, $3, to_timestamp($4))"
"RETURNING "
"(internal_id)")
(list (number->string id)
build-server-id
derivation-id
(number->string timestamp)))))
(define (ensure-build-exists conn build-server-id id
derivation-id timestamp)
(let ((existing-build
(select-build-by-build-server-and-id
conn build-server-id id)))
(if (null? existing-build)
(insert-build conn
id
build-server-id
derivation-id
timestamp)
(caar existing-build))))