branch master updated: Improve worker status page queries.

[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 6438742  Improve worker status page queries.
6438742 is described below

commit 6438742f992eb30eaa36be2c975f5599c6ba0614
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Fri Mar 12 17:06:30 2021 +0100

    Improve worker status page queries.
---
 src/cuirass/database.scm | 58 +++++++++++++++++++++++++++++++++---------------
 src/cuirass/http.scm     | 16 ++++++-------
 tests/database.scm       | 22 ++++++++++++++++--
 3 files changed, 67 insertions(+), 29 deletions(-)

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index cf33076..6ff04c2 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -67,7 +67,7 @@
             db-get-output
             db-get-outputs
             db-get-time-since-previous-build
-            db-get-build-percentage
+            db-get-build-percentages
             db-register-builds
             db-update-build-status!
             db-update-build-worker!
@@ -100,6 +100,7 @@
             db-add-or-update-worker
             db-get-worker
             db-get-workers
+            db-worker-current-builds
             db-remove-unresponsive-workers
             db-clear-workers
             db-clear-build-queue
@@ -650,24 +651,28 @@ WHERE job_name  = " job-name "AND specification = " 
specification
        (string->number time))
       (else #f))))
 
-(define (db-get-build-percentage build-id)
-  "Return the build completion percentage for BUILD-ID."
+(define (db-get-build-percentages build-ids)
+  (define builds
+    (format #f "{~a}"
+            (string-join
+             (map number->string build-ids) ",")))
+
   (with-db-worker-thread db
-    (match (expect-one-row
-            (exec-query/bind db "
-SELECT LEAST(duration::float/last_duration * 100, 100)::int AS percentage FROM
-(SELECT (extract(epoch from now())::int - starttime) as duration,
-last_build.duration AS last_duration FROM builds,
-(SELECT GREATEST((stoptime - starttime), 1) AS duration FROM Builds
-WHERE job_name IN
-(SELECT job_name from Builds WHERE id = " build-id ")
-AND status >= 0
-ORDER BY Builds.timestamp DESC LIMIT 1) last_build
-where id = " build-id ") d;
-"))
-      ((time)
-       (string->number time))
-      (else #f))))
+    (let loop ((rows
+                (exec-query/bind db "
+SELECT LEAST(duration::float/last_duration * 100, 100)::int AS percentage
+FROM (SELECT  DISTINCT ON (b1.id) b1.id AS id,
+GREATEST((b2.stoptime - b2.starttime), 1) AS last_duration,
+(extract(epoch from now())::int - b1.starttime) AS duration FROM builds AS b1
+LEFT JOIN builds AS b2 ON b1.job_name = b2.job_name WHERE b1.id IN
+(SELECT id FROM builds WHERE id = ANY(" builds "))
+AND b2.status >= 0 ORDER BY b1.id,  b2.id DESC) d;"))
+               (percentages '()))
+      (match rows
+        (() (reverse percentages))
+        (((percentage) . rest)
+         (loop rest
+               (cons (string->number percentage) percentages)))))))
 
 (define (db-register-builds jobs eval-id specification)
   (define (new-outputs? outputs)
@@ -1450,6 +1455,23 @@ SELECT name, address, machine, systems, last_seen from 
Workers"))
                       (last-seen (string->number last-seen)))
                      workers)))))))
 
+(define (db-worker-current-builds)
+  "Return the list of builds that are been built on the available workers.
+Multiple builds can be marked as started on the same worker if the fetching
+workers do not keep up.  Only pick the build with the latest start time."
+  (with-db-worker-thread db
+    (let loop ((rows (exec-query db "
+SELECT DISTINCT ON (name) name, builds.id FROM Workers
+INNER JOIN Builds ON workers.name = builds.worker
+AND Builds.status = -1 ORDER BY name,
+Builds.starttime DESC, Builds.id DESC;"))
+               (builds '()))
+      (match rows
+        (() (reverse builds))
+        (((name id) . rest)
+         (loop rest
+               (cons (db-get-build (string->number id)) builds)))))))
+
 (define (db-remove-unresponsive-workers timeout)
   "Remove the workers that are unresponsive since at least TIMEOUT seconds.
 Also restart the builds that are started on those workers."
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 13ecd45..fdc71cf 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -857,15 +857,13 @@ into a specification record and return it."
       (html-page
        "Workers status"
        (let* ((workers (db-get-workers))
-              (builds  (db-get-builds `((status . started)
-                                        (order . status+submission-time))))
-              (builds* (map (lambda (build)
-                              (let* ((id (assoc-ref build #:id))
-                                     (percentage
-                                      (db-get-build-percentage id)))
-                                `(,@build
-                                  (#:percentage . ,percentage))))
-                            builds)))
+              (builds (db-worker-current-builds))
+              (percentages (db-get-build-percentages builds))
+              (builds*
+               (map (lambda (build percentage)
+                      `(,@build
+                        #:percentage . ,percentage))
+                    builds percentages)))
          (workers-status workers builds*))
        '())))
 
diff --git a/tests/database.scm b/tests/database.scm
index 9b3a60b..85afb95 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -450,7 +450,7 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 
0);")
                                       #:outputs `(("out" . "/bar"))))
       (sort (db-get-pending-derivations) string<?)))
 
-  (test-assert "db-get-build-percentage"
+  (test-assert "db-get-build-percentages"
     (begin
       (let* ((ts (time-second (current-time time-utc)))
              (old `((#:derivation . "/last.drv")
@@ -479,7 +479,9 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0, 
0);")
                (match (expect-one-row
                        (exec-query (%db) "SELECT MAX(id) FROM Builds;"))
                  ((id) (string->number id)))))
-          (>= (db-get-build-percentage last-id) 50)))))
+          (match (db-get-build-percentages (list last-id))
+            ((percentage)
+             (>= percentage 50)))))))
 
   (test-equal "db-update-build-status!"
     (list #f 1)
@@ -597,6 +599,22 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 
0, 0);")
         ((product)
          (equal? (assq-ref product #:path) (getcwd))))))
 
+  (test-assert "db-worker-current-builds"
+    (begin
+      (let ((drv-1
+             (db-add-build (make-dummy-build "/build-1.drv")))
+            (drv-2
+             (db-add-build (make-dummy-build "/build-2.drv"))))
+        (db-add-or-update-worker %dummy-worker)
+        (db-update-build-worker! drv-1 "worker")
+        (db-update-build-worker! drv-2 "worker")
+        (db-update-build-status! drv-1 (build-status started))
+        (db-update-build-status! drv-2 (build-status started))
+        (match (db-worker-current-builds)
+          ((build)
+           (eq? (assq-ref (db-get-build drv-2) #:id)
+                (assq-ref build #:id)))))))
+
   (test-assert "db-close"
     (begin
       (db-close (%db))