Rework the builds and build_status tables as well as related code
Allow for build status information to be submitted by POST request. This required some changes to the builds and build_status tables, as for example, the Cuirass build id may not be available, and the derivation may not be know yet, so just record the derivation file name.
This commit is contained in:
parent
0ffd8caeeb
commit
5663235048
16 changed files with 510 additions and 229 deletions
|
|
@ -12,10 +12,13 @@
|
|||
secret-key-base
|
||||
build-server-id
|
||||
token-seed)))
|
||||
(base64-encode
|
||||
(bytevector-hash
|
||||
(string->utf8 source-string)
|
||||
(hash-algorithm sha1)))))
|
||||
(string-filter
|
||||
(base64-encode
|
||||
(bytevector-hash
|
||||
(string->utf8 source-string)
|
||||
(hash-algorithm sha1)))
|
||||
;; Remove the + / and = to make handling the value easier
|
||||
char-set:letter+digit)))
|
||||
|
||||
(define (compute-tokens-for-build-server conn secret-key-base build-server-id)
|
||||
(define query
|
||||
|
|
|
|||
|
|
@ -1,8 +1,12 @@
|
|||
(define-module (guix-data-service model build-status)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (squee)
|
||||
#:use-module (guix-data-service model utils)
|
||||
#:export (build-statuses
|
||||
build-status-strings
|
||||
insert-build-status))
|
||||
select-build-statuses-by-build-id
|
||||
insert-build-status
|
||||
insert-build-statuses))
|
||||
|
||||
(define build-statuses
|
||||
'((-2 . "scheduled")
|
||||
|
|
@ -16,25 +20,63 @@
|
|||
(define build-status-strings
|
||||
(map cdr build-statuses))
|
||||
|
||||
(define (insert-build-status conn internal-build-id
|
||||
starttime stoptime status)
|
||||
(exec-query conn
|
||||
(define (select-build-statuses-by-build-id conn
|
||||
build-id
|
||||
build-server-id)
|
||||
(define query
|
||||
"
|
||||
SELECT timestamp, status
|
||||
FROM build_status
|
||||
INNER JOIN builds ON builds.id = build_status.build_id
|
||||
WHERE builds.build_server_id = $1 AND
|
||||
builds.id = $2")
|
||||
|
||||
(exec-query conn query (list (number->string build-server-id)
|
||||
(number->string build-id))))
|
||||
|
||||
(define (insert-build-status conn build-id timestamp status)
|
||||
(define query
|
||||
(string-append
|
||||
"
|
||||
INSERT INTO build_status (build_id, timestamp, status)
|
||||
VALUES ("
|
||||
(number->string build-id)
|
||||
", "
|
||||
(string-append "to_timestamp("
|
||||
(number->string timestamp)
|
||||
")")
|
||||
", "
|
||||
(quote-string status)
|
||||
")"))
|
||||
|
||||
(exec-query conn query '()))
|
||||
|
||||
(define (insert-build-statuses conn build-ids data)
|
||||
(define query
|
||||
(string-append
|
||||
"
|
||||
INSERT INTO build_status (build_id, timestamp, status)
|
||||
VALUES "
|
||||
(string-join
|
||||
(map (match-lambda*
|
||||
(((timestamp status) build-id)
|
||||
(unless (member status build-status-strings)
|
||||
(throw
|
||||
'invalid-status
|
||||
status))
|
||||
|
||||
(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 "'"
|
||||
"("
|
||||
(number->string build-id)
|
||||
","
|
||||
(string-append "to_timestamp("
|
||||
(number->string timestamp)
|
||||
")")
|
||||
","
|
||||
(quote-string status)
|
||||
")")))
|
||||
data
|
||||
build-ids)
|
||||
", ")))
|
||||
|
||||
(exec-query conn query '()))
|
||||
|
|
|
|||
|
|
@ -1,104 +1,122 @@
|
|||
(define-module (guix-data-service model build)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (squee)
|
||||
#:use-module (guix-data-service model utils)
|
||||
#:export (select-build-stats
|
||||
select-builds-with-context
|
||||
select-builds-with-context-by-derivation-id
|
||||
select-build-by-build-server-and-id
|
||||
select-builds-with-context-by-derivation-file-name
|
||||
select-build-by-build-server-and-derivation-file-name
|
||||
insert-builds
|
||||
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"))
|
||||
"
|
||||
SELECT latest_build_status.status AS build_status, COUNT(*)
|
||||
FROM derivations
|
||||
LEFT JOIN builds ON builds.derivation_file_name = derivations.file_name
|
||||
LEFT JOIN
|
||||
(
|
||||
SELECT DISTINCT ON (build_id) *
|
||||
FROM build_status
|
||||
ORDER BY build_id, timestamp DESC
|
||||
) AS latest_build_status
|
||||
ON builds.id = latest_build_status.build_id
|
||||
GROUP BY latest_build_status.status
|
||||
ORDER BY 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"))
|
||||
"
|
||||
SELECT builds.id, build_servers.url, derivations.file_name,
|
||||
latest_build_status.timestamp, latest_build_status.status
|
||||
FROM builds
|
||||
INNER JOIN build_servers ON build_servers.id = builds.build_server_id
|
||||
INNER JOIN derivations ON derivations.file_name = builds.derivation_file_name
|
||||
INNER JOIN
|
||||
(
|
||||
SELECT DISTINCT ON (build_id) *
|
||||
FROM build_status
|
||||
ORDER BY build_id, timestamp DESC
|
||||
) AS latest_build_status
|
||||
ON latest_build_status.build_id = builds.id
|
||||
ORDER BY latest_build_status.timestamp DESC
|
||||
LIMIT 100")
|
||||
|
||||
(exec-query conn query))
|
||||
|
||||
(define (select-builds-with-context-by-derivation-id conn derivation-id)
|
||||
(define (select-builds-with-context-by-derivation-file-name
|
||||
conn derivation-file-name)
|
||||
(define query
|
||||
(string-append
|
||||
"SELECT builds.id, build_servers.url, "
|
||||
"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 "
|
||||
"(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 "
|
||||
"WHERE builds.derivation_id = $1 "
|
||||
"ORDER BY latest_build_status.status_fetched_at DESC "))
|
||||
"
|
||||
SELECT build_servers.url,
|
||||
latest_build_status.timestamp,
|
||||
latest_build_status.status
|
||||
FROM builds
|
||||
INNER JOIN build_servers ON build_servers.id = builds.build_server_id
|
||||
INNER JOIN
|
||||
(
|
||||
SELECT DISTINCT ON (build_id) *
|
||||
FROM build_status
|
||||
ORDER BY build_id, timestamp DESC
|
||||
) AS latest_build_status
|
||||
ON latest_build_status.build_id = builds.id
|
||||
WHERE builds.derivation_file_name = $1
|
||||
ORDER BY latest_build_status.timestamp DESC")
|
||||
|
||||
(exec-query conn query (list (number->string derivation-id))))
|
||||
(exec-query conn query (list derivation-file-name)))
|
||||
|
||||
(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 (select-build-by-build-server-and-derivation-file-name
|
||||
conn build-server-id derivation-file-name)
|
||||
(define query
|
||||
"
|
||||
SELECT id, build_server_id, derivation_file_name
|
||||
FROM builds
|
||||
WHERE build_server_id = $1 AND derivation_file_name = $2")
|
||||
|
||||
(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)))))
|
||||
(match (exec-query conn
|
||||
query
|
||||
(list (number->string build-server-id)
|
||||
derivation-file-name))
|
||||
((id) (string->number id))
|
||||
(_
|
||||
#f)))
|
||||
|
||||
(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)))
|
||||
(define (insert-builds conn build-server-id derivation-file-names)
|
||||
(insert-missing-data-and-return-all-ids
|
||||
conn
|
||||
"builds"
|
||||
'(build_server_id derivation_file_name)
|
||||
(map (lambda (derivation-file-name)
|
||||
(list build-server-id
|
||||
derivation-file-name))
|
||||
derivation-file-names)
|
||||
#:delete-duplicates? #t))
|
||||
|
||||
(if (null? existing-build)
|
||||
(define (insert-build conn build-server-id derivation-file-name)
|
||||
(match (exec-query conn
|
||||
"
|
||||
INSERT INTO builds (build_server_id, derivation_file_name)
|
||||
VALUES ($1, $2)
|
||||
RETURNING (id)"
|
||||
(list (number->string build-server-id)
|
||||
derivation-file-name))
|
||||
(((id))
|
||||
(string->number id))))
|
||||
|
||||
(define (ensure-build-exists conn
|
||||
build-server-id
|
||||
derivation-file-name)
|
||||
(let ((existing-build-id
|
||||
(select-build-by-build-server-and-derivation-file-name
|
||||
conn build-server-id derivation-file-name)))
|
||||
|
||||
(if existing-build-id
|
||||
existing-build-id
|
||||
(insert-build conn
|
||||
id
|
||||
build-server-id
|
||||
derivation-id
|
||||
timestamp)
|
||||
(caar existing-build))))
|
||||
derivation-file-name))))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue