[no subject]
branch: web-interface commit 2bb55c161b0f49bd56fd59ae1e813aa4185bebe1 Author: TSholokhova Date: Sun Aug 5 19:15:57 2018 +0200 web-interface: Add build log links. * src/cuirass/templates.scm (build-eval-table): Add build log links to the table. --- src/cuirass/templates.scm | 7 +-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm index 5799ee1..2e6c839 100644 --- a/src/cuirass/templates.scm +++ b/src/cuirass/templates.scm @@ -161,7 +161,8 @@ (th (@ (scope "col")) "Finished at") (th (@ (scope "col")) Job) (th (@ (scope "col")) Nixname) - (th (@ (scope "col")) System + (th (@ (scope "col")) System) + (th (@ (scope "col")) Log (define (table-row build) `(tr @@ -183,7 +184,9 @@ (td ,(strftime "%c" (localtime (assq-ref build #:stoptime (td ,(assq-ref build #:job)) (td ,(assq-ref build #:nixname)) - (td ,(assq-ref build #:system + (td ,(assq-ref build #:system)) + (td (a (@ (href "/build/" ,(assq-ref build #:id) "/log/raw")) + raw (define (build-id build) (match build
[no subject]
branch: web-interface commit a298d99dd552e7d9beca9ab73566aac76f44faed Author: TSholokhova Date: Sun Aug 5 21:25:37 2018 +0200 web-interface: Add navigation bar. * src/cuirass/database.scm (db-get-evaluation-specification): Request specification for given evaluation. * src/cuirass/templates.scm (html-page): Add navigation bar. * src/cuirass/http.scm: Fill navigation parameters. --- src/cuirass/database.scm | 8 src/cuirass/http.scm | 19 +++ src/cuirass/templates.scm | 21 + 3 files changed, 40 insertions(+), 8 deletions(-) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 9232a06..ee09a97 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -55,6 +55,7 @@ db-get-evaluations-build-summary db-get-evaluations-id-min db-get-evaluations-id-max +db-get-evaluation-specification read-sql-file read-quoted-string sqlite-exec @@ -729,3 +730,10 @@ AND (" status "IS NULL OR (" status "= 'pending' OR (" status "= 'failed' AND Builds.status > 0)))"))) (vector->list (car rows + +(define (db-get-evaluation-specification db eval) + "Return specification of evaluation with id EVAL." + (let ((rows (sqlite-exec db " +SELECT specification FROM Evaluations +WHERE id=" eval))) +(vector-ref (car rows) 0))) diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index e1b6592..f020e30 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -286,7 +286,8 @@ "Cuirass" (specifications-table (with-critical-section db-channel (db) - (db-get-specifications db)) + (db-get-specifications db))) +'( (("jobset" name) (respond-html @@ -304,7 +305,10 @@ (html-page name (evaluation-info-table name evaluations evaluation-id-min - evaluation-id-max)) + evaluation-id-max) + `(((#:name . ,name) + (#:link . ,(string-append "/jobset/" name)) + (#:active . #t (("eval" id) (respond-html @@ -316,7 +320,8 @@ (border-low-id (assq-ref params 'border-low-id)) (status (assq-ref params 'status)) (builds-id-max (db-get-builds-max db id status)) - (builds-id-min (db-get-builds-min db id status))) + (builds-id-min (db-get-builds-min db id status)) + (specification (db-get-evaluation-specification db id))) (html-page "Evaluation" (build-eval-table @@ -331,7 +336,13 @@ (border-low-id . ,border-low-id))) builds-id-min builds-id-max -status)) +status) + `(((#:name . ,specification) + (#:link . ,(string-append "/jobset/" specification)) + (#:active . #f)) + ((#:name . ,(string-append "Evaluation " id)) + (#:link . ,(string-append "/eval/" id)) + (#:active . #t (("static" path ...) (respond-static-file path)) diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm index 2e6c839..ceb56c3 100644 --- a/src/cuirass/templates.scm +++ b/src/cuirass/templates.scm @@ -26,7 +26,7 @@ evaluation-info-table build-eval-table)) -(define (html-page title body) +(define (html-page title body navigation) "Return HTML page with given TITLE and BODY." `(html (@ (xmlns "http://www.w3.org/1999/xhtml;) (xml:lang "en") @@ -44,11 +44,24 @@ (href "/static/css/open-iconic-bootstrap.css"))) (title ,title)) (body - (nav (@ (class "navbar navbar-expand-lg navbar-light bg-light")) - (a (@ (class "navbar-brand") (href "/")) + (nav (@ (class "navbar navbar-expand navbar-light bg-light")) + (a (@ (class "navbar-brand pt-0") (href "/")) (img (@ (src "/static/images/logo.png") (alt "logo") - (height "25") + (height "25") + (style "margin-top: -12px" + (div (@ (class "navbar-nav-scroll")) +(ul (@ (class "navbar-nav")) +(li (@ (class "nav-item")) +(a (@ (class "nav-link" ,(if (null? navigation) " active" "")) + (href "/")) + Home))
web-interface updated (0ce7d86 -> a298d99)
tsholokhova pushed a change to branch web-interface. from 0ce7d86 web-interface: Add builds filtering by status. Add links for different build status to evaluation table. new 2bb55c1 web-interface: Add build log links. new a298d99 web-interface: Add navigation bar. Summary of changes: src/cuirass/database.scm | 8 src/cuirass/http.scm | 19 +++ src/cuirass/templates.scm | 28 ++-- 3 files changed, 45 insertions(+), 10 deletions(-)
[no subject]
branch: web-interface commit 0ce7d867822edf4495e39aad5445f471ba172501 Author: TSholokhova Date: Sun Aug 5 16:55:16 2018 +0200 web-interface: Add builds filtering by status. Add links for different build status to evaluation table. * src/cuirass/database.scm (db-get-builds): Add 'succeeded' and 'failed' status filters. (db-get-builds-min, db-get-builds-max): Extend functional to support min/max extraction for a given status. * src/cuirass/http.scm: Add status parameter for /eval/id endpoint. * src/cuirass/templates.scm (evaluation-info-table): Add links to a build table filtered by satus. (build-eval-table): Add status parameter to pagination links. --- src/cuirass/database.scm | 46 +- src/cuirass/http.scm | 14 +- src/cuirass/templates.scm | 43 --- 3 files changed, 74 insertions(+), 29 deletions(-) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 4927f2a..9232a06 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -547,7 +547,9 @@ AND (:job IS NULL OR (:job = Derivations.job_name)) AND (:system IS NULL OR (:system = Derivations.system)) AND (:evaluation IS NULL OR (:evaluation = Builds.evaluation)) AND (:status IS NULL OR (:status = 'done' AND Builds.status >= 0) - OR (:status = 'pending' AND Builds.status < 0)) + OR (:status = 'pending' AND Builds.status < 0) + OR (:status = 'succeeded' AND Builds.status = 0) + OR (:status = 'failed' AND Builds.status > 0)) AND (:borderlowtime IS NULL OR :borderlowid IS NULL OR ((:borderlowtime, :borderlowid) < (Builds.stoptime, Builds.id))) AND (:borderhightime IS NULL OR :borderhighid IS NULL @@ -680,24 +682,50 @@ SELECT MAX(id) FROM Evaluations WHERE specification=" spec))) (vector-ref (car rows) 0))) -(define (db-get-builds-min db eval) +(define (db-get-builds-min db eval status) "Return the min build (stoptime, id) pair for - the given evaluation EVAL." + the given evaluation EVAL and STATUS." (let ((rows (sqlite-exec db " SELECT stoptime, MIN(id) FROM (SELECT id, stoptime FROM Builds -WHERE evaluation=" eval " AND -stoptime = (SELECT MIN(stoptime) -FROM Builds WHERE evaluation=" eval "))"))) +WHERE evaluation=" eval " +AND stoptime = (SELECT MIN(stoptime) + FROM Builds + WHERE evaluation=" eval " + AND (" status "IS NULL OR (" status "= 'pending' + AND Builds.status < 0) + OR (" status "= 'succeeded' + AND Builds.status = 0) + OR (" status "= 'failed' + AND Builds.status > 0))) +AND (" status "IS NULL OR (" status "= 'pending' + AND Builds.status < 0) + OR (" status "= 'succeeded' + AND Builds.status = 0) + OR (" status "= 'failed' + AND Builds.status > 0)))"))) (vector->list (car rows -(define (db-get-builds-max db eval) +(define (db-get-builds-max db eval status) "Return the max build (stoptime, id) pair for - the given evaluation EVAL." + the given evaluation EVAL and STATUS." (let ((rows (sqlite-exec db " SELECT stoptime, MAX(id) FROM (SELECT id, stoptime FROM Builds WHERE evaluation=" eval " AND stoptime = (SELECT MAX(stoptime) -FROM Builds WHERE evaluation=" eval "))"))) + FROM Builds + WHERE evaluation=" eval " + AND (" status "IS NULL OR (" status "= 'pending' + AND Builds.status < 0) + OR (" status "= 'succeeded' + AND Builds.status = 0) + OR (" status "= 'failed' + AND Builds.status > 0))) +AND (" status "IS NULL OR (" status "= 'pending' + AND Builds.status < 0) + OR (" status "= 'succeeded' + AND Builds.status = 0) + OR (" status "= 'failed' + AND Builds.status > 0)))"))) (vector->list (car rows diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index 16bbda0..e1b6592 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -309,17 +309,20 @@ (("eval" id) (respond-html (with-critical-section db-channel (db) -(let* ((builds-id-max (db-get-builds-max db id)) - (builds-id-min (db-get-builds-min db id)) - (params (request-parameters request)) +(let* ((params (request-parameters request)) (border-high-time (assq-ref params 'border-high-time)) (border-low-time (assq-ref params 'border-low-time)) (border-high-id (assq-ref params 'border-high-id)) - (border-low-id
branch web-interface created (now 0ce7d86)
tsholokhova pushed a change to branch web-interface. at 0ce7d86 web-interface: Add builds filtering by status. Add links for different build status to evaluation table. This branch includes the following new commits: new 0ce7d86 web-interface: Add builds filtering by status. Add links for different build status to evaluation table.
branch web-interface created (now db6aee3)
tsholokhova pushed a change to branch web-interface. at db6aee3 Add web-interface. This branch includes the following new commits: new d971fcc Add static files. new db6aee3 Add web-interface.
branch web-interface deleted (was 504b919)
tsholokhova pushed a change to branch web-interface. was 504b919 Fix pagination for builds. * src/cuirass/templates.scm: Rewrite pagination template. * src/cuirass/database.scm: Change build filtering for pagination. * src/cuirass/http.scm: Add parameters for tuple-pagination. * tests/database.scm: Fix test. This change permanently discards the following revisions: discards 504b919 Fix pagination for builds. * src/cuirass/templates.scm: Rewrite pagination template. * src/cuirass/database.scm: Change build filtering for pagination. * src/cuirass/http.scm: Add parameters for tuple-pagination. * tests/database.scm: Fix test. discards 7453c23 Fix with-critical-section wrapping. discards 6a540b1 Add web-interface. discards 80030d9 Add static files.
[no subject]
\ + src/static/images/logo.png + TEST_EXTENSIONS = .scm .sh AM_TESTS_ENVIRONMENT = \ env GUILE_AUTO_COMPILE='0' \ diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index a1398bc..5e928cf 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2016, 2017 Mathieu Lirzin ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2018 Ludovic Courtès +;;; Copyright © 2018 Tatiana Sholokhova ;;; ;;; This file is part of Cuirass. ;;; @@ -45,10 +46,17 @@ db-update-build-status! db-get-build db-get-builds +db-get-builds-min +db-get-builds-max db-get-evaluations +db-get-evaluations-build-summary +db-get-evaluations-count +db-get-evaluations-id-min +db-get-evaluations-id-max read-sql-file read-quoted-string sqlite-exec +assqx-ref ;; Parameters. %package-database %package-schema-file @@ -376,20 +384,20 @@ log file for DRV." (#:outputs. ,(db-get-outputs db id)) (#:branch . ,branch) +;; XXX Change caller and remove +(define (assqx-ref filters key) + (match filters +(() + #f) +(((xkey xvalue) rest ...) + (if (eq? key xkey) + xvalue + (assqx-ref rest key) + (define (db-get-builds db filters) "Retrieve all builds in database DB which are matched by given FILTERS. FILTERS is an assoc list which possible keys are 'project | 'jobset | 'job | -'system | 'nr | 'order | 'status." - - ;; XXX Change caller and remove - (define (assqx-ref filters key) -(match filters - (() - #f) - (((xkey xvalue) rest ...) - (if (eq? key xkey) - xvalue - (assqx-ref rest key) +'system | 'nr | 'order | 'status | 'evaluation " (define (format-output name path) `(,name . ((#:path . ,path @@ -448,12 +456,11 @@ Assumes that if group id stays the same the group headers stay the same." (let ((outputs (cons-output x-output-name x-output-path outputs))) (collect-outputs repeated-builds-id repeated-row outputs rest))) ((#(x-builds-id x-output-name x-output-path other-cells ...) . rest) - (cons (finish-group) ;finish current group - + (cons (finish-group);finish current group ;; Start new group. (let* ((outputs (cons-output x-output-name x-output-path '())) (x-repeated-row (list->vector other-cells))) - (collect-outputs x-builds-id x-repeated-row outputs rest)) + (collect-outputs x-builds-id x-repeated-row outputs rest)) (define (group-outputs rows) (match rows @@ -462,18 +469,26 @@ Assumes that if group id stays the same the group headers stay the same." (let ((x-repeated-row (list->vector other-cells))) (collect-outputs x-builds-id x-repeated-row '() rows) - (let* ((order (match (assq 'order filters) - (('order 'build-id) "Builds.id ASC") - (('order 'decreasing-build-id) "Builds.id DESC") - (('order 'finish-time) "Builds.stoptime DESC") - (('order 'start-time) "Builds.starttime DESC") - (('order 'submission-time) "Builds.timestamp DESC") - (('order 'status+submission-time) - ;; With this order, builds in 'running' state (-1) appear - ;; before those in 'scheduled' state (-2). - "Builds.status DESC, Builds.timestamp DESC") - (_ "Builds.id DESC"))) - (stmt-text (format #f "\ + (let* +((order + (match +(assq 'order filters) +(('order 'build-id) "id ASC") +(('order 'decreasing-build-id) "id DESC") +(('order 'finish-time) "stoptime DESC") +(('order 'finish-time+build-id) "stoptime DESC, id DESC") +(('order 'start-time) "starttime DESC") +(('order 'submission-time) "timestamp DESC") +(('order 'status+submission-time) + ;; With this order, builds in 'running' state (-1) appear + ;; before those in 'scheduled' state (-2). + ;"Builds.status DESC, Builds.timestamp DESC") + ;(_ "Builds.id DESC"))) +"status DESC, timestamp DESC") +(_ "id DESC"))) + (stmt-text (format #f "\ +SELECT * +FROM ( SELECT Builds.id, Outputs.name, Outputs.path, Builds.timestamp, Builds.starttime, Builds.stoptime, Builds.log, Builds.status, Builds.derivation,\ Derivations.job_name, Derivations.system, Derivations.nix_name,\ Specifications.repo_name, Specifications.bra
web-interface updated (7453c23 -> 504b919)
tsholokhova pushed a change to branch web-interface. from 7453c23 Fix with-critical-section wrapping. new 504b919 Fix pagination for builds. * src/cuirass/templates.scm: Rewrite pagination template. * src/cuirass/database.scm: Change build filtering for pagination. * src/cuirass/http.scm: Add parameters for tuple-pagination. * tests/database.scm: Fix test. Summary of changes: src/cuirass/database.scm | 99 +++- src/cuirass/http.scm | 48 +++--- src/cuirass/templates.scm | 161 +++--- tests/database.scm| 2 +- 4 files changed, 188 insertions(+), 122 deletions(-)
[no subject]
branch: web-interface commit 504b9199fefb0a1fe30f7963e306de0ae6cc4008 Author: TSholokhova Date: Mon Jul 23 00:43:17 2018 +0200 Fix pagination for builds. * src/cuirass/templates.scm: Rewrite pagination template. * src/cuirass/database.scm: Change build filtering for pagination. * src/cuirass/http.scm: Add parameters for tuple-pagination. * tests/database.scm: Fix test. --- src/cuirass/database.scm | 99 +++- src/cuirass/http.scm | 48 +++--- src/cuirass/templates.scm | 161 +++--- tests/database.scm| 2 +- 4 files changed, 188 insertions(+), 122 deletions(-) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index dda808c..5e928cf 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -46,8 +46,8 @@ db-update-build-status! db-get-build db-get-builds -db-get-builds-id-min -db-get-builds-id-max +db-get-builds-min +db-get-builds-max db-get-evaluations db-get-evaluations-build-summary db-get-evaluations-count @@ -476,6 +476,7 @@ Assumes that if group id stays the same the group headers stay the same." (('order 'build-id) "id ASC") (('order 'decreasing-build-id) "id DESC") (('order 'finish-time) "stoptime DESC") +(('order 'finish-time+build-id) "stoptime DESC, id DESC") (('order 'start-time) "starttime DESC") (('order 'submission-time) "timestamp DESC") (('order 'status+submission-time) @@ -503,9 +504,10 @@ AND (:job IS NULL OR (:job = Derivations.job_name)) \ AND (:system IS NULL OR (:system = Derivations.system)) \ AND (:evaluation IS NULL OR (:evaluation = Builds.evaluation)) \ AND (:status IS NULL OR (:status = 'done' AND Builds.status >= 0) OR (:status = 'pending' AND Builds.status < 0)) \ -AND (:borderlow IS NULL OR (:borderlow < Builds.stoptime)) \ -AND (:borderhigh IS NULL OR (:borderhigh > Builds.stoptime)) -ORDER BY CASE WHEN :borderlow IS NULL THEN Builds.stoptime ELSE -Builds.stoptime END DESC +AND (:borderlowtime IS NULL OR :borderlowid is NULL OR ((:borderlowtime, :borderlowid) < (Builds.stoptime, Builds.id))) \ +AND (:borderhightime IS NULL OR :borderhighid is NULL OR ((:borderhightime, :borderhighid) > (Builds.stoptime, Builds.id))) \ +ORDER BY CASE WHEN :borderlowtime IS NULL OR :borderlowid IS NULL THEN Builds.stoptime ELSE -Builds.stoptime END DESC, \ +CASE WHEN :borderlowtime IS NULL OR :borderlowid IS NULL THEN Builds.id ELSE -Builds.id END DESC \ LIMIT :nr) ORDER BY ~a, id ASC;" order)) (stmt (sqlite-prepare db stmt-text #:cache? #t))) @@ -518,8 +520,14 @@ ORDER BY ~a, id ASC;" order)) #:system (assqx-ref filters 'system) #:status (and=> (assqx-ref filters 'status) object->string) - #:borderlow (assqx-ref filters 'border-low) - #:borderhigh (assqx-ref filters 'border-high) + #:borderlowid +(assqx-ref filters 'border-low-id) + #:borderhighid +(assqx-ref filters 'border-high-id) + #:borderlowtime +(assqx-ref filters 'border-low-time) + #:borderhightime +(assqx-ref filters 'border-high-time) #:nr (match (assqx-ref filters 'nr) (#f -1) (x x))) @@ -581,8 +589,8 @@ FROM Evaluations ORDER BY id DESC LIMIT " limit ";")) evaluations)) (define (db-get-evaluations-build-summary db spec limit border-low border-high) -(let loop - ((rows (sqlite-exec db + (let loop +((rows (sqlite-exec db "SELECT E.id, E.revision, B.succeeded, B.failed, B.scheduled FROM \ (SELECT id, evaluation, SUM(status=0) as succeeded, SUM(status>0) as failed, SUM(status<0) as scheduled \ FROM Builds \ @@ -597,49 +605,50 @@ ORDER BY CASE WHEN " border-low "IS NULL THEN id ELSE -id END DESC \ LIMIT " limit ") E \ ON B.evaluation=E.id \ ORDER BY E.id ASC;")) - (evaluations '())) - (match rows - (() evaluations) - ((#(id revision succeeded failed scheduled) . rest) - (loop rest - (cons `((#:id . ,id) - (#:revision . ,revision) - (#:succeeded . ,succeeded) - (#:failed . ,failed) - (#:scheduled . ,scheduled)) - evaluations)) - -(define (db-get-evaluations-count db spec) - "Return the number of evaluations of the given
web-interface updated (6a540b1 -> 7453c23)
tsholokhova pushed a change to branch web-interface. from 6a540b1 Add web-interface. new 7453c23 Fix with-critical-section wrapping. Summary of changes: src/cuirass/http.scm | 128 +-- 1 file changed, 64 insertions(+), 64 deletions(-)
[no subject]
branch: web-interface commit 7453c2343acb28d651026d27b916e3c9d837ad6e Author: TSholokhova Date: Sun Jul 22 16:47:46 2018 +0200 Fix with-critical-section wrapping. * /src/cuirass/http.scm: Use one critical-section per function. --- src/cuirass/http.scm | 128 +-- 1 file changed, 64 insertions(+), 64 deletions(-) diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index dcf1641..38a5f49 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -97,19 +97,20 @@ (#:releasename . #nil) (#:buildinputs_builds . #nil))) -(define (handle-build-request db-channel build-id) - "Retrieve build identified by BUILD-ID over DB-CHANNEL and convert it +(define (handle-build-request db build-id) + "Retrieve build identified by BUILD-ID over DB and convert it to hydra format. Return #f is not build was found." - (let ((build (with-critical-section db-channel (db) - (db-get-build db build-id -(and=> build build->hydra-build))) + (let ((build (db-get-build db build-id))) + (and=> build build->hydra-build))) -(define (handle-builds-request db-channel filters) - "Retrieve all builds matched by FILTERS in DB-CHANNEL and convert them +(define (handle-builds-request db filters) + "Retrieve all builds matched by FILTERS in DB and convert them to Hydra format." - (let ((builds (with-critical-section db-channel (db) - (with-time-logging "builds request" - (db-get-builds db filters) + (let +((builds + (with-time-logging +"builds request" +(db-get-builds db filters (map build->hydra-build builds))) (define (request-parameters request) @@ -217,12 +218,15 @@ (with-critical-section db-channel (db) (db-get-specifications db) (("build" build-id) - (let ((hydra-build (handle-build-request - db-channel - (string->number build-id + (let + ((hydra-build + (with-critical-section db-channel (db) + (handle-build-request + db + (string->number build-id) (if hydra-build - (respond-json (object->json-string hydra-build)) - (respond-build-not-found build-id + (respond-json (object->json-string hydra-build)) + (respond-build-not-found build-id (("build" build-id "log" "raw") (let ((build (with-critical-section db-channel (db) (db-get-build db (string->number build-id) @@ -263,11 +267,12 @@ (if valid-params? ;; Limit results to builds that are "done". (respond-json (object->json-string - (handle-builds-request -db-channel -`((status done) -,@params -(order finish-time) + (with-critical-section db-channel (db) + (handle-builds-request + db + `((status done) + ,@params + (order finish-time)) (respond-json-with-error 500 "Parameter not defined!" (("api" "queue") (let* ((params (request-parameters request)) @@ -293,52 +298,47 @@ (db-get-specifications db)) (("jobset" name) - (let* - ((evaluation-id-max - (with-critical-section db-channel (db) - (db-get-evaluations-id-max db name))) - (evaluation-id-min - (with-critical-section db-channel (db) - (db-get-evaluations-id-min db name))) - (params (request-parameters request)) - (border-high (assqx-ref params 'border-high)) - (border-low (assqx-ref params 'border-low))) - (respond-html - (html-page - name - (evaluation-info-table - name - (with-critical-section db-channel (db) -(db-get-evaluations-build-summary - db - name - (%pagesize) - border-low - border-high)) - evaluation-id-min - evaluation-id-max) + (respond-html + (with-critical-section db-channel (db) + (let* + ((evaluation-id-max (db-get-evaluations-id-max db name)) +(evaluation-id-min (db-get-evaluations-id-min db name)) +(params (request-parameters request)) +(border-high (assqx-ref params 'border-high)) +(border-low (assqx-ref params 'border-low))) + (html-page + name + (evaluation-info-table + name + (db-get-evaluations-build-summary + db + name + (%pagesize) +
branch web-interface created (now 6a540b1)
tsholokhova pushed a change to branch web-interface. at 6a540b1 Add web-interface. This branch includes the following new commits: new 80030d9 Add static files. new 6a540b1 Add web-interface.
[no subject]
eu Othacehe ;;; Copyright © 2018 Ludovic Courtès +;;; Copyright © 2018 Tatiana Sholokhova ;;; ;;; This file is part of Cuirass. ;;; @@ -45,10 +46,17 @@ db-update-build-status! db-get-build db-get-builds +db-get-builds-id-min +db-get-builds-id-max db-get-evaluations +db-get-evaluations-build-summary +db-get-evaluations-count +db-get-evaluations-id-min +db-get-evaluations-id-max read-sql-file read-quoted-string sqlite-exec +assqx-ref ;; Parameters. %package-database %package-schema-file @@ -376,20 +384,20 @@ log file for DRV." (#:outputs. ,(db-get-outputs db id)) (#:branch . ,branch) +;; XXX Change caller and remove +(define (assqx-ref filters key) + (match filters +(() + #f) +(((xkey xvalue) rest ...) + (if (eq? key xkey) + xvalue + (assqx-ref rest key) + (define (db-get-builds db filters) "Retrieve all builds in database DB which are matched by given FILTERS. FILTERS is an assoc list which possible keys are 'project | 'jobset | 'job | -'system | 'nr | 'order | 'status." - - ;; XXX Change caller and remove - (define (assqx-ref filters key) -(match filters - (() - #f) - (((xkey xvalue) rest ...) - (if (eq? key xkey) - xvalue - (assqx-ref rest key) +'system | 'nr | 'order | 'status | 'evaluation " (define (format-output name path) `(,name . ((#:path . ,path @@ -448,12 +456,11 @@ Assumes that if group id stays the same the group headers stay the same." (let ((outputs (cons-output x-output-name x-output-path outputs))) (collect-outputs repeated-builds-id repeated-row outputs rest))) ((#(x-builds-id x-output-name x-output-path other-cells ...) . rest) - (cons (finish-group) ;finish current group - + (cons (finish-group);finish current group ;; Start new group. (let* ((outputs (cons-output x-output-name x-output-path '())) (x-repeated-row (list->vector other-cells))) - (collect-outputs x-builds-id x-repeated-row outputs rest)) + (collect-outputs x-builds-id x-repeated-row outputs rest)) (define (group-outputs rows) (match rows @@ -462,18 +469,25 @@ Assumes that if group id stays the same the group headers stay the same." (let ((x-repeated-row (list->vector other-cells))) (collect-outputs x-builds-id x-repeated-row '() rows) - (let* ((order (match (assq 'order filters) - (('order 'build-id) "Builds.id ASC") - (('order 'decreasing-build-id) "Builds.id DESC") - (('order 'finish-time) "Builds.stoptime DESC") - (('order 'start-time) "Builds.starttime DESC") - (('order 'submission-time) "Builds.timestamp DESC") - (('order 'status+submission-time) - ;; With this order, builds in 'running' state (-1) appear - ;; before those in 'scheduled' state (-2). - "Builds.status DESC, Builds.timestamp DESC") - (_ "Builds.id DESC"))) - (stmt-text (format #f "\ + (let* +((order + (match +(assq 'order filters) +(('order 'build-id) "id ASC") +(('order 'decreasing-build-id) "id DESC") +(('order 'finish-time) "stoptime DESC") +(('order 'start-time) "starttime DESC") +(('order 'submission-time) "timestamp DESC") +(('order 'status+submission-time) + ;; With this order, builds in 'running' state (-1) appear + ;; before those in 'scheduled' state (-2). + ;"Builds.status DESC, Builds.timestamp DESC") + ;(_ "Builds.id DESC"))) +"status DESC, timestamp DESC") +(_ "id DESC"))) + (stmt-text (format #f "\ +SELECT * +FROM ( SELECT Builds.id, Outputs.name, Outputs.path, 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 \ @@ -487,19 +501,28 @@ AND (:project IS NULL OR (:project = Specifications.repo_name)) \ AND (:jobset IS NULL OR (:jobset = Specifications.branch)) \ AND (:job IS NULL OR (:job = Derivations.job_name)) \ AND (:system IS NULL OR (:system = Derivations.system)) \ +AND (:evaluation IS NULL OR (:evaluation = Builds.evaluation)) \ AND (:status IS NULL OR (:status = 'done' AND Builds.status >= 0) OR (:status = 'pending' AND Builds.status < 0
branch web-interface deleted (was 417c7ef)
tsholokhova pushed a change to branch web-interface. was 417c7ef Fix codestyle. * src/cuirass/templates.scm: Fix codestyle. * src/cuirass/database.scm: Fix codestyle. * src/cuirass/http.scm: Fix codestyle. * tests/database.scm: Fix test. * Makefile.am: Add static files paths. This change permanently discards the following revisions: discards 417c7ef Fix codestyle. * src/cuirass/templates.scm: Fix codestyle. * src/cuirass/database.scm: Fix codestyle. * src/cuirass/http.scm: Fix codestyle. * tests/database.scm: Fix test. * Makefile.am: Add static files paths. discards c31a5d3 Add pagination for each evaluation page. discards 643f25f Update id pagination (previous+last buttons). * src/cuirass/templates.scm: Add buttons for pagination. * src/cuirass/database.scm(db-get-evaluations-build-summary): Implement different order for low and high borders. discards 5d61dea Update id pagination. discards 450c6bb Add white-list. discards ac0fd3c Change HTML5 to XHTML. Fix codestyle. discards 7091f46 Implement first feature. Add bootstrap style. discards 8e31e6f Add basic HTML templates, main and specification builds pages.
web-interface updated (c31a5d3 -> 417c7ef)
tsholokhova pushed a change to branch web-interface. from c31a5d3 Add pagination for each evaluation page. new 417c7ef Fix codestyle. * src/cuirass/templates.scm: Fix codestyle. * src/cuirass/database.scm: Fix codestyle. * src/cuirass/http.scm: Fix codestyle. * tests/database.scm: Fix test. * Makefile.am: Add static files paths. Summary of changes: Makefile.am | 16 + src/cuirass/database.scm | 151 +++--- src/cuirass/http.scm | 114 -- src/cuirass/templates.scm | 106 +++- tests/database.scm| 2 +- 5 files changed, 179 insertions(+), 210 deletions(-)
[no subject]
branch: web-interface commit 417c7eff906ac211891d35557c31cafa213f5c17 Author: TSholokhova Date: Sat Jul 21 15:19:32 2018 +0200 Fix codestyle. * src/cuirass/templates.scm: Fix codestyle. * src/cuirass/database.scm: Fix codestyle. * src/cuirass/http.scm: Fix codestyle. * tests/database.scm: Fix test. * Makefile.am: Add static files paths. --- Makefile.am | 16 + src/cuirass/database.scm | 151 +++--- src/cuirass/http.scm | 114 -- src/cuirass/templates.scm | 106 +++- tests/database.scm| 2 +- 5 files changed, 179 insertions(+), 210 deletions(-) diff --git a/Makefile.am b/Makefile.am index 75848ef..ed38317 100644 --- a/Makefile.am +++ b/Makefile.am @@ -32,6 +32,10 @@ pkgmoduledir = $(guilesitedir)/$(PACKAGE) pkgobjectdir = $(guileobjectdir)/$(PACKAGE) webmoduledir = $(guilesitedir)/web/server webobjectdir = $(guileobjectdir)/web/server +staticdir = $(pkgdatadir)/static +cssdir = $(staticdir)/css +fontsdir = $(staticdir)/fonts +imagesdir = $(staticdir)/images dist_pkgmodule_DATA = \ src/cuirass/base.scm \ @@ -57,6 +61,18 @@ nodist_webobject_DATA = \ dist_pkgdata_DATA = src/schema.sql +dist_css_DATA =\ + src/static/css/bootstrap.css \ + src/static/css/open-iconic-bootstrap.css +dist_fonts_DATA = \ + src/static/fonts/open-iconic.eot \ + src/static/fonts/open-iconic.otf \ + src/static/fonts/open-iconic.svg \ + src/static/fonts/open-iconic.ttf \ + src/static/fonts/open-iconic.woff +dist_images_DATA = \ + src/static/images/logo.png + TEST_EXTENSIONS = .scm .sh AM_TESTS_ENVIRONMENT = \ env GUILE_AUTO_COMPILE='0' \ diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 37494da..dda808c 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2016, 2017 Mathieu Lirzin ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2018 Ludovic Courtès +;;; Copyright © 2018 Tatiana Sholokhova ;;; ;;; This file is part of Cuirass. ;;; @@ -55,6 +56,7 @@ read-sql-file read-quoted-string sqlite-exec +assqx-ref ;; Parameters. %package-database %package-schema-file @@ -382,21 +384,21 @@ log file for DRV." (#:outputs. ,(db-get-outputs db id)) (#:branch . ,branch) +;; XXX Change caller and remove +(define (assqx-ref filters key) + (match filters +(() + #f) +(((xkey xvalue) rest ...) + (if (eq? key xkey) + xvalue + (assqx-ref rest key) + (define (db-get-builds db filters) "Retrieve all builds in database DB which are matched by given FILTERS. FILTERS is an assoc list which possible keys are 'project | 'jobset | 'job | 'system | 'nr | 'order | 'status | 'evaluation " - ;; XXX Change caller and remove - (define (assqx-ref filters key) -(match filters - (() - #f) - (((xkey xvalue) rest ...) - (if (eq? key xkey) - xvalue - (assqx-ref rest key) - (define (format-output name path) `(,name . ((#:path . ,path @@ -454,12 +456,11 @@ Assumes that if group id stays the same the group headers stay the same." (let ((outputs (cons-output x-output-name x-output-path outputs))) (collect-outputs repeated-builds-id repeated-row outputs rest))) ((#(x-builds-id x-output-name x-output-path other-cells ...) . rest) - (cons (finish-group) ;finish current group - + (cons (finish-group);finish current group ;; Start new group. (let* ((outputs (cons-output x-output-name x-output-path '())) (x-repeated-row (list->vector other-cells))) - (collect-outputs x-builds-id x-repeated-row outputs rest)) + (collect-outputs x-builds-id x-repeated-row outputs rest)) (define (group-outputs rows) (match rows @@ -468,26 +469,23 @@ Assumes that if group id stays the same the group headers stay the same." (let ((x-repeated-row (list->vector other-cells))) (collect-outputs x-builds-id x-repeated-row '() rows) - (let* ((order (match (assq 'order filters) - ;(('order 'build-id) "Builds.id ASC") - ;(('order 'decreasing-build-id) "Builds.id DESC") - ;(('order 'finish-time) "Builds.stoptime DESC") - ;(('order 'start-time) "Builds.starttime DESC") - ;(('order 'submission-time) "Builds.timestamp DESC") -
[no subject]
branch: web-interface commit c31a5d36fc41fe96d59d4e9a2081cfb98a50ee5a Author: TSholokhova Date: Sun Jul 8 21:16:00 2018 +0200 Add pagination for each evaluation page. * src/cuirass/templates.scm (build-eval-table): Add pagination. * src/cuirass/database.scm: Add border filters for pagination in db-get-builds. Add functions for searching max and min stoptimes. * src/cuirass/http.scm: Add pagination parameters in "eval" query. --- src/cuirass/database.scm | 52 ++- src/cuirass/http.scm | 30 +++ src/cuirass/templates.scm | 9 +--- 3 files changed, 65 insertions(+), 26 deletions(-) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index b3d43fc..37494da 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -45,6 +45,8 @@ db-update-build-status! db-get-build db-get-builds +db-get-builds-id-min +db-get-builds-id-max db-get-evaluations db-get-evaluations-build-summary db-get-evaluations-count @@ -467,17 +469,27 @@ Assumes that if group id stays the same the group headers stay the same." (collect-outputs x-builds-id x-repeated-row '() rows) (let* ((order (match (assq 'order filters) - (('order 'build-id) "Builds.id ASC") - (('order 'decreasing-build-id) "Builds.id DESC") - (('order 'finish-time) "Builds.stoptime DESC") - (('order 'start-time) "Builds.starttime DESC") - (('order 'submission-time) "Builds.timestamp DESC") + ;(('order 'build-id) "Builds.id ASC") + ;(('order 'decreasing-build-id) "Builds.id DESC") + ;(('order 'finish-time) "Builds.stoptime DESC") + ;(('order 'start-time) "Builds.starttime DESC") + ;(('order 'submission-time) "Builds.timestamp DESC") + ;(('order 'status+submission-time) + (('order 'build-id) "id ASC") + (('order 'decreasing-build-id) "id DESC") + (('order 'finish-time) "stoptime DESC") + (('order 'start-time) "starttime DESC") + (('order 'submission-time) "timestamp DESC") (('order 'status+submission-time) ;; With this order, builds in 'running' state (-1) appear ;; before those in 'scheduled' state (-2). - "Builds.status DESC, Builds.timestamp DESC") - (_ "Builds.id DESC"))) + ;"Builds.status DESC, Builds.timestamp DESC") + ;(_ "Builds.id DESC"))) + "status DESC, timestamp DESC") + (_ "id DESC"))) (stmt-text (format #f "\ +SELECT * +FROM ( SELECT Builds.id, Outputs.name, Outputs.path, 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 \ @@ -493,7 +505,11 @@ AND (:job IS NULL OR (:job = Derivations.job_name)) \ AND (:system IS NULL OR (:system = Derivations.system)) \ AND (:evaluation IS NULL OR (:evaluation = Builds.evaluation)) \ AND (:status IS NULL OR (:status = 'done' AND Builds.status >= 0) OR (:status = 'pending' AND Builds.status < 0)) \ -ORDER BY ~a, Builds.id ASC LIMIT :nr;" order)) +AND (:borderlow IS NULL OR (:borderlow < Builds.stoptime)) \ +AND (:borderhigh IS NULL OR (:borderhigh > Builds.stoptime)) +ORDER BY CASE WHEN :borderlow IS NULL THEN Builds.stoptime ELSE -Builds.stoptime END DESC +LIMIT :nr) +ORDER BY ~a, id ASC;" order)) (stmt (sqlite-prepare db stmt-text #:cache? #t))) (sqlite-bind-arguments stmt #:id (assqx-ref filters 'id) #:project (assqx-ref filters 'project) @@ -503,6 +519,8 @@ ORDER BY ~a, Builds.id ASC LIMIT :nr;" order)) #:system (assqx-ref filters 'system) #:status (and=> (assqx-ref filters 'status) object->string) + #:borderlow (assqx-ref filters 'border-low) + #:borderhigh (assqx-ref filters 'border-high) #:nr (match (assqx-ref filters 'nr) (#f -1) (x x))) @@ -600,15 +618,29 @@ WHERE specification=" spec))) (array-ref (list-ref rows 0) 0))) (define (db-get-evaluations-id-max db spec) - "Return the number of evaluations of the given specification SPEC" + "Return the max id of evaluations of the given specification SPEC" (let ((rows (sqlite-exec db "SELECT MAX(id) FROM Evaluations WHERE specification=" spec))) (array-ref (list-ref rows 0) 0))) (define
web-interface updated (643f25f -> c31a5d3)
tsholokhova pushed a change to branch web-interface. from 643f25f Update id pagination (previous+last buttons). * src/cuirass/templates.scm: Add buttons for pagination. * src/cuirass/database.scm(db-get-evaluations-build-summary): Implement different order for low and high borders. new c31a5d3 Add pagination for each evaluation page. Summary of changes: src/cuirass/database.scm | 52 ++- src/cuirass/http.scm | 30 +++ src/cuirass/templates.scm | 9 +--- 3 files changed, 65 insertions(+), 26 deletions(-)
[no subject]
branch: web-interface commit 643f25f265102652df463b580ba981b82baac076 Author: TSholokhova Date: Sun Jul 8 18:37:22 2018 +0200 Update id pagination (previous+last buttons). * src/cuirass/templates.scm: Add buttons for pagination. * src/cuirass/database.scm(db-get-evaluations-build-summary): Implement different order for low and high borders. --- src/cuirass/database.scm | 5 +++-- src/cuirass/templates.scm | 18 +- 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 30dc706..b3d43fc 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -575,9 +575,10 @@ FROM Evaluations ORDER BY id DESC LIMIT " limit ";")) WHERE (specification=" spec ")\ AND (" border-low "IS NULL OR (id >" border-low "))\ AND (" border-high "IS NULL OR (id <" border-high "))\ - ORDER BY id DESC + ORDER BY CASE WHEN " border-low "IS NULL THEN id ELSE -id END DESC LIMIT " limit ") E -ON B.evaluation=E.id;")) +ON B.evaluation=E.id +ORDER BY E.id ASC;")) (evaluations '())) (match rows (() evaluations) diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm index c134ec3..6e4d7bd 100644 --- a/src/cuirass/templates.scm +++ b/src/cuirass/templates.scm @@ -77,20 +77,20 @@ (ul (@ (class "pagination")) (li (@ (class "page-item")) (a (@ (class "page-link") - (href "?border-low=" ,(number->string (- id-min 1 + (href "?border-high=" ,(number->string (+ id-max 1 "<< First")) -;(li (@ (class "page-item" ,(if (= page-id-max id-max) " disabled" ""))) -;(a (@ (class "page-link") -; (href "?border-low=" ,(number->string page-id-max))) -; "< Previous")) +(li (@ (class "page-item" ,(if (= page-id-max id-max) " disabled" ""))) +(a (@ (class "page-link") + (href "?border-low=" ,(number->string page-id-max))) + "< Previous")) (li (@ (class "page-item" ,(if (= page-id-min id-min) " disabled" ""))) (a (@ (class "page-link") (href "?border-high=" ,(number->string page-id-min))) "Next >")) -;(li (@ (class "page-item")) -;(a (@ (class "page-link") -; (href "?border-high=" ,(number->string (+ id-min PAGESIZE -; "Last >>")) +(li (@ (class "page-item")) +(a (@ (class "page-link") + (href "?border-low=" ,(number->string (- id-min 1 + "Last >>"))
web-interface updated (5d61dea -> 643f25f)
tsholokhova pushed a change to branch web-interface. from 5d61dea Update id pagination. new 643f25f Update id pagination (previous+last buttons). * src/cuirass/templates.scm: Add buttons for pagination. * src/cuirass/database.scm(db-get-evaluations-build-summary): Implement different order for low and high borders. Summary of changes: src/cuirass/database.scm | 5 +++-- src/cuirass/templates.scm | 18 +- 2 files changed, 12 insertions(+), 11 deletions(-)
[no subject]
branch: web-interface commit 5d61dea08e5067783492573b53c650da2a5a80c1 Author: TSholokhova Date: Wed Jul 4 22:38:40 2018 +0200 Update id pagination. * src/cuirass/http.scm: Change parameters. * src/cuirass/templates.scm: Fix pagination function. Added min and max functions for lists. * src/cuirass/database.scm: Add borders parameters to evaluation request. --- src/cuirass/database.scm | 27 +++--- src/cuirass/http.scm | 31 +++- src/cuirass/templates.scm | 90 --- 3 files changed, 98 insertions(+), 50 deletions(-) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index ecf9a39..30dc706 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -48,6 +48,8 @@ db-get-evaluations db-get-evaluations-build-summary db-get-evaluations-count +db-get-evaluations-id-min +db-get-evaluations-id-max read-sql-file read-quoted-string sqlite-exec @@ -561,7 +563,7 @@ FROM Evaluations ORDER BY id DESC LIMIT " limit ";")) (#:revision . ,revision)) evaluations)) -(define (db-get-evaluations-build-summary db spec limit offset) +(define (db-get-evaluations-build-summary db spec limit border-low border-high) (let loop ((rows (sqlite-exec db "SELECT E.id, E.revision, B.succeeded, B.failed, B.scheduled FROM (SELECT id, evaluation, SUM(status=0) as succeeded, SUM(status>0) as failed, SUM(status<0) as scheduled @@ -570,10 +572,11 @@ FROM Evaluations ORDER BY id DESC LIMIT " limit ";")) JOIN (SELECT id, revision FROM Evaluations - WHERE specification=" spec - "ORDER BY id DESC - LIMIT " limit " OFFSET " offset " - ) E + WHERE (specification=" spec ")\ + AND (" border-low "IS NULL OR (id >" border-low "))\ + AND (" border-high "IS NULL OR (id <" border-high "))\ + ORDER BY id DESC + LIMIT " limit ") E ON B.evaluation=E.id;")) (evaluations '())) (match rows @@ -594,3 +597,17 @@ ON B.evaluation=E.id;")) "SELECT COUNT(id) FROM Evaluations WHERE specification=" spec))) (array-ref (list-ref rows 0) 0))) + +(define (db-get-evaluations-id-max db spec) + "Return the number of evaluations of the given specification SPEC" + (let ((rows (sqlite-exec db +"SELECT MAX(id) FROM Evaluations +WHERE specification=" spec))) +(array-ref (list-ref rows 0) 0))) + +(define (db-get-evaluations-id-min db spec) + "Return the number of evaluations of the given specification SPEC" + (let ((rows (sqlite-exec db +"SELECT MIN(id) FROM Evaluations +WHERE specification=" spec))) +(array-ref (list-ref rows 0) 0))) diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index 712db10..698872b 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -152,6 +152,11 @@ Hydra format." (define (request-path-components request) (split-and-decode-uri-path (uri-path (request-uri request +(define (normalize-parameter parameter) + (if parameter +(list-ref parameter 0) +#f)) + (define (url-handler request body db-channel) (define* (respond response #:key body (db-channel db-channel)) @@ -304,21 +309,31 @@ Hydra format." (nr 10) (order status+submission-time))) (("jobset" name) - (let* ((evaluation-count (with-critical-section db-channel (db) (db-get-evaluations-count db name))) - (page-count (quotient (+ evaluation-count (- PAGESIZE 1)) PAGESIZE)) + (let* ((evaluation-id-max (with-critical-section db-channel (db) (db-get-evaluations-id-max db name))) + (evaluation-id-min (with-critical-section db-channel (db) (db-get-evaluations-id-min db name))) (params (request-parameters request)) - (page-exist? (assq-ref params 'page)) - (page-number? (if page-exist? (list-ref page-exist? 0) 1)) - (page (if page-number? (min (max 1 page-number?) page-count) 1))) + (page 1) + (border-high (normalize-parameter (assq-ref params 'border-high))) + (border-low (normalize-parameter (assq-ref params 'border-low + ;(page-exist? (assq-ref params 'page)) + ;(page-number? (if page-exist? (list-ref page-exist? 0) 1)) + ;(page (if page-number? (min (max 1 page-number?) page-count) 1))) + ;(display border-low))) (respond-html (html-page name (evaluation-info-table name - page (with-critical-section db-channel (db) -(db-get-evaluations-build-summary db name PAGESIZE (* PAGESIZE (- page 1 - evaluation-count) +(db-get-evaluations-build-summary + db + name + PAGESIZE + border-low + border-high + )) + evaluation-id-min + evaluation-id-max) (("eval" id)
web-interface updated (450c6bb -> 5d61dea)
tsholokhova pushed a change to branch web-interface. from 450c6bb Add white-list. new 5d61dea Update id pagination. Summary of changes: src/cuirass/database.scm | 27 +++--- src/cuirass/http.scm | 31 +++- src/cuirass/templates.scm | 90 --- 3 files changed, 98 insertions(+), 50 deletions(-)
[no subject]
branch: web-interface commit 450c6bb6610d9425539535894014f2b795458962 Author: TSholokhova Date: Wed Jun 27 15:42:41 2018 +0300 Add white-list. * src/cuirass/http.scm (respond-static-file, file-white-list): Add white list check. --- src/cuirass/http.scm | 22 +++--- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index 9cab34d..712db10 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -44,7 +44,7 @@ ;; Define to the static file directory. (string-append (or (getenv "CUIRASS_DATADIR") (string-append %datadir "/" %package)) - "/static/")) + "/static")) (define file-mime-types '(("css" . (text/css)) @@ -55,6 +55,13 @@ ("gif" . (image/gif)) ("html" . (text/html +(define file-white-list + '("css/bootstrap.css" +"css/open-iconic-bootstrap.css" +"fonts/open-iconic.otf" +"fonts/open-iconic.woff" +"images/logo.png")) + (define (file-extension file-name) (last (string-split file-name #\.))) @@ -174,13 +181,14 @@ Hydra format." (define (respond-static-file path) ;; PATH is a list of path components -(let ((file-name (string-join (cons* %static-directory path) "/"))) - (if (and (not (any (cut string-contains <> "..") path)) - (file-exists? file-name) - (not (directory? file-name))) +(let ((file-name (string-join path "/")) + (file-path (string-join (cons* %static-directory path) "/"))) + (if (and (member file-name file-white-list) + (file-exists? file-path) + (not (directory? file-path))) (respond -`((content-type . ,(assoc-ref file-mime-types (file-extension file-name -#:body (call-with-input-file file-name get-bytevector-all)) +`((content-type . ,(assoc-ref file-mime-types (file-extension file-path +#:body (call-with-input-file file-path get-bytevector-all)) (respond-not-found file-name (define (respond-build-not-found build-id)
web-interface updated (ac0fd3c -> 450c6bb)
tsholokhova pushed a change to branch web-interface. from ac0fd3c Change HTML5 to XHTML. Fix codestyle. new 450c6bb Add white-list. Summary of changes: src/cuirass/http.scm | 22 +++--- 1 file changed, 15 insertions(+), 7 deletions(-)
[no subject]
branch: web-interface commit ac0fd3c928ad0824e0f1318aada947dcade2b896 Author: TSholokhova Date: Wed Jun 13 01:18:38 2018 +0300 Change HTML5 to XHTML. Fix codestyle. * src/cuirass/http.scm (respond-html): Add XHTML preamble and content-type. * src/cuirass/templates.scm (html-page): Add XHTML preamble; fix codestyle. * src/cuirass/database.scm: Fix codestyle. --- src/cuirass/database.scm | 17 + src/cuirass/http.scm | 19 ++- src/cuirass/templates.scm | 26 +- 3 files changed, 32 insertions(+), 30 deletions(-) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 79fd844..ecf9a39 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -46,7 +46,7 @@ db-get-build db-get-builds db-get-evaluations -db-get-evaluations-info +db-get-evaluations-build-summary db-get-evaluations-count read-sql-file read-quoted-string @@ -561,10 +561,10 @@ FROM Evaluations ORDER BY id DESC LIMIT " limit ";")) (#:revision . ,revision)) evaluations)) -(define (db-get-evaluations-info db spec limit offset) +(define (db-get-evaluations-build-summary db spec limit offset) (let loop ((rows (sqlite-exec db -"SELECT E.id, E.revision, B.succ, B.fail, B.que FROM - (SELECT id, evaluation, SUM(status=0) as succ, SUM(status>0) as fail, SUM(status<0) as que +"SELECT E.id, E.revision, B.succeeded, B.failed, B.scheduled FROM + (SELECT id, evaluation, SUM(status=0) as succeeded, SUM(status>0) as failed, SUM(status<0) as scheduled FROM Builds GROUP BY evaluation) B JOIN @@ -578,17 +578,18 @@ ON B.evaluation=E.id;")) (evaluations '())) (match rows (() evaluations) - ((#(id revision succ fail que) + ((#(id revision succeeded failed scheduled) . rest) (loop rest (cons `((#:id . ,id) (#:revision . ,revision) - (#:succ . ,succ) - (#:fail . ,fail) - (#:que . ,que)) + (#:succeeded . ,succeeded) + (#:failed . ,failed) + (#:scheduled . ,scheduled)) evaluations)) (define (db-get-evaluations-count db spec) + "Return the number of evaluations of the given specification SPEC" (let ((rows (sqlite-exec db "SELECT COUNT(id) FROM Evaluations WHERE specification=" spec))) diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index 7560f38..9cab34d 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -55,6 +55,7 @@ ("gif" . (image/gif)) ("html" . (text/html + (define (file-extension file-name) (last (string-split file-name #\.))) @@ -166,9 +167,9 @@ Hydra format." `((error . ,message) (define (respond-html body) -(respond '((content-type . (text/html))) +(respond '((content-type . (application/xhtml+xml))) #:body (lambda (port) - (format port "") + (format port "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\;>") (sxml->xml body port (define (respond-static-file path) @@ -295,12 +296,12 @@ Hydra format." (nr 10) (order status+submission-time))) (("jobset" name) - (let* ((eval_cnt (with-critical-section db-channel (db) (db-get-evaluations-count db name))) - (page_cnt (quotient (+ eval_cnt (- PAGESIZE 1)) PAGESIZE)) + (let* ((evaluation-count (with-critical-section db-channel (db) (db-get-evaluations-count db name))) + (page-count (quotient (+ evaluation-count (- PAGESIZE 1)) PAGESIZE)) (params (request-parameters request)) - (page_ext? (assq-ref params 'page)) - (page_int? (if page_ext? (list-ref page_ext? 0) 1)) - (page (if page_int? (min (max 1 page_int?) page_cnt) 1))) + (page-exist? (assq-ref params 'page)) + (page-number? (if page-exist? (list-ref page-exist? 0) 1)) + (page (if page-number? (min (max 1 page-number?) page-count) 1))) (respond-html (html-page name @@ -308,8 +309,8 @@ Hydra format." name page (with-critical-section db-channel (db) -(db-get-evaluations-info db name PAGESIZE (* PAGESIZE (- page 1 - eval_cnt) +(db-get-evaluations-build-summary db name PAGESIZE (* PAGESIZE (- page 1 + evaluation-count) (("eval" id) (respond-html diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm index 829e738..927c156 100644 --- a/src/cuirass/templates.scm +++ b/src/cuirass/templates.scm @@ -29,7 +29,7 @@ (define (html-page title body) "Return html page with given title and body" - `(html (@ (lang
web-interface updated (7091f46 -> ac0fd3c)
tsholokhova pushed a change to branch web-interface. from 7091f46 Implement first feature. Add bootstrap style. new ac0fd3c Change HTML5 to XHTML. Fix codestyle. Summary of changes: src/cuirass/database.scm | 17 + src/cuirass/http.scm | 19 ++- src/cuirass/templates.scm | 26 +- 3 files changed, 32 insertions(+), 30 deletions(-)
web-interface updated (8e31e6f -> 7091f46)
tsholokhova pushed a change to branch web-interface. from 8e31e6f Add basic HTML templates, main and specification builds pages. new 7091f46 Implement first feature. Add bootstrap style. Summary of changes: src/cuirass/database.scm | 39 +- src/cuirass/http.scm | 66 +- src/cuirass/templates.scm| 163 +- src/static/css/bootstrap.css | 8981 ++ src/static/css/open-iconic-bootstrap.css | 952 src/static/fonts/open-iconic.eot | Bin 0 -> 28196 bytes src/static/fonts/open-iconic.otf | Bin 0 -> 20996 bytes src/static/fonts/open-iconic.svg | 543 ++ src/static/fonts/open-iconic.ttf | Bin 0 -> 28028 bytes src/static/fonts/open-iconic.woff| Bin 0 -> 14984 bytes src/static/images/logo.png | Bin 0 -> 9494 bytes src/static/style.css | 150 - 12 files changed, 10692 insertions(+), 202 deletions(-) create mode 100644 src/static/css/bootstrap.css create mode 100644 src/static/css/open-iconic-bootstrap.css create mode 100644 src/static/fonts/open-iconic.eot create mode 100644 src/static/fonts/open-iconic.otf create mode 100644 src/static/fonts/open-iconic.svg create mode 100644 src/static/fonts/open-iconic.ttf create mode 100644 src/static/fonts/open-iconic.woff create mode 100644 src/static/images/logo.png delete mode 100644 src/static/style.css
[no subject]
branch: web-interface commit 8e31e6f8af799b6d8a3c0ede9290d463ba436c61 Author: TSholokhova Date: Wed May 23 16:37:23 2018 +0300 Add basic HTML templates, main and specification builds pages. * src/cuirass/templates.scm: New file. Add main page template. Add builds tables (latest and queue). Add hyperref from the main page to the builds pages. * Makefile.am (dist_pkgmodule_DATA): Add it. * src/cuirass/http.scm (url-handler): Add handler for “status” endpoint. (%static-directory, file-mime-types): New variables. (url-handler): Add handler for “/status/”; add handler for static files. * src/static/style.css: New file. --- Makefile.am | 3 +- src/cuirass/http.scm | 75 +-- src/cuirass/templates.scm | 93 src/static/style.css | 150 ++ 4 files changed, 316 insertions(+), 5 deletions(-) diff --git a/Makefile.am b/Makefile.am index d372b9e..75848ef 100644 --- a/Makefile.am +++ b/Makefile.am @@ -39,7 +39,8 @@ dist_pkgmodule_DATA = \ src/cuirass/http.scm \ src/cuirass/logging.scm \ src/cuirass/ui.scm \ - src/cuirass/utils.scm + src/cuirass/utils.scm \ + src/cuirass/templates.scm nodist_pkgmodule_DATA = \ src/cuirass/config.scm diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index e911b9b..ec4f278 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -1,7 +1,9 @@ + http.scm -- HTTP API ;;; Copyright © 2016 Mathieu Lirzin ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2018 Ludovic Courtès +;;; Copyright © 2018 Tatiana Sholokhova ;;; ;;; This file is part of Cuirass. ;;; @@ -22,8 +24,10 @@ #:use-module (cuirass database) #:use-module (cuirass utils) #:use-module (cuirass logging) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (ice-9 binary-ports) #:use-module (ice-9 match) #:use-module (json) #:use-module (web request) @@ -32,8 +36,29 @@ #:use-module (web uri) #:use-module (fibers) #:use-module (fibers channels) + #:use-module (sxml simple) + #:use-module (cuirass templates) #:export (run-cuirass-server)) +(define %static-directory + ;; Define to the static file directory. + (string-append (or (getenv "CUIRASS_DATADIR") + (string-append %datadir "/" %package)) + "/static/")) + +(define file-mime-types + '(("css" . (text/css)) +("js" . (text/javascript)) +("png" . (image/png)) +("gif" . (image/gif)) +("html" . (text/html + +(define (file-extension file-name) + (last (string-split file-name #\.))) + +(define (directory? filename) + (string=? filename (dirname filename))) + (define (build->hydra-build build) "Convert BUILD to an assoc list matching hydra API format." (define (bool->int bool) @@ -103,7 +128,7 @@ Hydra format." (string-split query #\&)) '( - + ;;; ;;; Web server. ;;; @@ -112,6 +137,7 @@ Hydra format." ;;; 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 @@ -135,6 +161,22 @@ Hydra format." #:body (object->json-string `((error . ,message) + + (define (respond-html body) +(respond '((content-type . (text/html))) + #:body (lambda (port) + (sxml->xml body port + + (define (respond-static-file path) +;; PATH is a list of path components +(let ((file-name (string-join (cons* %static-directory path) "/"))) + (if (and (not (any (cut string-contains <> "..") path)) + (file-exists? file-name) + (not (directory? file-name))) + (respond +`((content-type . ,(assoc-ref file-mime-types (file-extension file-name +#:body (call-with-input-file file-name get-bytevector-all)) + (respond-not-found file-name (define (respond-build-not-found build-id) (respond-json-with-error @@ -147,6 +189,11 @@ Hydra format." 404 (format #f "The build log of derivation ~a is not available." drv + (define (respond-not-found resource_name) +(respond (build-response #:code 404) + #:body (string-append "Resource not found: " + resource_name))) + (log-message "~a ~a" (request-method request) (uri-path (request-uri request))) @@ -223,13 +270,33 @@ Hydra format." ,@params
branch web-interface created (now 8e31e6f)
tsholokhova pushed a change to branch web-interface. at 8e31e6f Add basic HTML templates, main and specification builds pages. This branch includes the following new commits: new 8e31e6f Add basic HTML templates, main and specification builds pages.
branch web-interface deleted (was 501d15b)
tsholokhova pushed a change to branch web-interface. was 501d15b Add specification builds page. This change permanently discards the following revisions: discards 501d15b Add specification builds page. discards a4fe6dd basic html templates
web-interface updated (a4fe6dd -> 501d15b)
tsholokhova pushed a change to branch web-interface. from a4fe6dd basic html templates new 501d15b Add specification builds page. Summary of changes: src/cuirass/http.scm | 72 ++ src/cuirass/templates.scm | 104 +--- src/static/style.css | 150 ++ 3 files changed, 295 insertions(+), 31 deletions(-) create mode 100644 src/static/style.css
[no subject]
branch: web-interface commit 501d15b27d16f0ef0c1f808bf97e1340a62ac5f5 Author: TSholokhova <tanja201...@gmail.com> Date: Mon May 28 00:25:22 2018 +0300 Add specification builds page. * src/cuirass/http.scm: Add handler for "/status/" query. Static files serving. Fix codestyle. * src/cuirass/templates.scm: Add builds tables (latest and queue). Add hyperref from the main page to the builds pages. * src/static/style.css: New file. Example style file. --- src/cuirass/http.scm | 72 ++ src/cuirass/templates.scm | 104 +--- src/static/style.css | 150 ++ 3 files changed, 295 insertions(+), 31 deletions(-) diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index f5e3ac1..3d4f4c2 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2016 Mathieu Lirzin <m...@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othac...@gmail.com> ;;; Copyright © 2018 Ludovic Courtès <l...@gnu.org> +;;; Copyright © 2018 Tatiana Sholokhova <tanja201...@gmail.com> ;;; ;;; This file is part of Cuirass. ;;; @@ -23,8 +24,10 @@ #:use-module (cuirass database) #:use-module (cuirass utils) #:use-module (cuirass logging) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (ice-9 binary-ports) #:use-module (ice-9 match) #:use-module (json) #:use-module (web request) @@ -37,6 +40,25 @@ #:use-module (cuirass templates) #:export (run-cuirass-server)) +(define %static-directory + ;; Define to the static file directory. + (string-append (or (getenv "CUIRASS_DATADIR") + (string-append %datadir "/" %package)) + "/static/")) + +(define file-mime-types + '(("css" . (text/css)) +("js" . (text/javascript)) +("png" . (image/png)) +("gif" . (image/gif)) +("html" . (text/html + +(define (file-extension file-name) + (last (string-split file-name #\.))) + +(define (directory? filename) + (string=? filename (dirname filename))) + (define (build->hydra-build build) "Convert BUILD to an assoc list matching hydra API format." (define (bool->int bool) @@ -143,8 +165,18 @@ Hydra format." (define (respond-html body) (respond '((content-type . (text/html))) #:body (lambda (port) - (sxml->xml body port) - ))) + (sxml->xml body port + + (define (respond-static-file path) +;; PATH is a list of path components +(let ((file-name (string-join (cons* %static-directory path) "/"))) + (if (and (not (any (cut string-contains <> "..") path)) + (file-exists? file-name) + (not (directory? file-name))) + (respond +`((content-type . ,(assoc-ref file-mime-types (file-extension file-name +#:body (call-with-input-file file-name get-bytevector-all)) + (respond-not-found file-name (define (respond-build-not-found build-id) (respond-json-with-error @@ -157,6 +189,11 @@ Hydra format." 404 (format #f "The build log of derivation ~a is not available." drv + (define (respond-not-found resource_name) +(respond (build-response #:code 404) + #:body (string-append "Resource not found: " + resource_name))) + (log-message "~a ~a" (request-method request) (uri-path (request-uri request))) @@ -233,18 +270,33 @@ Hydra format." ,@params (order status+submission-time) (respond-json-with-error 500 "Parameter not defined!" -(("status") - (respond-html (templatize - "Status" - (specifications-table -(with-critical-section db-channel (db) (db-get-specifications db)) +(("status") + (respond-html (html-page + "Status" + (specifications-table + (with-critical-section db-channel (db) (db-get-specifications db)) +(("status" name) + (respond-html (html-page + name + (build-table +(handle-builds-request db-channel + `((status done) + (project ,name) + (nr 10) + (order finish-time))) +(handle-builds-request db-channel + `((status pending) +
[no subject]
branch: web-interface commit a4fe6dd0d0c82c84a810d3368dd60fea3aa1b2b0 Author: TSholokhovaDate: Wed May 23 16:37:23 2018 +0300 basic html templates --- Makefile.am | 3 ++- src/cuirass/http.scm | 15 +++ src/cuirass/templates.scm | 32 3 files changed, 49 insertions(+), 1 deletion(-) diff --git a/Makefile.am b/Makefile.am index d372b9e..75848ef 100644 --- a/Makefile.am +++ b/Makefile.am @@ -39,7 +39,8 @@ dist_pkgmodule_DATA = \ src/cuirass/http.scm \ src/cuirass/logging.scm \ src/cuirass/ui.scm \ - src/cuirass/utils.scm + src/cuirass/utils.scm \ + src/cuirass/templates.scm nodist_pkgmodule_DATA = \ src/cuirass/config.scm diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm index e911b9b..f5e3ac1 100644 --- a/src/cuirass/http.scm +++ b/src/cuirass/http.scm @@ -1,3 +1,4 @@ + http.scm -- HTTP API ;;; Copyright © 2016 Mathieu Lirzin ;;; Copyright © 2017 Mathieu Othacehe @@ -32,6 +33,8 @@ #:use-module (web uri) #:use-module (fibers) #:use-module (fibers channels) + #:use-module (sxml simple) + #:use-module (cuirass templates) #:export (run-cuirass-server)) (define (build->hydra-build build) @@ -112,6 +115,7 @@ Hydra format." ;;; 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 @@ -135,6 +139,12 @@ Hydra format." #:body (object->json-string `((error . ,message) + + (define (respond-html body) +(respond '((content-type . (text/html))) + #:body (lambda (port) + (sxml->xml body port) + ))) (define (respond-build-not-found build-id) (respond-json-with-error @@ -223,6 +233,11 @@ Hydra format." ,@params (order status+submission-time) (respond-json-with-error 500 "Parameter not defined!" +(("status") + (respond-html (templatize + "Status" + (specifications-table +(with-critical-section db-channel (db) (db-get-specifications db)) ('method-not-allowed ;; 405 "Method Not Allowed" (values (build-response #:code 405) #f db-channel)) diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm new file mode 100644 index 000..ff63469 --- /dev/null +++ b/src/cuirass/templates.scm @@ -0,0 +1,32 @@ +(define-module (cuirass templates) + #:export (templatize +specifications-table)) + + +(define (templatize title body) + `(html +,(head title) +(body ,body))) + + +(define (head title) + `(head +(meta (@ (charset "utf-8"))) +(title ,title))) + + +(define (specifications-table specs) + `(table +(@ (class "table-fill")) +(thead + (tr + (th (@ (class "text-left")) Name) + (th (@ (class "text-left")) Branch))) +(tbody + (@ (class "table-fill")) + ,@(map +(lambda (spec) + `(tr +(td ,(assq-ref spec #:name)) +(td ,(assq-ref spec #:branch +specs
branch web-interface created (now a4fe6dd)
tsholokhova pushed a change to branch web-interface. at a4fe6dd basic html templates This branch includes the following new commits: new a4fe6dd basic html templates