diff options
| -rw-r--r-- | doc/cuirass.texi | 191 | ||||
| -rw-r--r-- | src/cuirass/database.scm | 29 | ||||
| -rw-r--r-- | src/cuirass/http.scm | 150 | ||||
| -rw-r--r-- | src/cuirass/utils.scm | 22 | ||||
| -rw-r--r-- | tests/http.scm | 219 |
5 files changed, 542 insertions, 69 deletions
diff --git a/doc/cuirass.texi b/doc/cuirass.texi index add13e0..c09f801 100644 --- a/doc/cuirass.texi +++ b/doc/cuirass.texi @@ -57,6 +57,7 @@ Tutorial sections: Reference sections: * Invocation:: How to run Cuirass. * Database:: About the database schema. +* Web API:: Description of the Web API. * Contributing:: Your help needed! * GNU Free Documentation License:: The license of this manual. @@ -381,8 +382,198 @@ This text field holds the name of the output. This text field holds the path of the output. @end table + +@c ********************************************************************* +@node Web API +@chapter Web API +@cindex web api + +Cuirass web API is derived from Hydra one, see @url{https://github.com/NixOS/hydra/blob/master/doc/manual/api.xml, Hydra API description}. + +For now only a subset of this API is implemented. + +@section API description +@cindex description, json + +@subsection Build information + +It is possible to query Cuirass web server for build informations. The +dedicated API is "/build/@var{build-id}" where @var{build-id} is the +unique id associated to the build in database. + +For instance, querying a local Cuirass web server can be done with +@code{curl} and @code{jq} to format the JSON response : + +@example +$ curl -s "http://localhost:8080/build/2" | jq + +@{ + "id": 2, + "project": "guix", + "jobset": "master", + "job": "acpica-20150410-job", + "timestamp": 1501347493, + "starttime": 1501347493, + "stoptime": 1501347493, + "buildoutputs": @{ + "out": @{ + "path": "/gnu/store/6g3njhfzqpdm335s7qhvmwvs5l7gcbq1-acpica-20150410" + @} + @}, + "system": "x86_64-linux", + "nixname": "acpica-20150410", + "buildstatus": 0, + "busy": 0, + "priority": 0, + "finished": 1, + "buildproducts": null, + "releasename": null, + "buildinputs_builds": null +@} +@end example + +If requested @var{build-id} is not known, the HTTP code 404 is +answered with a JSON error message. For example : + +@example +$ curl -s "http://localhost:8080/build/fff" + +@{"error" : "Build with ID fff doesn't exist."@} +@end example + +The nominal output is a JSON object whose fields are described +hereafter. + +@table @code +@item id +The unique build id. + +@item project +The associated specification name, as a string. + +@item jobset +The associated specification branch, as a string. + +@item job +The associated job-name, as a string. + +@item timestamp +Timestamp taken at build creation time. + +@item starttime +Timestamp taken at build start time. + +@item stoptime +Timestamp taken at build stop time. + +@item buildoutputs +Build outputs as a JSON object. The keys names are referring to the +eventual output names. The associated value is another JSON object which +only key is @code{path}. @code{path} value is the output directory in +store as a string. + +@item system +System name of the build, as a string. + +@item nixname +Derivation name, as a string. + +@item buildstatus +Build status, as an integer. Possible values are : + +@example +0 -> succeeded +1 -> failed +2 -> failed dependency +3 -> failed other +4 -> cancelled +@end example + +@item busy +Whether the build is pending, as an integer (not implemented yet). + +@item priority +Build priority, as an integer (not implemented yet). + +@item finished +Build finished, as an integer (not implemented yet : always 1). + +@item buildproducts +Build products in store as a JSON object (not implemented yet). + +@item releasename +Unknown, not implemented yet. + +@item buildinputs_builds +Inputs used for the build, as a JSON object (not implemented yet). + +@end table + +@subsection Build raw log output + +It is possible to ask Cuirass for the raw build output log with the API +"/build/@var{build-id}/log/raw" where @var{build-id} is the +unique id associated to the build in database. + +The output is a raw text, for example : + +@example +$ curl http://localhost:8080/build/2/log/raw + +starting phase `set-SOURCE-DATE-EPOCH' +phase `set-SOURCE-DATE-EPOCH' succeeded after 0.0 seconds +starting phase `set-paths' +... +@end example + +If requested @var{build-id} is not known, the HTTP code 404 is +answered with a JSON error message. For example : + +@example +$ curl -s "http://localhost:8080/build/fff/log/raw" + +@{"error" : "Build with ID fff doesn't exist."@} +@end example + +@subsection Latest builds + +The list of latest builds can be obtained with the API +"/api/latestbuilds". The output is a JSON array of +builds. Builds are represented as in "/build/@var{build-id} API. + +This request accepts a mandatory parameter and multiple optional ones. + +@table @code +@item nr +Limit query result to nr elements. This parameter is @emph{mandatory}. + +@item project +Filter query result to builds with the given @code{project}. + +@item jobset +Filter query result to builds with the given @code{jobset}. + +@item job +Filter query result to builds with the given @code{job} name. + +@item system +Filter query result to builds with the given @code{system}. + @end table +For example, to ask for the ten last builds : + +@example +$ curl "http://localhost:8080/api/latestbuilds?nr=10" +@end example + +or the five last builds which project is ``guix'' and jobset ``master' : + +@example +$ curl "http://localhost:8080/api/latestbuilds?nr=5&project=guix&jobset=master" +@end example + +If no builds matching given parameters are found and empty JSON array is returned. @c ********************************************************************* @node Contributing diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 37d126c..0c7c8f8 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -232,7 +232,7 @@ INSERT INTO Outputs (build, name, path) VALUES ('~A', '~A', '~A');" outputs)))))) (define db-build-request "\ -SELECT Builds.id, Builds.timestamp, Builds.starttime, Builds.stoptime, Builds.log, Builds.status,\ +SELECT Builds.id, Builds.timestamp, Builds.starttime, Builds.stoptime, Builds.log, Builds.status, Builds.derivation,\ Derivations.job_name, Derivations.system, Derivations.nix_name,\ Specifications.repo_name, Specifications.branch \ FROM Builds \ @@ -242,20 +242,21 @@ INNER JOIN Specifications ON Evaluations.specification = Specifications.repo_nam (define (db-format-build db build) (match build - (#(id timestamp starttime stoptime log status job-name system + (#(id timestamp starttime stoptime log status derivation job-name system nix-name repo-name branch) - `((#:id . ,id) - (#:timestamp . ,timestamp) - (#:starttime . ,starttime) - (#:stoptime . ,stoptime) - (#:log . ,log) - (#:status . ,status) - (#:job-name . ,job-name) - (#:system . ,system) - (#:nix-name . ,nix-name) - (#:repo-name . ,repo-name) - (#:outputs . ,(db-get-outputs db id)) - (#:branch . ,branch))))) + `((#:id . ,id) + (#:timestamp . ,timestamp) + (#:starttime . ,starttime) + (#:stoptime . ,stoptime) + (#:log . ,log) + (#:status . ,status) + (#:derivation . ,derivation) + (#:job-name . ,job-name) + (#:system . ,system) + (#:nix-name . ,nix-name) + (#:repo-name . ,repo-name) + (#:outputs . ,(db-get-outputs db id)) + (#:branch . ,branch))))) (define (db-get-build db id) "Retrieve a build in database DB which corresponds to ID." diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index 33cd37b..23c3ad7 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -1,5 +1,6 @@ ;;;; http.scm -- HTTP API ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> +;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; ;;; This file is part of Cuirass. ;;; @@ -19,52 +20,147 @@ (define-module (cuirass http) #:use-module (cuirass database) #:use-module (cuirass utils) - #:use-module (ice-9 hash-table) + #:use-module (guix config) + #:use-module (guix build utils) + #:use-module (guix utils) #:use-module (ice-9 match) + #:use-module (ice-9 popen) #:use-module (json) #:use-module (web request) #:use-module (web response) #:use-module (web server) #:use-module (web uri) - #:export (spec->json-string - run-cuirass-server)) + #:export (run-cuirass-server)) -;;; -;;; JSON format. -;;; +(define (build->hydra-build build) + "Convert BUILD to an assoc list matching hydra API format." + `((#:id . ,(assq-ref build #:id)) + (#:project . ,(assq-ref build #:repo-name)) + (#:jobset . ,(assq-ref build #:branch)) + (#:job . ,(assq-ref build #:job-name)) + (#:timestamp . ,(assq-ref build #:timestamp)) + (#:starttime . ,(assq-ref build #:starttime)) + (#:stoptime . ,(assq-ref build #:stoptime)) + (#:buildoutputs . ,(assq-ref build #:outputs)) + (#:system . ,(assq-ref build #:system)) + (#:nixname . ,(assq-ref build #:nix-name)) + (#:buildstatus . ,(assq-ref build #:status)) + + ;; TODO: Fill the fields above with correct values. + (#:busy . 0) + (#:priority . 0) + (#:finished . 1) + (#:buildproducts . #nil) + (#:releasename . #nil) + (#:buildinputs_builds . #nil))) + +(define (handle-build-request db build-id) + "Retrieve build identified by BUILD-ID in DB and convert it to hydra + format. Return #f is not build was found." + (let ((build (db-get-build db build-id))) + (and=> build build->hydra-build))) -(define (object->json-scm obj) - "Prepare OBJ for JSON usage." - (cond ((string? obj) obj) - ((number? obj) obj) - ((boolean? obj) obj) - ((null? obj) obj) - ((symbol? obj) (symbol->string obj)) - ((keyword? obj) (object->json-scm (keyword->symbol obj))) - ((alist? obj) (alist->hash-table (map object->json-scm obj))) - ((pair? obj) (cons (object->json-scm (car obj)) - (object->json-scm (cdr obj)))) - (else (object->string obj)))) - -(define* (spec->json-string spec #:key pretty) - "Return SPEC as a JSON object." - (scm->json-string (object->json-scm spec) #:pretty pretty)) +(define (handle-builds-request db filters) + "Retrieve all builds matched by FILTERS in DB and convert them to hydra + format." + (let ((builds (db-get-builds db filters))) + (map build->hydra-build builds))) + +(define (handle-log-request db build) + "Retrieve the log file of BUILD. Return a lambda which PORT argument is an + input port from which the content of the log file can be read or #f if the + log file is not readable." + (let* ((log (assq-ref build #:log)) + (access (and (string? log) + (access? log R_OK)))) + (and access + (lambda (out-port) + (let ((in-pipe-port + (open-input-pipe + (format #f "~a -dc ~a" %bzip2 log)))) + (dump-port in-pipe-port out-port) + (close-pipe in-pipe-port)))))) + +(define (request-parameters request) + "Parse the REQUEST query parameters and return them under the form + '((parameter value) ...)." + (let* ((uri (request-uri request)) + (query (uri-query uri))) + (and query + (map (lambda (param) + (match (string-split param #\=) + ((key param) + (list (string->symbol key) param)))) + (string-split query #\&))))) ;;; ;;; Web server. ;;; +;;; The api is derived from the hydra one. It is partially described here : +;;; +;;; https://github.com/NixOS/hydra/blob/master/doc/manual/api.xml +;;; (define (request-path-components request) (split-and-decode-uri-path (uri-path (request-uri request)))) (define (url-handler request body db) + (define* (respond response #:key body (db db)) (values response body db)) + + (define-syntax-rule (respond-json body ...) + (respond '((content-type . (application/json))) + #:body body ...)) + + (define-syntax-rule (respond-text body ...) + (respond '((content-type . (text/plain))) + #:body body ...)) + + (define-syntax-rule (respond-json-with-error error-code message) + (respond + (build-response #:headers '((content-type . (application/json))) + #:code error-code) + #:body + (object->json-string + `((error . ,message))))) + + (define (respond-build-not-found build-id) + (respond-json-with-error + 404 + (format #f "Build with ID ~a doesn't exist." build-id))) + + (define (respond-build-log-not-found build) + (let ((drv (assq-ref build #:derivation))) + (respond-json-with-error + 404 + (format #f "The build log of derivation ~a is not available." drv)))) + (match (request-path-components request) (((or "jobsets" "specifications") . rest) - (respond '((content-type . (application/json))) - #:body (spec->json-string (car (db-get-specifications db))))) + (respond-json (object->json-string (car (db-get-specifications db))))) + (("build" build-id) + (let ((hydra-build (handle-build-request db build-id))) + (if hydra-build + (respond-json (object->json-string hydra-build)) + (respond-build-not-found build-id)))) + (("build" build-id "log" "raw") + (let ((build (db-get-build db build-id))) + (if build + (let ((log-response (handle-log-request db build))) + (if log-response + (respond-text log-response) + (respond-build-log-not-found build))) + (respond-build-not-found build-id)))) + (("api" "latestbuilds") + (let* ((params (request-parameters request)) + ;; 'nr parameter is mandatory to limit query size. + (valid-params? (assq-ref params 'nr))) + (if valid-params? + (respond-json (object->json-string + (handle-builds-request db params))) + (respond-json-with-error 500 "Parameter not defined!")))) (_ (respond (build-response #:code 404) #:body (string-append "Resource not found: " @@ -73,6 +169,6 @@ (define* (run-cuirass-server db #:key (port 8080)) (format (current-error-port) "listening on port ~A~%" port) (run-server url-handler - 'http ;server implementation - `(#:port ,port) ;implementation parameters - db)) ;state + 'http + `(#:port ,port) + db)) diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm index d966543..a932674 100644 --- a/src/cuirass/utils.scm +++ b/src/cuirass/utils.scm @@ -21,9 +21,29 @@ (define-module (cuirass utils) #:use-module (ice-9 match) #:use-module (srfi srfi-1) - #:export (alist?)) + #:use-module (json) + #:export (alist? + object->json-scm + object->json-string)) (define (alist? obj) "Return #t if OBJ is an alist." (and (list? obj) (every pair? obj))) + +(define (object->json-scm obj) + "Prepare OBJ for JSON usage." + (cond ((string? obj) obj) + ((number? obj) obj) + ((boolean? obj) obj) + ((null? obj) obj) + ((symbol? obj) (symbol->string obj)) + ((keyword? obj) (object->json-scm (keyword->symbol obj))) + ((alist? obj) (map object->json-scm obj)) + ((pair? obj) (cons (object->json-scm (car obj)) + (object->json-scm (cdr obj)))) + (else (object->string obj)))) + +(define* (object->json-string object #:key pretty) + "Return OBJECT as a JSON object." + (scm->json-string (object->json-scm object) #:pretty pretty)) diff --git a/tests/http.scm b/tests/http.scm index 4c5214d..99daf23 100644 --- a/tests/http.scm +++ b/tests/http.scm @@ -1,6 +1,7 @@ ;;; http.scm -- tests for (cuirass http) module ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; ;;; This file is part of Cuirass. ;;; @@ -18,7 +19,14 @@ ;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>. (use-modules (cuirass http) + (cuirass database) + (cuirass utils) + (guix utils) + (guix build utils) (json) + (web client) + (web response) + (rnrs bytevectors) (srfi srfi-1) (srfi srfi-64)) @@ -42,30 +50,187 @@ #t t1))) -(test-begin "http") - -(test-assert "spec->json-string" - ;; Note: We cannot compare the strings directly because field ordering - ;; depends on the hash algorithm used in Guile's hash tables, and that - ;; algorithm changed in Guile 2.2. - (hash-table=? - (call-with-input-string - (string-append "{" - "\"boolean\" : false," - "\"string\" : \"guix\"," - "\"alist\" : {\"subset\" : \"hello\"}," - "\"list\" : [1, \"2\", \"three\"]," - "\"symbol\" : \"hydra-jobs\"," - "\"number\" : 1" - "}") - json->scm) - (call-with-input-string - (spec->json-string '((#:number . 1) - (string . "guix") - ("symbol" . hydra-jobs) - (#:alist (subset . "hello")) - (list 1 "2" #:three) - ("boolean" . #f))) - json->scm))) - -(test-end) +(define (http-get-body uri) + (call-with-values (lambda () (http-get uri)) + (lambda (response body) body))) + +(define (wait-until-ready port) + ;; Wait until the server is accepting connections. + (let ((conn (socket PF_INET SOCK_STREAM 0))) + (let loop () + (unless (false-if-exception + (connect conn AF_INET (inet-pton AF_INET "127.0.0.1") port)) + (loop))))) + +(define (test-cuirass-uri route) + (string-append "http://localhost:6688" route)) + +(define database-name + ;; Use an empty and temporary database for the tests. + (string-append (getcwd) "/" (number->string (getpid)) "-tmp.db")) + +(define %db + ;; Global Slot for a database object. + (make-parameter #t)) + +(define build-query-result + '((#:id . 1) + (#:project . "guix") + (#:jobset . "master") + (#:job . "fake-job") + (#:timestamp . 1501347493) + (#:starttime . 1501347493) + (#:stoptime . 1501347493) + (#:buildoutputs . ((out ("path" . "/gnu/store/fake-1.0")))) + (#:system . "x86_64-linux") + (#:nixname . "fake-1.0") + (#:buildstatus . 0) + (#:busy . 0) + (#:priority . 0) + (#:finished . 1) + (#:buildproducts . #nil) + (#:releasename . #nil) + (#:buildinputs_builds . #nil))) + +(define log-file-name + ;; Use a fake temporary log file. + (string-append (getcwd) "/" (number->string (getpid)) "-log.txt")) + +(call-with-output-file log-file-name + ;; Write "build log" string compressed with bzip2 inside LOG-FILE-NAME. + (lambda (out) + (dump-port + (call-with-input-string "build log" + (lambda (port) + (compressed-port 'bzip2 port))) + out))) + +(test-group-with-cleanup "http" + (test-assert "object->json-string" + ;; Note: We cannot compare the strings directly because field ordering + ;; depends on the hash algorithm used in Guile's hash tables, and that + ;; algorithm changed in Guile 2.2. + (hash-table=? + (call-with-input-string + (string-append "{" + "\"boolean\" : false," + "\"string\" : \"guix\"," + "\"alist\" : {\"subset\" : \"hello\"}," + "\"list\" : [1, \"2\", \"three\"]," + "\"symbol\" : \"hydra-jobs\"," + "\"number\" : 1" + "}") + json->scm) + (call-with-input-string + (object->json-string '((#:number . 1) + (string . "guix") + ("symbol" . hydra-jobs) + (#:alist (subset . "hello")) + (list 1 "2" #:three) + ("boolean" . #f))) + json->scm))) + + (test-assert "db-init" + (%db (db-init database-name))) + + (test-assert "cuirass-run" + (call-with-new-thread + (lambda () + (run-cuirass-server (%db) #:port 6688)))) + + (test-assert "wait-server" + (wait-until-ready 6688)) + + (test-assert "fill-db" + (let ((build + `((#:derivation . "/gnu/store/fake.drv") + (#:eval-id . 1) + (#:log . ,log-file-name) + (#:status . 0) + (#:outputs . (("out" . "/gnu/store/fake-1.0"))) + (#:timestamp . 1501347493) + (#:starttime . 1501347493) + (#:stoptime . 1501347493))) + (derivation + '((#:derivation . "/gnu/store/fake.drv") + (#:job-name . "fake-job") + (#:system . "x86_64-linux") + (#:nix-name . "fake-1.0") + (#:eval-id . 1))) + (specification + '((#:name . "guix") + (#:url . "git://git.savannah.gnu.org/guix.git") + (#:load-path . ".") + (#:file . "/tmp/gnu-system.scm") + (#:proc . hydra-jobs) + (#:arguments (subset . "hello")) + (#:branch . "master") + (#:tag . #f) + (#:commit . #f) + (#:no-compile? . #f))) + (evaluation + '((#:specification . "guix") + (#:revision . 1)))) + (db-add-build (%db) build) + (db-add-derivation (%db) derivation) + (db-add-specification (%db) specification) + (db-add-evaluation (%db) evaluation))) + + (test-assert "/build/1" + (hash-table=? + (call-with-input-string + (utf8->string + (http-get-body (test-cuirass-uri "/build/1"))) + json->scm) + (call-with-input-string + (object->json-string build-query-result) + json->scm))) + + (test-equal "/build/1/log/raw" + "build log" + (http-get-body + (test-cuirass-uri "/build/1/log/raw"))) + + (test-equal "/build/2" + 404 + (response-code (http-get (test-cuirass-uri "/build/2")))) + + (test-equal "/build/2/log/raw" + 404 + (response-code (http-get (test-cuirass-uri "/build/2/log/raw")))) + + (test-equal "/api/latestbuilds" + 500 + (response-code (http-get (test-cuirass-uri "/api/latestbuilds")))) + + (test-assert "/api/latestbuilds?nr=1&project=guix&jobset=master" + (let ((hash-list + (call-with-input-string + (utf8->string + (http-get-body + (test-cuirass-uri + "/api/latestbuilds?nr=1&project=guix&jobset=master"))) + json->scm))) + (and (= (length hash-list) 1) + (hash-table=? + (car hash-list) + (call-with-input-string + (object->json-string build-query-result) + json->scm))))) + + (test-assert "/api/latestbuilds?nr=1&project=gnu" + ;; The result should be an empty JSON array. + (let ((hash-list + (call-with-input-string + (utf8->string + (http-get-body + (test-cuirass-uri + "/api/latestbuilds?nr=1&project=gnu"))) + json->scm))) + (= (length hash-list) 0))) + + (test-assert "db-close" + (db-close (%db))) + + (delete-file database-name) + (delete-file log-file-name)) |