ci: Add procedures to access jobs and builds.

* guix/ci.scm (<job>): New record type.
(evaluation-jobs, build, job-build): New procedures.
This commit is contained in:
Ludovic Courtès 2021-07-03 19:35:18 +02:00
parent 77dba2281f
commit 073f198e34
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -51,10 +51,18 @@ (define-module (guix ci)
evaluation-complete?
evaluation-checkouts
job?
job-build-id
job-status
job-name
%query-limit
queued-builds
latest-builds
evaluation
evaluation-jobs
build
job-build
latest-evaluations
evaluations-for-commit
@ -109,6 +117,13 @@ (define-json-mapping <build> make-build build?
(vector->list products)
'())))))
(define-json-mapping <job> make-job job?
json->job
(build-id job-build-id "build") ;integer
(status job-status "status" ;symbol
integer->build-status)
(name job-name)) ;string
(define-json-mapping <checkout> make-checkout checkout?
json->checkout
(commit checkout-commit) ;string (SHA1)
@ -197,6 +212,28 @@ (define* (evaluations-for-commit url commit #:optional (limit %query-limit))
(evaluation-checkouts evaluation)))
(latest-evaluations url limit)))
(define (evaluation-jobs url evaluation-id)
"Return the list of jobs of evaluation EVALUATION-ID."
(map json->job
(vector->list
(json->scm (http-fetch
(string-append url "/api/jobs?evaluation="
(number->string evaluation-id)))))))
(define (build url id)
"Look up build ID at URL and return it. Raise &http-get-error if it is not
found (404)."
(json->build
(http-fetch (string-append url "/build/" ;note: no "/api" here
(number->string id)))))
(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 (find-latest-commit-with-substitutes url)
"Return the latest commit with available substitutes for the Guix package
definitions at URL. Return false if no commit were found."