[no subject]

[Mathieu Othacehe]

branch: master
commit bba1311478a50c837a8c70a556d308ca32ead816
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Tue Apr 6 15:15:18 2021 +0200

    Add jobs support.
    
    Each evaluation registration produces a list of new jobs. Until now, only 
the
    jobs which build outputs were not stored in the "Outputs" table were added 
to
    the "Builds" table.
    
    It means that Cuirass looses track of the job list associated to a given
    evaluation.  This is problematic to provide the overall build status of an
    evaluation or to find the evaluation providing the best build coverage.
    
    Add a new "Jobs" table that stores the job list of each evaluation.  Also 
add
    a new "/api/jobs" API to consult it.
    
    * src/sql/upgrade-2.sql: New file.
    * Makefile.am (dist_sql_DATA): Add it.
    * src/schema.sql (Jobs): New table.
    * src/cuirass/database.scm (db-add-job, db-get-jobs): New procedures.
    (db-register-builds): Call db-add-job.
    * src/cuirass/http.scm (url-handler): New "/api/jobs" route.
    * tests/database.scm ("db-get-jobs", "db-get-jobs names"): New tests.
    * doc/cuirass.texi (Web API, Database): Document it.
---
 Makefile.am              |  3 +-
 doc/cuirass.texi         | 74 ++++++++++++++++++++++++++++++++++++++++++++++++
 src/cuirass/database.scm | 47 ++++++++++++++++++++++++++++++
 src/cuirass/http.scm     | 13 +++++++++
 src/schema.sql           | 11 +++++++
 src/sql/upgrade-2.sql    | 14 +++++++++
 tests/database.scm       | 12 ++++++++
 7 files changed, 173 insertions(+), 1 deletion(-)

diff --git a/Makefile.am b/Makefile.am
index afaf6da..d9c87e2 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -88,7 +88,8 @@ nodist_webobject_DATA =                               \
 dist_pkgdata_DATA = src/schema.sql
 
 dist_sql_DATA =                                \
-  src/sql/upgrade-1.sql
+  src/sql/upgrade-1.sql                                \
+  src/sql/upgrade-2.sql
 
 dist_css_DATA =                                        \
   src/static/css/choices.min.css               \
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index 2513747..72c07ff 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -867,6 +867,56 @@ $ curl -s "http://localhost:8080/build/fff/log/raw";
 @{"error" : "Build with ID fff doesn't exist."@}
 @end example
 
+@subsection Jobs
+
+The list of jobs associated with a given evaluation can be obtained
+with the API "/api/jobs".  The output is a JSON array of
+jobs.
+
+This request accepts a mandatory parameter and multiple optional ones.
+
+@table @code
+@item evaluation
+The evaluation id. This parameter is @emph{mandatory}.
+
+@item names
+Filter query result to jobs which names are part of the given
+@code{names} list, a comma separated list of job names.
+
+@item system
+Filter query result to jobs with the given @code{system}.
+
+@end table
+
+For example, to ask for the jobs of evaluation @code{12} for
+@code{x86_64-linux}:
+
+@example
+$ curl "http://localhost:8080/api/jobs?evaluation=12&system=x86_64-linux";
+@end example
+
+or the @code{emacs} and @code{emacs-minimal} jobs of evaluation
+@code{12} for @code{x86_64-linux}:
+
+@example
+$ curl 
"http://localhost:8080/api/jobs?evaluation=12&names=emacs.x86_64-linux,emacs-minimal.x86_64-linux";
+@end example
+
+The nominal output is a JSON object whose fields are described
+hereafter.
+
+@table @code
+@item build
+The unique build id associated with the job.
+
+@item status
+The build status, as an integer.
+
+@item name
+The job name, as a string.
+
+@end table
+
 @subsection Latest builds
 
 The list of latest builds can be obtained with the API
@@ -1033,6 +1083,30 @@ The timestamp after evaluation completion.
 
 @end table
 
+@section Jobs
+@cindex jobs, database
+
+This table contains all the jobs associated with a given evaluation.
+If a new job produces build outputs that are not already stored inside
+the @code{Outputs} table then, it is added to the @code{Builds} table.
+
+@table @code
+@item name
+This text field holds the job name.
+
+@item evaluation
+This integer field references the evaluation identifier from the
+@code{Evaluations} table, indicating to which evaluation this job
+belongs.
+
+@item derivation
+This text field holds the absolute name of the job derivation file.
+
+@item system
+This text field holds the system name of the derivation.
+
+@end table
+
 @section Builds
 @cindex builds, database
 
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 2c77a6a..ef954f9 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -68,6 +68,7 @@
             db-get-outputs
             db-get-time-since-previous-build
             db-get-build-percentages
+            db-get-jobs
             db-register-builds
             db-update-build-status!
             db-update-build-worker!
@@ -677,6 +678,49 @@ AND b2.status >= 0 ORDER BY b1.id,  b2.id DESC) d;"))
          (loop rest
                (cons (string->number percentage) percentages)))))))
 
