branch master updated: database: Fix db-get-build-percentages.

[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 6932c56  database: Fix db-get-build-percentages.
6932c56 is described below

commit 6932c565ef825cf5daeb6f5bfe32ca76a6a73d9e
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Thu Apr 22 21:23:22 2021 +0200

    database: Fix db-get-build-percentages.
---
 src/cuirass/database.scm | 15 +++++++++++----
 src/cuirass/http.scm     |  6 +-----
 tests/database.scm       |  4 ++--
 3 files changed, 14 insertions(+), 11 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index afbca36..9c83925 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -673,7 +673,7 @@ WHERE specification = " specification
   (with-db-worker-thread db
     (let loop ((rows
                 (exec-query/bind db "
-SELECT CASE WHEN last_duration = 0 THEN
+SELECT id, CASE WHEN last_duration = 0 THEN
 0 ELSE LEAST(duration::float/last_duration * 100, 100)::int END AS percentage
 FROM (SELECT  DISTINCT ON (b1.id) b1.id AS id,
 COALESCE((b2.stoptime - b2.starttime), 0) AS last_duration,
@@ -685,9 +685,16 @@ ORDER BY b1.id,  b2.id DESC) d;"))
                (percentages '()))
       (match rows
         (() (reverse percentages))
-        (((percentage) . rest)
-         (loop rest
-               (cons (string->number percentage) percentages)))))))
+        (((id percentage) . rest)
+         (let ((build
+                (find (lambda (build)
+                        (eq? (assq-ref build #:id)
+                             (string->number id)))
+                      builds)))
+           (loop rest
+                 (cons `(,@build
+                         (#:percentage . ,(string->number percentage)))
+                       percentages))))))))
 
 (define (db-add-job job eval-id)
   "Insert JOB into Jobs table for the EVAL-ID evaluation.  It is possible that
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 45a000d..8c5b83f 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -1054,12 +1054,8 @@ passed, only display JOBS targeting this SYSTEM."
        "Workers status"
        (let* ((workers (db-get-workers))
               (builds (db-worker-current-builds))
-              (percentages (db-get-build-percentages builds))
               (builds*
-               (map (lambda (build percentage)
-                      `(,@build
-                        (#:percentage . ,percentage)))
-                    builds percentages)))
+               (db-get-build-percentages builds)))
          (workers-status workers builds*))
        '())))
 
diff --git a/tests/database.scm b/tests/database.scm
index 3f32130..b54bae2 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -539,8 +539,8 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 
0);")
         (db-add-build new)
         (match (db-get-build-percentages
                 (list (db-get-build (assq-ref new #:derivation))))
-          ((percentage)
-           (>= percentage 50))))))
+          ((build)
+           (>= (assq-ref build #:percentage) 50))))))
 
   (test-equal "db-update-build-status!"
     (list #f 1)