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:
parent
8bef36a95e
commit
4d0d6f2e82
|
@ -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 \
|
||||
|
|
|
@ -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")))
|
|
@ -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 "'"
|
||||
")")))
|
|
@ -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))))
|
||||
|
Loading…
Reference in New Issue