ci: Add jobs history support.

* guix/ci.scm (history?, history-evaluation, history-checkouts, history-jobs,
jobs-history): New procedures.
(<history>): New record.
This commit is contained in:
Mathieu Othacehe 2021-08-22 21:36:29 +02:00
parent 9adb69b089
commit bb5f395a08
No known key found for this signature in database
GPG key ID: 8354763531769CA6

View file

@ -59,6 +59,11 @@ (define-module (guix ci)
job-status
job-name
history?
history-evaluation
history-checkouts
history-jobs
%query-limit
queued-builds
latest-builds
@ -66,6 +71,7 @@ (define-module (guix ci)
evaluation-jobs
build
job-build
jobs-history
latest-evaluations
evaluations-for-commit
@ -127,6 +133,18 @@ (define-json-mapping <job> make-job job?
integer->build-status)
(name job-name)) ;string
(define-json-mapping <history> make-history history?
json->history
(evaluation history-evaluation) ;integer
(checkouts history-checkouts "checkouts" ;<checkout>*
(lambda (checkouts)
(map json->checkout
(vector->list checkouts))))
(jobs history-jobs "jobs"
(lambda (jobs)
(map json->job
(vector->list jobs)))))
(define-json-mapping <checkout> make-checkout checkout?
json->checkout
(commit checkout-commit) ;string (SHA1)
@ -247,8 +265,20 @@ (define (job-build url job)
"Return the build associated with JOB."
(build url (job-build-id job)))
;; TODO: job history:
;; https://ci.guix.gnu.org/api/jobs/history?spec=master&names=coreutils.x86_64-linux&nr=10
(define* (jobs-history url jobs
#:key
(specification "master")
(limit 20))
"Return the job history for the SPECIFICATION jobs which names are part of
the JOBS list, from the CI server at URL. Limit the history to the latest
LIMIT evaluations. "
(let ((names (string-join jobs ",")))
(map json->history
(vector->list
(json->scm
(http-fetch
(format #f "~a/api/jobs/history?spec=~a&names=~a&nr=~a"
url specification names (number->string limit))))))))
(define (find-latest-commit-with-substitutes url)
"Return the latest commit with available substitutes for the Guix package