mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-23 18:56:43 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

ci: Add procedures to access jobs and builds.

Browse source 
* 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
1 changed files with 37 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
guix/ci.scm
View file

@ -51,10 +51,18 @@ (define-module (guix ci)
evaluation-complete? evaluation-complete?
evaluation-checkouts evaluation-checkouts
job?
job-build-id
job-status
job-name
%query-limit %query-limit
queued-builds queued-builds
latest-builds latest-builds
evaluation evaluation
evaluation-jobs
build
job-build
latest-evaluations latest-evaluations
evaluations-for-commit evaluations-for-commit
@ -109,6 +117,13 @@ (define-json-mapping <build> make-build build?
(vector->list products) (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? (define-json-mapping <checkout> make-checkout checkout?
json->checkout json->checkout
(commit checkout-commit) ;string (SHA1) (commit checkout-commit) ;string (SHA1)
@ -197,6 +212,28 @@ (define* (evaluations-for-commit url commit #:optional (limit %query-limit))
(evaluation-checkouts evaluation))) (evaluation-checkouts evaluation)))
(latest-evaluations url limit))) (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) (define (find-latest-commit-with-substitutes url)
"Return the latest commit with available substitutes for the Guix package "Return the latest commit with available substitutes for the Guix package
definitions at URL. Return false if no commit were found." definitions at URL. Return false if no commit were found."