Web interface review

["Clément Lassieur" <clement@lassieur.org>]

Hello Tatiana,

While your commits aren't pushed to master, they can be modified as much
as you want.  It's good to take advantage of this to make them very
consistent.  For example, they shouldn't correct one another.  The
naming, also, should describe what they do.  It would be inconvenient to
add the huge static files in the commits where you do the actual work,
so maybe we can set them appart.  It's also good that after each commit,
Cuirass is still in a working and consistent state.

What do you think of:

  1. One commit to add all the static files.
  2. One commit to add the whole web interface.

I'm not sure about it, though.  Usually it's better if the commits are
short, but it's also difficult to split the work into small parts
consistenly.  Don't hesitate to tell me if you find a better alternative
:-).

I'll be reviewing the "second commit": everything except the static
files.  But just one note about the static files: they need to be
declared in the Makefile, so that they are copied to their right
location.  That would look like:

--8<---------------cut here---------------start------------->8---
diff --git a/Makefile.am b/Makefile.am
index f519f51..549713a 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -34,6 +34,10 @@ pkgobjectdir = $(guileobjectdir)/$(PACKAGE)
 webmoduledir = $(guilesitedir)/web/server
 webobjectdir = $(guileobjectdir)/web/server
 sqldir = $(pkgdatadir)/sql
+staticdir = $(pkgdatadir)/static
+cssdir = $(staticdir)/css
+fontsdir = $(staticdir)/fonts
+imagesdir = $(staticdir)/images
 
 dist_pkgmodule_DATA =				\
   src/cuirass/base.scm				\
@@ -62,6 +66,18 @@ dist_pkgdata_DATA = src/schema.sql
 dist_sql_DATA = 				\
   src/sql/upgrade-1.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' \
--8<---------------cut here---------------end--------------->8---

Could you add a copyright header at the beginning of database.scm?

>    ;; XXX Change caller and remove
>    (define (assqx-ref filters key)
> @@ -533,17 +539,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)
                     ^
Could you please remove the code comments?  (And in other places too :-))

> +                   (('order 'build-id) "id ASC")
                     ^
And fix the indentation :-)

About the indentation, I've seen it at several places in the code.
Maybe you could try to setup your text editor so that it indents Scheme
correctly.  Don't hesitate to ask for help about it.  You can also join
us on IRC (#guix), we'd happily share our tricks.

> +                  (('order 'decreasing-build-id) "id DESC")
> +                  (('order 'finish-time) "stoptime DESC")
> +                  (('order 'start-time) "starttime DESC")
> +                  (('order 'submission-time) "timestamp DESC")

[...]

> @@ -624,3 +648,67 @@ FROM Evaluations ORDER BY id DESC LIMIT " limit ";"))
>                       (#:specification . ,specification)
>                       (#:commits . ,(string-tokenize commits)))
>                     evaluations))))))
> +
  ^
extra line :-)