+(define (db-add-job job eval-id)
+  "Insert JOB into Jobs table for the EVAL-ID evaluation."
+  (let ((name       (assq-ref job #:job-name))
+        (derivation (assq-ref job #:derivation))
+        (system     (assq-ref job #:system)))
+    (with-db-worker-thread db
+      (exec-query/bind db "\
+INSERT INTO Jobs (name, evaluation, derivation, system)
+VALUES (" name ", " eval-id ", " derivation ", " system ")
+ON CONFLICT ON CONSTRAINT jobs_pkey DO NOTHING;"))))
+
+(define (db-get-jobs eval-id filters)
+  "Return the jobs inside Jobs table for the EVAL-ID evaluation that are
+matching the given FILTERS.  FILTERS is an assoc list whose possible keys are
+the symbols system and names."
+  (define (format-names names)
+    (format #f "{~a}" (string-join names ",")))
+
+  (with-db-worker-thread db
+    (let ((query "
+SELECT Builds.id, Builds.status, Jobs.name FROM Jobs
+INNER JOIN Builds ON Jobs.derivation = Builds.derivation
+WHERE Jobs.evaluation = :evaluation
+AND ((Jobs.system = :system) OR :system IS NULL)
+AND ((Jobs.name = ANY(:names)) OR :names IS NULL)
+ORDER BY Jobs.name")
+          (params
+           `((#:evaluation . ,eval-id)
+             (#:system . ,(assq-ref filters 'system))
+             (#:names . ,(and=> (assq-ref filters 'names)
+                                format-names)))))
+      (let loop ((rows (exec-query/bind-params db query params))
+                 (jobs '()))
+        (match rows
+          (() (reverse jobs))
+          (((id status name)
+            . rest)
+           (loop rest
+                 (cons `((#:build . ,(string->number id))
+                         (#:status . ,(string->number status))
+                         (#:name . ,name))
+                       jobs))))))))
+
 (define (db-register-builds jobs eval-id specification)
   (define (new-outputs? outputs)
     (let ((new-outputs
@@ -703,6 +747,9 @@ AND b2.status >= 0 ORDER BY b1.id,  b2.id DESC) d;"))
            (timeout    (assq-ref job #:timeout))
            (outputs    (assq-ref job #:outputs))
            (cur-time   (time-second (current-time time-utc))))
+      ;; Always register JOB inside the Jobs table.  If it triggers a new
+      ;; build, also register it into the Builds table below.
+      (db-add-job job eval-id)
       (and (new-outputs? outputs)
            (let ((build `((#:derivation . ,drv)
                           (#:eval-id . ,eval-id)
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index f848b42..dd5c352 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -687,6 +687,19 @@ into a specification record and return it."
                (append output
                        `((#:build . ,(or build #nil)))))))
            (respond-output-not-found id))))
+    (('GET "api" "jobs")
+     (let* ((params (request-parameters request))
+            (eval-id (assq-ref params 'evaluation)))
+       (if eval-id
+           (respond-json
+            (object->json-string
+             (list->vector
+              (db-get-jobs eval-id
+                           `((names
+                              . ,(and=> (assq-ref params 'names)
+                                        (cut string-split <> #\,)))
+                             ,@params)))))
+           (respond-json-with-error 500 "Parameter not defined!"))))
     (('GET "api" "evaluation")
      (let* ((params (request-parameters request))
             (id (assq-ref params 'id)))
diff --git a/src/schema.sql b/src/schema.sql
index de5e67d..3ce2bf1 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -24,6 +24,15 @@ CREATE TABLE Evaluations (
   FOREIGN KEY (specification) REFERENCES Specifications(name) ON DELETE CASCADE
 );
 
+CREATE TABLE Jobs (
+  name          TEXT NOT NULL,
+  evaluation    INTEGER NOT NULL,
+  derivation    TEXT NOT NULL,
+  system        TEXT NOT NULL,
+  PRIMARY KEY (evaluation, derivation),
+  FOREIGN KEY (evaluation) REFERENCES Evaluations(id) ON DELETE CASCADE
+);
+
 CREATE TABLE Checkouts (
   specification TEXT NOT NULL,
   revision      TEXT NOT NULL,
@@ -112,6 +121,8 @@ CREATE INDEX Builds_status_ts_id on Builds(status DESC, 
timestamp DESC, id ASC);
 CREATE INDEX Builds_priority_timestamp on Builds(priority ASC, timestamp DESC);
 CREATE INDEX Builds_weather_evaluation ON Builds (weather, evaluation);
 
+CREATE INDEX Jobs_name ON Jobs (name);
+
 CREATE INDEX Evaluations_status_index ON Evaluations (id, status);
 CREATE INDEX Evaluations_specification_index ON Evaluations (specification, id 
DESC);
 
diff --git a/src/sql/upgrade-2.sql b/src/sql/upgrade-2.sql
new file mode 100644
index 0000000..65ac9af
--- /dev/null
+++ b/src/sql/upgrade-2.sql
@@ -0,0 +1,14 @@
+BEGIN TRANSACTION;
+
+CREATE TABLE Jobs (
+  name          TEXT NOT NULL,
+  evaluation    INTEGER NOT NULL,
+  derivation    TEXT NOT NULL,
+  system        TEXT NOT NULL,
+  PRIMARY KEY (evaluation, derivation),
+  FOREIGN KEY (evaluation) REFERENCES Evaluations(id) ON DELETE CASCADE
+);
+
+CREATE INDEX Jobs_name ON Jobs (name);
+
+COMMIT;
diff --git a/tests/database.scm b/tests/database.scm
index f139638..07d1d00 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -201,6 +201,18 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 
0, 0);")
                                ("foo2" . ,(format #f "~a.output.2" drv))))))
                           2 (db-get-specification "guix"))))
 
+  (test-assert "db-get-jobs"
+    (match (db-get-jobs 2
+                        '((#:system . "x86_64-linux")))
+      ((job)
+       (string=? (assq-ref job #:name) "test"))))
+
+  (test-assert "db-get-jobs names"
+    (match (db-get-jobs 2
+                        '((names "test")))
+      ((job)
+       (string=? (assq-ref job #:name) "test"))))
+
   (test-assert "db-update-build-status!"
     (db-update-build-status! "/test.drv"
                              (build-status failed)))