summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-07-03 19:35:18 +0200
committerLudovic Courtès <ludo@gnu.org>2021-07-04 23:00:36 +0200
commit073f198e34d8004a4ac4dba558683514e5562994 (patch)
tree7661a67a968b5a9eab8818bab15a345e9e6c2ebd
parent77dba2281ffec5294f39d4f10f9cc64a936cf9ff (diff)
downloadguix-073f198e34d8004a4ac4dba558683514e5562994.tar.gz
ci: Add procedures to access jobs and builds.
* guix/ci.scm (<job>): New record type.
(evaluation-jobs, build, job-build): New procedures.
-rw-r--r--guix/ci.scm37
1 files changed, 37 insertions, 0 deletions
diff --git a/guix/ci.scm b/guix/ci.scm
index bf3573247a..dde93bbd53 100644
--- a/guix/ci.scm
+++ b/guix/ci.scm
@@ -51,10 +51,18 @@
             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 @@
                           (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 @@ as one of their inputs."
                   (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."