[no subject]

2018-08-05 Thread Tatiana
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]

2018-08-05 Thread Tatiana
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)

2018-08-05 Thread Tatiana
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]

2018-08-05 Thread Tatiana
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)

2018-08-05 Thread Tatiana
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)

2018-07-24 Thread Tatiana
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)

2018-07-24 Thread Tatiana
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]

2018-07-24 Thread Tatiana
\
+  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)

2018-07-22 Thread Tatiana
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]

2018-07-22 Thread Tatiana
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)

2018-07-22 Thread Tatiana
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]

2018-07-22 Thread Tatiana
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)

2018-07-21 Thread Tatiana
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]

2018-07-21 Thread Tatiana
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)

2018-07-21 Thread Tatiana
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)

2018-07-21 Thread Tatiana
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]

2018-07-21 Thread Tatiana
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]

2018-07-08 Thread Tatiana
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)

2018-07-08 Thread Tatiana
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]

2018-07-08 Thread Tatiana
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)

2018-07-08 Thread Tatiana
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]

2018-07-04 Thread Tatiana
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)

2018-07-04 Thread Tatiana
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]

2018-06-27 Thread Tatiana
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)

2018-06-27 Thread Tatiana
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]

2018-06-12 Thread Tatiana
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)

2018-06-12 Thread Tatiana
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)

2018-06-10 Thread Tatiana
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]

2018-06-02 Thread Tatiana
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)

2018-06-02 Thread Tatiana
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)

2018-06-02 Thread Tatiana
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)

2018-05-27 Thread Tatiana
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]

2018-05-27 Thread Tatiana
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]

2018-05-23 Thread Tatiana
branch: web-interface
commit a4fe6dd0d0c82c84a810d3368dd60fea3aa1b2b0
Author: TSholokhova 
Date:   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)

2018-05-23 Thread Tatiana
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