mirror of
git://git.savannah.gnu.org/guix/guix-cuirass.git
synced 2023-12-14 06:03:04 +01:00
http: Add /eval/latest/dashboard endpoint.
* src/cuirass/http.scm (url-handler)[redirect]: New procedure. Add clause for /eval/latest/dashboard. * src/cuirass/templates.scm (specifications-table): Link to it.
This commit is contained in:
parent
0eb24588be
commit
d0b08b0d40
|
@ -512,6 +512,12 @@ passed, only display JOBS targeting this SYSTEM."
|
|||
(object->json-string
|
||||
`((error . ,message)))))
|
||||
|
||||
(define (redirect ref)
|
||||
(let ((uri (string->uri-reference ref)))
|
||||
(respond (build-response #:headers `((location . ,uri))
|
||||
#:code 302)
|
||||
#:body "Redirected...")))
|
||||
|
||||
(define* (respond-html body #:key code)
|
||||
(respond
|
||||
(let ((content-type '((content-type . (text/html)))))
|
||||
|
@ -968,6 +974,20 @@ passed, only display JOBS targeting this SYSTEM."
|
|||
(respond-compressed-file log)
|
||||
(respond-not-found (uri->string (request-uri request))))))
|
||||
|
||||
(('GET "eval" "latest" "dashboard")
|
||||
(let* ((params (request-parameters request))
|
||||
(spec (assq-ref params 'spec))
|
||||
(system (assq-ref params 'system))
|
||||
(evaluation-id (and spec (db-get-latest-evaluation spec))))
|
||||
(if evaluation-id
|
||||
(redirect (string-append "/eval/"
|
||||
(number->string evaluation-id)
|
||||
"/dashboard"
|
||||
(if system
|
||||
(string-append "?system=" system)
|
||||
"")))
|
||||
(respond-not-found "/eval/latest/dashboard"))))
|
||||
|
||||
(('GET "eval" (= string->number id) "dashboard")
|
||||
(let* ((params (request-parameters request))
|
||||
(spec (db-get-evaluation-specification id))
|
||||
|
|
|
@ -427,15 +427,13 @@ system whose names start with " (code "guile-") ":" (br)
|
|||
(string-append "Dashboard " name))
|
||||
(eval (and=> (spec->latest-eval-ok name)
|
||||
(cut assq-ref <> #:evaluation))))
|
||||
(if eval
|
||||
`((a (@ (href "/eval/" ,(assq-ref eval #:id)
|
||||
"/dashboard"))
|
||||
`((a (@ (href "/eval/latest/dashboard?spec="
|
||||
,(uri-encode name)))
|
||||
(div
|
||||
(@ (class "oi oi-monitor d-inline-block ml-2")
|
||||
(title ,dashboard-name)
|
||||
(aria-label ,dashboard-name))
|
||||
"")))
|
||||
'()))
|
||||
""))))
|
||||
,(let ((id
|
||||
(string-append
|
||||
"specDropdown-"
|
||||
|
|
Loading…
Reference in a new issue