> +(define (db-get-evaluations-build-summary db spec limit border-low border-high)
> +  (let loop ((rows  (sqlite-exec db
                                       ^
The string needs to start here, otherwise you'll have an indentation
issue.

> +"SELECT E.id, E.revision, B.succeeded, B.failed, B.scheduled FROM
                                                                     ^
Please end each line with '\', so that new lines aren't interpreted by
SQLite.

> +  (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
> +  (SELECT id, revision
> +  FROM Evaluations
> +  WHERE (specification=" spec ")\
> +  AND (" border-low "IS NULL OR (id >" border-low "))\
> +  AND (" border-high "IS NULL OR (id <" border-high "))\
> +  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 specification SPEC"

Our convention is that we end our sentences with a '.' in docstrings :-)

> +  (let ((rows (sqlite-exec db
> +"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 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 (db-get-evaluations-id-min db spec)
> +  "Return the min id 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)))
> +
 ^ extra line
> +
> +(define (db-get-builds-id-max db eval)
> +  (let ((rows (sqlite-exec db
> +"SELECT MAX(stoptime) FROM Builds
> +WHERE evaluation=" eval)))
> +    (array-ref (list-ref rows 0) 0)))
> +
 ^ extra line
> +
> +(define (db-get-builds-id-min db eval)
> +  (let ((rows (sqlite-exec db
> +"SELECT MIN(stoptime) FROM Builds
> +WHERE evaluation=" eval)))
> +    (array-ref (list-ref rows 0) 0)))
> diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
> index a45e6b1..1995abf 100644
> --- a/src/cuirass/http.scm
> +++ b/src/cuirass/http.scm
> @@ -1,8 +1,10 @@
> +
>  ;;;; http.scm -- HTTP API
>  ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
>  ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
>  ;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
>  ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
> +;;; Copyright © 2018 Tatiana Sholokhova <tanja201396@gmail.com>
>  ;;;
>  ;;; This file is part of Cuirass.
>  ;;;
> @@ -23,8 +25,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)
> @@ -33,8 +37,39 @@
>    #: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"))

Here you should use a parameter[1], it will allow %static-directory to
be "dynamically bound"[2], which makes it easy to change the setting for
a particular bit of code, restoring to its original value when done.
Plus, they are per-thread, unlike global variables.  There are examples
of paremeters in database.scm.  Then to access the value of the
parameter, you need to use (%static-directory) instead of
%static-directory.

[1]: https://www.gnu.org/software/guile/manual/html_node/Parameters.html
[2]: https://www.gnu.org/software/guile/manual/html_node/Lexical-Scope.html

> +(define file-mime-types
> +  '(("css" . (text/css))
> +    ("otf" . (font/otf))
> +    ("woff" . (font/woff))
> +    ("js"  . (text/javascript))
> +    ("png" . (image/png))
> +    ("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"))
> +
 ^ extra line :-)
> +
> +(define (file-extension file-name)
> +  (last (string-split file-name #\.)))

This would behave inconsistenly if there is no extension.  Please use
'file-extension' from (guix utils).

> +(define (directory? filename)
> +  (string=? filename (dirname filename)))

This doesn't work, it seems to always return #f.  Instead, you can use
'file-is-directory?' from the module (guix build union).

As a general rule, don't hesitate to use stuff from Guix, because it's
already a dependency, it's very close to Cuirass, and it's good to avoid
copying code.  Also, don't hesitate to 'grep' for stuff like
"is-directory" in the Guix repo, to find ideas.  It's big and there are
many examples that you can use.

>  (define (build->hydra-build build)
>    "Convert BUILD to an assoc list matching hydra API format."
>    (define (bool->int bool)
> @@ -99,11 +134,12 @@ Hydra format."
>                            (match key-symbol
>                              ('id (string->number param))
>                              ('nr (string->number param))
> +                            ('page (string->number param))
>                              (_   param)))))))
>               (string-split query #\&))
>          '())))
>  
> -\f
> +
   ^
Here you removed the page break (^L) :-)

>  ;;;
>  ;;; Web server.
>  ;;;
> @@ -112,9 +148,15 @@ Hydra format."
>  ;;; https://github.com/NixOS/hydra/blob/master/doc/manual/api.xml
>  ;;;
>  
> +
  ^
Here you added a line.

>  (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))

You don't need this function, see below.

>  (define (url-handler request body db-channel)
>  
>    (define* (respond response #:key body (db-channel db-channel))
> @@ -136,6 +178,24 @@ Hydra format."
>       (object->json-string
>        `((error . ,message)))))

[...]

> +    (("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)))

Could you please stick to 80 columns?  I've noticed this at other places
too.

> +      (params (request-parameters request))
> +      (border-high (normalize-parameter (assq-ref params 'border-high)))
> +      (border-low (normalize-parameter (assq-ref params 'border-low))))

We need to rewrite request-parameters so that it returns an assoc-list,
but in the meantime it's better to use the 'assqx-ref' function from
database.scm.  You probably need to get it out of 'db-get-builds'
though, and to export it.

> +      (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
> +              ))

Please avoid dangling parentheses :-)

> +          evaluation-id-min
> +          evaluation-id-max)))))
> +
> +    (("eval" id)
> +     (let* ((builds-id-max (with-critical-section db-channel (db) (db-get-builds-id-max db id)))
> +      (builds-id-min (with-critical-section db-channel (db) (db-get-builds-id-min db id)))

Here I think you can put the '(with-critical-section db-channel (db)'
around the 'let*', so that you don't need to call it twice.  Same for
"jobset".

> +      (params (request-parameters request))
> +      (border-high (normalize-parameter (assq-ref params 'border-high)))
> +      (border-low (normalize-parameter (assq-ref params 'border-low))))
> +       (respond-html
> +         (html-page
> +          "Evaluations"
> +          (build-eval-table
> +            (handle-builds-request db-channel
> +                                  `((evaluation ,id)
> +                                   (nr ,PAGESIZE)

See below, if it's a parameter, it would be (nr ,(%pagesize)).

> +                                   (order finish-time)
> +                                   (border-high ,border-high)
> +                                   (border-low ,border-low)))
> +            builds-id-min
> +            builds-id-max)))))
> +
> +    (("static" path ...)
> +     ;(display (request-uri request))
> +     (respond-static-file path))
>      ('method-not-allowed
>       ;; 405 "Method Not Allowed"
>       (values (build-response #:code 405) #f db-channel))
>      (_
> -     (respond (build-response #:code 404)
> -              #:body (string-append "Resource not found: "
> -                                    (uri->string (request-uri request)))))))
> +     (respond-not-found  (uri->string (request-uri request))))))
>  
>  (define* (run-cuirass-server db #:key (host "localhost") (port 8080))
>    (let* ((host-info  (gethostbyname host))
> diff --git a/src/cuirass/templates.scm b/src/cuirass/templates.scm
> new file mode 100644
> index 0000000..0e72981
> --- /dev/null
> +++ b/src/cuirass/templates.scm
> @@ -0,0 +1,207 @@
> +
> +;;;; http.scm -- HTTP API
> +;;; Copyright © 2018 Tatiana Sholokhova <tanja201396@gmail.com>
> +;;;
> +;;; This file is part of Cuirass.
> +;;;
> +;;; Cuirass is free software: you can redistribute it and/or modify
> +;;; it under the terms of the GNU General Public License as published by
> +;;; the Free Software Foundation, either version 3 of the License, or
> +;;; (at your option) any later version.
> +;;;
> +;;; Cuirass is distributed in the hope that it will be useful,
> +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
> +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
> +;;; GNU General Public License for more details.
> +;;;
> +;;; You should have received a copy of the GNU General Public License
> +;;; along with Cuirass.  If not, see <http://www.gnu.org/licenses/>.
> +
> +(define-module (cuirass templates)
> +  #:export (html-page
> +            specifications-table
> +            build-table
> +            evaluation-info-table
> +            build-eval-table
> +            PAGESIZE))
> +
> +(define PAGESIZE 10)

It's better to use Guile parameters[1] for the reasons explained above.
Also, our convention is to start global variables' names with a '%'.
That would give:

(define %pagesize
  ;; description
  (make-parameter 10))

[1]: https://www.gnu.org/software/guile/manual/html_node/Parameters.html

> +(define (html-page title body)
> +  "Return html page with given title and body"
> +  `(html (@ (xmlns "http://www.w3.org/1999/xhtml") (xml:lang "en") (lang "en"))
> +    (head
> +      (meta (@ (charset "utf-8")))
> +      (meta (@ (name "viewport")
> +               (content "width=device-width, initial-scale=1, shrink-to-fit=no")))
> +      (link (@ (rel "stylesheet")
> +               (href "/static/css/bootstrap.css")))
> +      (link (@ (rel "stylesheet")
> +               (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 "/"))
> +              (img (@ (src "/static/images/logo.png")
> +                      (alt "logo")
> +                      (height "25")))))
> +      (main (@ (role "main") (class "container pt-4 px-1"))
> +            ,body
> +            (hr)))))
> +
> +
> +(define (specifications-table specs)
> +  "Return body for main (Projects) html-page"

I think it's good to refer to the arguments while describing the
function.  I'd use: "Return HTML for the SPECS table." or something
similar.  I think this function could be used in another context than a
"body" (please correct me if I'm wrong), so there is no need to put
"body" in the docstring.

> +  `((p (@ (class "lead")) "Projects")
> +    (table
> +      (@ (class "table table-sm table-hover"))
> +       ,@(if (null? specs)
> +          `((th (@ (scope "col")) "No elements here."))
> +          `((thead
> +              (tr
> +               (th (@ (scope "col")) Name)
> +               (th (@ (scope "col")) Branch)))
> +             (tbody
> +              ,@(map
> +               (lambda (spec)
> +                `(tr
> +                  (td (a (@ (href "/jobset/" ,(assq-ref spec #:name))) ,(assq-ref spec #:name)))
> +                  (td ,(assq-ref spec #:branch))))
> +              specs)))))))
> +
> +(define (pagination page-id-min page-id-max id-min id-max)
> +  "Return page navigation buttons"
> +    `(div (@ (class row))
> +      (nav
> +        (@ (class "mx-auto") (aria-label "Page navigation"))
> +        (ul (@ (class "pagination"))
> +            (li (@ (class "page-item"))
> +                (a (@ (class "page-link")
> +                   (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-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-low=" ,(number->string (- id-min 1))))
> +                   "Last >>"))
> +            ))))

Could you give a status about the pagination?  I have seen several
discussions about it.  The goal for this commit is to have something
that we can use, but it doesn't need to be perfect.  We can improve it
later.

> +(define (minimum lst cur-min)

I have no idea what cur-min means :-)  Could you find a more descriptive
name?

> +  (cond ((null? lst) cur-min)
> +      ((< (car lst) cur-min) (minimum (cdr lst) (car lst)))
> +      (else (minimum (cdr lst) cur-min))))
> +
 ^ extra line :-)
> +
> +(define (maximum lst cur-max)
> +  (cond ((null? lst) cur-max)
> +      ((> (car lst) cur-max) (maximum (cdr lst) (car lst)))
> +      (else (maximum (cdr lst) cur-max))))
> +
 ^ too
> +
> +(define (evaluation-info-table name data evaluation-id-min evaluation-id-max)
> +  "Return body for (Evaluation) html-page"

"Return HTML for the EVALUATION table NAME from EVALUATION-ID-MIN to
EVALUATION-ID-MAX." (and please, replace 'data' with 'evaluations', it's
difficult to know what 'data' means :-)).

> +  (let ((id-min (minimum (map (lambda (row) (assq-ref row #:id)) data) evaluation-id-max))
> +       (id-max (maximum (map (lambda (row) (assq-ref row #:id)) data) evaluation-id-min)))
> +    `((p (@ (class "lead")) "Evaluations of " ,name)
> +      ;(p (@ (class "text-muted")) "Showing evaluations ",id-min "-",id-max " out of ",evaluation-id-max)
> +      (table
> +        (@ (class "table table-sm table-hover table-striped"))
> +         ,@(if (null? data)
> +            `((th (@ (scope "col")) "No elements here."))
> +            `((thead
> +                (tr
> +                 (th (@ (scope "col")) "#")
> +                 (th (@ (scope "col")) Revision)
> +                 (th (@ (scope "col")) Success)))
> +               (tbody
> +                ,@(map
> +                 (lambda (row)
> +                  `(tr
> +                    (th (@ (scope "row")) (a (@ (href "/eval/" ,(assq-ref row #:id))) ,(assq-ref row #:id)))
> +                    (td ,(assq-ref row #:revision))
> +                    (td
> +                      (a (@ (href "#") (class "badge badge-success")) ,(assq-ref row #:succeeded))
> +                      (a (@ (href "#") (class "badge badge-danger")) ,(assq-ref row #:failed))
> +                      (a (@ (href "#") (class "badge badge-secondary")) ,(assq-ref row #:scheduled)))))
> +                 data)))))
> +      ,(pagination id-min id-max evaluation-id-min evaluation-id-max))))
> +
> +(define (build-eval-table data build-id-min build-id-max)
> +
 ^ extra line
> +  (define (table-header)
> +    `(thead
> +      (tr
> +       (th (@ (scope "col")) '())
> +       (th (@ (scope "col")) ID)
> +       (th (@ (scope "col")) Project)
> +       (th (@ (scope "col")) "Finished at")
> +       (th (@ (scope "col")) Job)
> +       (th (@ (scope "col")) Nixname)
> +       (th (@ (scope "col")) System)

[...]

> +(define (build-table done pending)
> +  "Return body for project's html-page"
> +  (define (table-row build)
> +    `(tr
> +      (td ,(assq-ref build #:project))
> +      (td ,(assq-ref build #:jobset))
> +      (td ,(assq-ref build #:job))
> +      (td ,(assq-ref build #:nixname))
> +      (td ,(assq-ref build #:buildstatus))))
> +  (define (table-header)
> +    `(thead
> +      (tr
> +       (th (@ (scope "col")) Project)
> +       (th (@ (scope "col")) Jobset)
> +       (th (@ (scope "col")) Job)
> +       (th (@ (scope "col")) Nixname)
> +       (th (@ (scope "col")) Buildstatus))))
> +  `((table
> +     (@ (class "table table-sm table-hover table-striped"))
> +     (caption  "Latest builds")
> +     ,@(if (null? done)
> +       `((th (@ (scope "col")) "No elements here."))
> +       `(,(table-header)
> +         (tbody
> +          (@ (class "table table-sm table-hover table-striped"))
> +          ,@(map table-row done)))))
> +    (table
> +     (@ (class "table table-sm table-hover table-striped"))
> +     (caption "Queue")
> +     ,@(if (null? pending)
> +       `((th (@ (scope "col")) "No elements here."))
> +       `(,(table-header)
> +         (tbody
> +          (@ (class "table table-sm table-hover table-striped"))
> +          ,@(map table-row pending)))))))

Here I would do a procedure 'build-table' of one argument, that I would
call twice: once with the builds that are done, and once with the builds
that are pending.  That would avoid the code repetition.

Also, if you need help with git (to put the commits together), don't
hesistate to ask, either here or on IRC (#guix).

And please, make sure 'make check' works :-).  I had to replace (3
"/baz.drv") with (1 "/foo.drv") in the "db-get-builds" test, but I
didn't look closely at it.

And that's all!

Thank you!
Clément