guix/guix-cuirass
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git synced 2023-12-14 06:03:04 +01:00
Code Issues Releases Wiki Activity

Add evaluation retry & cancel support.

Browse source 
* 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.
This commit is contained in:
Mathieu Othacehe 2021-03-09 18:57:07 +01:00
parent d116dc36c3
commit 6c5da97d46
No known key found for this signature in database
GPG key ID: 8354763531769CA6
3 changed files with 39 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
src/cuirass/http.scm
View file

@ -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]"

14
src/cuirass/templates.scm
View file

@ -542,12 +542,24 @@ system whose names start with " (code "guile-") ":" (br)
(aria-haspopup "true")
(aria-expanded "false"))
" ")
(div (@ (class "dropdown-menu"))
(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 "" "" "" "")

5
tests/database.scm
View file

@ -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")