branch master updated: Add evaluation retry & cancel support.

[Mathieu Othacehe]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix-cuirass.

The following commit(s) were added to refs/heads/master by this push:
     new 6c5da97  Add evaluation retry & cancel support.
6c5da97 is described below

commit 6c5da97d46f8425c20b24f2b89591c5495896172
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Tue Mar 9 18:57:07 2021 +0100

    Add evaluation retry & cancel support.
    
    * src/cuirass/http.scm (url-handler): Add "/admin/evaluation/<id>/cancel" 
and
    "admin/evaluation/<id>/retry" routes.
    * src/cuirass/templates.scm (evaluation-info-table): Add "Cancel pending
    builds" and "Retry" buttons.
---
 src/cuirass/http.scm      | 24 ++++++++++++++++++++++++
 src/cuirass/templates.scm | 14 +++++++++++++-
 tests/database.scm        |  5 ++---
 3 files changed, 39 insertions(+), 4 deletions(-)

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 14ba07f..2ea8b89 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -504,6 +504,18 @@ Hydra format."
                                  (string-append "/build/" id "/details")))))
       #:body ""))
 
+    (('GET "admin" "evaluation" id "cancel")
+     (let* ((eval (db-get-evaluation id))
+            (specification (assq-ref eval #:specification)))
+       (db-cancel-pending-builds! (string->number id))
+       (respond
+        (build-response
+         #:code 302
+         #:headers `((location
+                      . ,(string->uri-reference
+                          (string-append "/jobset/" specification)))))
+        #:body "")))
+
     (('GET "admin" "evaluation" id "restart")
      (let* ((eval (db-get-evaluation id))
             (specification (assq-ref eval #:specification)))
@@ -516,6 +528,18 @@ Hydra format."
                           (string-append "/jobset/" specification)))))
         #:body "")))
 
+    (('GET "admin" "evaluation" id "retry")
+     (let* ((eval (db-get-evaluation id))
+            (specification (assq-ref eval #:specification)))
+       (db-retry-evaluation! (string->number id))
+       (respond
+        (build-response
+         #:code 302
+         #:headers `((location
+                      . ,(string->uri-reference
+                          (string-append "/jobset/" specification)))))
+        #:body "")))
+
     (('GET "admin")
      (respond-html (html-page
                     "Cuirass [Admin]"
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index a6cef8f..1d4eefb 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -546,8 +546,20 @@ system whose names start with " (code "guile-") ":" (br)
                                (a (@ (class "oi oi-lock-locked dropdown-item")
                                      (href "/admin/evaluation/"
                                            ,(assq-ref row #:id)
+                                           "/cancel"))
+                                  " Cancel pending builds"))
+                          (div (@ (class "dropdown-menu"))
+                               (a (@ (class "oi oi-lock-locked dropdown-item")
+                                     (href "/admin/evaluation/"
+                                           ,(assq-ref row #:id)
                                            "/restart"))
-                                  " Restart"))))))
+                                  " Restart"))
+                          (div (@ (class "dropdown-menu"))
+                               (a (@ (class "oi oi-lock-locked dropdown-item")
+                                     (href "/admin/evaluation/"
+                                           ,(assq-ref row #:id)
+                                           "/retry"))
+                                  " Retry"))))))
                  evaluations)))))
     ,(if (null? evaluations)
          (pagination "" "" "" "")
diff --git a/tests/database.scm b/tests/database.scm
index ab6df55..877a46d 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -535,11 +535,10 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 
0, 0);")
       (eq? (assq-ref (db-get-build "/old-build.drv") #:status)
            (build-status scheduled))))
 
-  (test-equal "db-retry-evaluation!"
-    '()
+  (test-assert "db-retry-evaluation!"
     (begin
       (db-retry-evaluation! 4)
-      (db-get-checkouts 4)))
+      (null? (db-get-checkouts 4))))
 
   (test-assert "db-cancel-pending-builds!"
     (let* ((drv "/old-build.drv")