04/05: ci: Add procedures to access jobs and builds.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 073f198e34d8004a4ac4dba558683514e5562994
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Jul 3 19:35:18 2021 +0200

    ci: Add procedures to access jobs and builds.
    
    * guix/ci.scm (<job>): New record type.
    (evaluation-jobs, build, job-build): New procedures.
---
 guix/ci.scm | 37 +++++++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)

diff --git a/guix/ci.scm b/guix/ci.scm
index bf35732..dde93bb 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."