diff mbox series

[bug#47929,3/5] ci: Add dashboard procedures.

Message ID 20210421122108.2344-3-othacehe@gnu.org
State New
Headers show
Series Add manifest support to channel-with-substitutes-available | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job
cbaines/issue success View issue

Commit Message

Mathieu Othacehe April 21, 2021, 12:21 p.m. UTC
* guix/ci.scm (dashboard-url, dashboard-register): New procedures.
---
 guix/ci.scm | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)
diff mbox series

Patch

diff --git a/guix/ci.scm b/guix/ci.scm
index 780e90ef32..78ab739340 100644
--- a/guix/ci.scm
+++ b/guix/ci.scm
@@ -65,6 +65,8 @@ 
             evaluations-for-commit
 
             manifest->jobs
+            dashboard-url
+            dashboard-register
             channel-with-substitutes-available))
 
 ;;; Commentary:
@@ -282,6 +284,26 @@  evaluation with the higher successful jobs count."
            (package->job-name (package-name package)))
          packages)))
 
+(define (dashboard-url url id)
+  "Return the url of the dashboard with the given ID on the CI server at URL."
+  (format #f "~a/dashboard/~a" url id))
+
+(define* (dashboard-register url packages
+                             #:key
+                             (specification "master"))
+  "Register a dashboard for the packages jobs of the given SPECIFICATION using
+the CI server at URL.  Returns the newly created dashboard id or false if it
+could not be created."
+  (let* ((jobs (manifest->jobs
+                (packages->manifest packages)))
+         (names (string-join jobs ","))
+         (id (json->scm
+              (http-fetch
+               (format #f "~a/api/dashboard/register?spec=~a&names=~a"
+                       url specification names)))))
+    (and id
+         (assoc-ref id "id"))))
+
 (define* (latest-checkouts-with-substitutes url jobs)
   "Return a list of latest checkouts, sorted by descending substitutes
 coverage of the given JOBS list on the CI server at URL. Only evaluations for