[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
|
From: |
Mathieu Othacehe |
|
Date: |
Mon, 19 Apr 2021 13:38:45 -0400 (EDT) |
branch: master
commit 79b85ab98dc8778724ef9524a1daa63f5c935b77
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Fri Apr 16 14:48:36 2021 +0200
Add "/api/jobs/history" API.
* src/cuirass/database.scm (db-get-jobs-history): New procedure.
* src/cuirass/http.scm (jobs-history->json-object): New procedure.
(url-handler): New "/api/jobs/history" route.
* tests/database.scm ("db-get-jobs-history"): New test.
---
doc/cuirass.texi | 53 ++++++++++++++++++++++++++++++++++++++++++++++--
src/cuirass/database.scm | 45 ++++++++++++++++++++++++++++++++++++++++
src/cuirass/http.scm | 33 ++++++++++++++++++++++++++++++
tests/database.scm | 12 ++++++++++-
4 files changed, 140 insertions(+), 3 deletions(-)
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index c12ce71..89eed92 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -932,6 +932,49 @@ The job name, as a string.
@end table
+@subsection Jobs history
+
+The history of jobs across the last evaluations of a given
+specification can be optained with the API "/api/jobs/history".
+
+This request accepts three mandatory parameters.
+
+@table @code
+@item specification
+The specification name. 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. This
+parameter is @emph{mandatory}.
+
+@item nr
+Limit query result to nr elements. This parameter is @emph{mandatory}.
+
+@end table
+
+For example, to ask for the history of @code{emacs.x86_64-linux} and
+@code{emacs-minimal.x86_64-linux} jobs of the @code{master}
+specification over the last 10 evaluations:
+
+@example
+$ curl
"http://localhost:8080/api/jobs/history?spec=master&names=emacs.x86_64-linux,emacs-minimal.x86_64-linux&nr=10";
+@end example
+
+The nominal output is a JSON array which objects have the following field:
+
+@table @code
+@item evaluation
+The unique evaluation id.
+
+@item checkouts
+The evaluation checkouts as a JSON array.
+
+@item name
+The jobs list for this evaluation, as a JSON array.
+
+@end table
+
@subsection Latest builds
The list of latest builds can be obtained with the API
@@ -1117,12 +1160,18 @@ This integer field references the evaluation identifier
from the
@code{Evaluations} table, indicating to which evaluation this job
belongs.
-@item builds
+@item build
This integer field references the build id from the @code{Builds}
table, corresponding to this job.
+@item status
+This integer field holds the build status of the above build. The
+goal of this duplication is to avoid expensive joins between the Jobs
+and Builds table.
+
@item system
-This text field holds the system name of the derivation.
+This text field holds the system name of the above build. This field
+is duplicated for the same reason as the above status field.
@end table
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index c3450a5..e140819 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -69,6 +69,7 @@
db-get-time-since-previous-eval
db-get-build-percentages
db-get-jobs
+ db-get-jobs-history
db-register-builds
db-update-build-status!
db-update-build-worker!
@@ -737,6 +738,50 @@ ORDER BY Jobs.name")
(#:name . ,name))
jobs))))))))
+(define* (db-get-jobs-history names #:key spec limit)
+ "Return the list of jobs from Jobs table which name is a member of the given
+NAMES list, for the last LIMIT evaluations of SPEC specification."
+ (define (format-names names)
+ (format #f "{~a}" (string-join names ",")))
+
+ (with-db-worker-thread db
+ (let ((query "
+SELECT name, evaluation, build, status FROM Jobs
+WHERE Jobs.evaluation IN (SELECT id FROM Evaluations
+WHERE specification = :spec AND status = 0
+ORDER BY id DESC LIMIT :nr)
+AND Jobs.name = ANY(:names);")
+ (params
+ `((#:spec . ,spec)
+ (#:names . ,(format-names names)))))
+ (let loop ((rows (exec-query/bind-params db query params))
+ (evaluations '()))
+ (match rows
+ (() (sort evaluations
+ (lambda (a b)
+ (let ((eval (cut assq-ref <> #:evaluation)))
+ (> (eval a) (eval b))))))
+ (((name evaluation build status)
+ . rest)
+ (loop rest
+ (let* ((eval (find (lambda (e)
+ (eq? (assq-ref e #:evaluation)
+ (string->number evaluation)))
+ evaluations))
+ (jobs (and eval
+ (assq-ref eval #:jobs)))
+ (job `((#:name . ,name)
+ (#:build . ,(string->number build))
+ (#:status . ,(string->number status)))))
+ (if eval
+ (begin
+ (assq-set! eval #:jobs (cons job jobs))
+ evaluations)
+ (cons `((#:evaluation . ,(string->number evaluation))
+ (#:checkouts . ,(db-get-checkouts evaluation))
+ (#:jobs . ,(list job)))
+ evaluations))))))))))
+
(define (db-register-builds jobs eval-id specification)
(define (new-outputs? outputs)
(let ((new-outputs
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 14aa302..7bd7aac 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -173,6 +173,18 @@
(#:systems . ,(list->vector
(specification-systems spec)))))
+(define (jobs-history->json-object history)
+ "Turn HISTORY into a representation suitable for 'json->scm'."
+ (object->json-string
+ (list->vector
+ (map (lambda (eval)
+ `((#:evaluation . ,(assq-ref eval #:evaluation))
+ (#:checkouts . ,(list->vector
+ (assq-ref eval #:checkouts)))
+ (#:jobs . ,(list->vector
+ (assq-ref eval #:jobs)))))
+ history))))
+
(define (handle-build-request build-id)
"Retrieve build identified by BUILD-ID over the database and convert it to
hydra format. Return #f is not build was found."
@@ -705,6 +717,27 @@ into a specification record and return it."
(cut string-split <> #\,)))
,@params)))))
(respond-json-with-error 500 "Parameter not defined!"))))
+ (('GET "api" "jobs" "history")
+ (let* ((params (request-parameters request))
+ (names (and=> (assq-ref params 'names)
+ (cut string-split <> #\,)))
+ (spec (assq-ref params 'spec))
+ (limit (assq-ref params 'nr)))
+ (cond
+ ((not (and names spec limit))
+ (respond-json-with-error 500 "Parameter not defined"))
+ ((> limit 100)
+ (respond-json-with-error 500 "Maximum limit exceeded"))
+ (else
+ (catch 'json-invalid
+ (lambda ()
+ (respond-json
+ (jobs-history->json-object
+ (db-get-jobs-history names
+ #:spec spec
+ #:limit limit))))
+ (lambda _
+ (respond-json-with-error 500 "Invalid body")))))))
(('GET "api" "evaluation")
(let* ((params (request-parameters request))
(id (assq-ref params 'id)))
diff --git a/tests/database.scm b/tests/database.scm
index 5385a15..5bf59db 100644
--- a/tests/database.scm
+++ b/tests/database.scm
@@ -235,6 +235,16 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0,
0, 0);")
#:derivation)
"/test.drv"))))
+ (test-assert "db-get-jobs-history"
+ (begin
+ (db-set-evaluation-status 4 (evaluation-status succeeded))
+ (match (db-get-jobs-history '("test")
+ #:spec "guix"
+ #:limit 2)
+ ((eval)
+ (and (eq? (assq-ref eval #:evaluation) 4)
+ (eq? (length (assq-ref eval #:jobs)) 1))))))
+
(test-assert "db-update-build-status!"
(db-update-build-status! "/test.drv"
(build-status failed)))
@@ -342,7 +352,7 @@ timestamp, checkouttime, evaltime) VALUES ('guix', 0, 0, 0,
0);")
(db-get-evaluations-id-max "foo"))
(test-equal "db-get-latest-evaluations"
- 1
+ 4
(match (db-get-latest-evaluations)
((eval)
(assq-ref eval #:evaluation))))