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

http: Add /eval/latest/dashboard endpoint.

Browse source 
* 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:
Ludovic Courtès 2023-06-02 00:25:43 +02:00
parent 0eb24588be
commit d0b08b0d40
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 27 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
src/cuirass/http.scm
View file

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

16
src/cuirass/templates.scm
View file

@ -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"))
(div
(@ (class "oi oi-monitor d-inline-block ml-2")
(title ,dashboard-name)
(aria-label ,dashboard-name))
"")))
'()))
`((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-"