[no subject]

[Mathieu Othacehe]

branch: master
commit f6008378be3554a928896e18661038716ca2d64a
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Mon Mar 22 19:35:12 2021 +0100

    Add builds count per machine metric.
---
 src/cuirass/metrics.scm |  42 +++++++++++++++---
 tests/metrics.scm       | 115 +++++++++++++++++++++++++++---------------------
 2 files changed, 100 insertions(+), 57 deletions(-)

diff --git a/src/cuirass/metrics.scm b/src/cuirass/metrics.scm
index efd6d16..5f14dea 100644
--- a/src/cuirass/metrics.scm
+++ b/src/cuirass/metrics.scm
@@ -207,6 +207,26 @@ status = 0 ORDER BY id DESC" days)))
            (loop rest
                  (cons id evaluations))))))))
 
+(define (db-get-machines)
+  "Return the list of build machines."
+  (with-db-worker-thread db
+    (let ((query "SELECT DISTINCT ON (machine) machine FROM Workers"))
+      (let loop ((rows (exec-query db query))
+                 (machines '()))
+        (match rows
+          (() (reverse machines))
+          (((machine) . rest)
+           (loop rest
+                 (cons machine machines))))))))
+
+(define (db-builds-count-per-machine machine)
+  "Return the number of builds performed by MACHINE during the last day."
+  (with-db-worker-thread db
+    (return-exact
+     (exec-query/bind db "SELECT COUNT(*) FROM Workers LEFT JOIN Builds ON
+Workers.name = Builds.worker WHERE machine = " machine "AND
+to_timestamp(stoptime)::date > 'today'::date - interval '1 day'"))))
+
 
 ;;;
 ;;; Definitions.
@@ -283,7 +303,12 @@ status = 0 ORDER BY id DESC" days)))
    ;; Evaluation completion speed in builds/hour.
    (metric
     (id 'evaluation-completion-speed)
-    (compute-proc db-evaluation-completion-speed))))
+    (compute-proc db-evaluation-completion-speed))
+
+   ;; Builds count per machine during the last day.
+   (metric
+    (id 'builds-per-machine-per-day)
+    (compute-proc db-builds-count-per-machine))))
 
 (define (metric->type metric)
   "Return the index of the given METRIC in %metrics list.  This index is used
@@ -359,10 +384,8 @@ for periodical metrics for instance."
             (log-message "Updating metric ~a (~a) to ~a."
                          (symbol->string id) field value)
             (exec-query/bind db "\
-INSERT INTO Metrics (field, type, value,
-timestamp) VALUES ("
-                             field ", "
-                             (metric->type metric) ", "
+INSERT INTO Metrics (field, type, value, timestamp) VALUES ("
+                             field ", " (metric->type metric) ", "
                              value ", "
                              now ")
 ON CONFLICT ON CONSTRAINT metrics_pkey DO
@@ -377,7 +400,8 @@ UPDATE SET value = " value ", timestamp = " now ";"))
   (with-db-worker-thread db
     (let ((specifications
            (map specification-name (db-get-specifications)))
-          (evaluations (db-latest-evaluations)))
+          (evaluations (db-latest-evaluations))
+          (machines (db-get-machines)))
       (exec-query db "BEGIN TRANSACTION;")
 
       (db-update-metric 'builds-per-day)
@@ -411,4 +435,10 @@ UPDATE SET value = " value ", timestamp = " now ";"))
                    'evaluation-completion-speed evaluation))
                 evaluations)
 
+      ;; Update machine related metrics.
+      (for-each (lambda (machine)
+                  (db-update-metric
+                   'builds-per-machine-per-day machine))
+                machines)
+
       (exec-query db "COMMIT;"))))
diff --git a/tests/metrics.scm b/tests/metrics.scm
index 7cdcc4a..ec689e5 100644
--- a/tests/metrics.scm
+++ b/tests/metrics.scm
@@ -1,6 +1,5 @@
-;;;; database.scm - tests for (cuirass metrics) module
-;;;
-;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
+;;; metrics.scm - tests for the (cuirass metrics) module
+;;; Copyright © 2020, 2021 Mathieu Othacehe <othacehe@gnu.org>
 ;;;
 ;;; This file is part of Cuirass.
 ;;;
@@ -60,6 +59,9 @@ INSERT INTO Evaluations (specification, status,
 timestamp, checkouttime, evaltime) VALUES ('guix', 1, 1600174547,
 1600174548, 1600174647);")
       (exec-query (%db) (format #f "\
+INSERT INTO Workers (name, address, machine, systems, last_seen) VALUES
+('worker', '10.0.0.1', 'machine', 'x86_64-linux', 0);"))
+      (exec-query (%db) (format #f "\
 INSERT INTO Builds (id, derivation, evaluation, job_name, system,
 nix_name, log, status, timestamp, starttime, stoptime) VALUES
 (1, '/gnu/store/1.drv', 2, '', '', '', '', 0, ~a, ~a, ~a);\
@@ -80,57 +82,68 @@ nix_name, log, status, timestamp, starttime, stoptime) 
VALUES
       (db-update-metric 'average-eval-duration-per-spec "guix")
       (db-get-metrics-with-id 'average-eval-duration-per-spec)))
 
-    (test-equal "builds-per-day"
-      1.0
-      (begin
-        (db-update-metric 'builds-per-day)
-        (db-get-metric 'builds-per-day yesterday)))
-
-    (test-equal "pending-builds"
-      `((,today . 1.0))
-      (begin
-        (db-update-metric 'pending-builds)
-        (db-get-metrics-with-id 'pending-builds)))
-
-    (test-equal "new-derivations-per-day"
-      `((,yesterday . 1.0))
-      (begin
-        (db-update-metric 'new-derivations-per-day)
-        (db-get-metrics-with-id 'new-derivations-per-day)))
-
-    (test-equal "percentage-failed-eval-per-spec"
-      `(("guix" . 50.0))
-      (begin
-        (db-update-metric 'percentage-failed-eval-per-spec "guix")
-        (db-get-metrics-with-id 'percentage-failed-eval-per-spec)))
-
-    (test-equal "db-update-metrics"
-      `((,today . 2.0))
-      (begin
-        (exec-query (%db) (format #f "\
+  (test-equal "builds-per-day"
+    1.0
+    (begin
+      (db-update-metric 'builds-per-day)
+      (db-get-metric 'builds-per-day yesterday)))
+
+  (test-equal "pending-builds"
+    `((,today . 1.0))
+    (begin
+      (db-update-metric 'pending-builds)
+      (db-get-metrics-with-id 'pending-builds)))
+
+  (test-equal "new-derivations-per-day"
+    `((,yesterday . 1.0))
+    (begin
+      (db-update-metric 'new-derivations-per-day)
+      (db-get-metrics-with-id 'new-derivations-per-day)))
+
+  (test-equal "percentage-failed-eval-per-spec"
+    `(("guix" . 50.0))
+    (begin
+      (db-update-metric 'percentage-failed-eval-per-spec "guix")
+      (db-get-metrics-with-id 'percentage-failed-eval-per-spec)))
+
+  (test-equal "db-update-metrics"
+    `((,today . 2.0))
+    (begin
+      (exec-query (%db) (format #f "\
 INSERT INTO Builds (id, derivation, evaluation, job_name, system,
 nix_name, log, status, timestamp, starttime, stoptime) VALUES
 (4, '/gnu/store/4.drv', 1, '', '', '', '', -2, 0, 0, 0);"))
-        (db-update-metrics)
-        (db-get-metrics-with-id 'pending-builds)))
-
-    (test-equal "average-eval-build-start-time"
-      `((2 . 1000.0))
-      (begin
-        (db-update-metric 'average-eval-build-start-time 2)
-        (db-get-metrics-with-id 'average-eval-build-start-time)))
-
-    (test-equal "average-eval-build-complete-time"
-      `((2 . 2000.0))
-      (begin
-        (db-update-metric 'average-eval-build-complete-time 2)
-        (db-get-metrics-with-id 'average-eval-build-complete-time)))
-
-    (test-equal "evaluation-completion-speed"
-      900.0
-      (begin
-        (db-update-metric 'evaluation-completion-speed 4)
-        (db-get-metric 'evaluation-completion-speed 4)))
+      (db-update-metrics)
+      (db-get-metrics-with-id 'pending-builds)))
+
+  (test-equal "average-eval-build-start-time"
+    `((2 . 1000.0))
+    (begin
+      (db-update-metric 'average-eval-build-start-time 2)
+      (db-get-metrics-with-id 'average-eval-build-start-time)))
+
+  (test-equal "average-eval-build-complete-time"
+    `((2 . 2000.0))
+    (begin
+      (db-update-metric 'average-eval-build-complete-time 2)
+      (db-get-metrics-with-id 'average-eval-build-complete-time)))
+
+  (test-equal "evaluation-completion-speed"
+    900.0
+    (begin
+      (db-update-metric 'evaluation-completion-speed 4)
+      (db-get-metric 'evaluation-completion-speed 4)))
+
+  (test-equal "builds-per-machine"
+    1.0
+    (begin
+      (exec-query (%db) (format #f "\
+INSERT INTO Builds (id, derivation, evaluation, job_name, system,
+worker, nix_name, log, status, timestamp, starttime, stoptime) VALUES
+(5, '/gnu/store/5.drv', 2, '', '', 'worker', '', '', 0, ~a, ~a, ~a);\
+" today (+ today 1600) (+ today 2600)))
+      (db-update-metric 'builds-per-machine-per-day "machine")
+      (db-get-metric 'builds-per-machine-per-day "machine")))
 
   (test-assert "db-close"
     (begin