guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[no subject]


From: Ludovic Courtès
Date: Thu, 1 Jun 2023 18:43:48 -0400 (EDT)

branch: master
commit d0b08b0d409ec3b656f4d9fe40ffe14e81ba8a16
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Jun 2 00:25:43 2023 +0200

    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.
---
 src/cuirass/http.scm      | 20 ++++++++++++++++++++
 src/cuirass/templates.scm | 16 +++++++---------
 2 files changed, 27 insertions(+), 9 deletions(-)

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index a9fc3ea..cee0811 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -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))
diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
index f723074..d852ca0 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -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-"



reply via email to

[Prev in Thread] Current Thread [Next in Thread]