[no subject]

[Tatiana]

branch: web-interface
commit 8e31e6f8af799b6d8a3c0ede9290d463ba436c61
Author: TSholokhova <address@hidden>
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/<repo_name>”; 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 <address@hidden>
 ;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
 ;;; Copyright © 2018 Ludovic Courtès <address@hidden>
+;;; Copyright © 2018 Tatiana Sholokhova <address@hidden>
 ;;;
 ;;; 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
                                       (order status+submission-time)))))
            (respond-json-with-error 500 "Parameter not defined!"))))
+    (("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)
+                          (project ,name)
+                          (nr 10)
+                          (order status+submission-time)))))))
+    (("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..3f27939
--- /dev/null
+++ b/src/cuirass/templates.scm
@@ -0,0 +1,93 @@
+
+;;;; http.scm -- HTTP API
+;;; Copyright © 2018 Tatiana Sholokhova <address@hidden>
+;;;
+;;; 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))
+
+
+(define (html-page title body)
+  "Return html page with given title and body"
+  `(html
+    (head
+      (meta (@ (charset "utf-8")))
+      (link (@ (rel "stylesheet")
+               (type "text/css")
+               (href "/static/style.css")))
+      (title ,title))
+    (body ,body)))
+
+
+(define (specifications-table specs)
+  "Return body for main (Status) html-page"
+  `(table
+    (@ (class "table-fill"))
+    (caption  "Status")
+     ,@(if (null? specs)
+        `((th (@ (class "text-left")) "No elements here."))
+        `((thead
+            (tr
+             (th (@ (class "text-left")) Name)
+             (th (@ (class "text-left")) Branch)))
+           (tbody
+            (@ (class "table-fill"))
+            ,@(map
+             (lambda (spec)
+              `(tr
+                (td (a (@ (href ,(string-append "/status/" (assq-ref spec 
#:name))))) ,(assq-ref spec #:name))
+                (td ,(assq-ref spec #:branch))))
+            specs))))))
+
+(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 (@ (class "text-left")) Project)
+       (th (@ (class "text-left")) Jobset)
+       (th (@ (class "text-left")) Job)
+       (th (@ (class "text-left")) Nixname)
+       (th (@ (class "text-left")) Buildstatus))))
+  `((table
+     (@ (class "table-fill"))
+     (caption  "Latest builds")
+     ,@(if (null? done)
+       `((th (@ (class "text-left")) "No elements here."))
+       `(,(table-header)
+         (tbody
+          (@ (class "table-fill"))
+          ,@(map table-row done)))))
+    (table
+     (@ (class "table-fill"))
+     (caption "Queue")
+     ,@(if (null? pending)
+       `((th (@ (class "text-left")) "No elements here."))
+       `(,(table-header)
+         (tbody
+          (@ (class "table-fill"))
+          ,@(map table-row pending)))))))
+
diff --git a/src/static/style.css b/src/static/style.css
new file mode 100644
index 0000000..556d781
--- /dev/null
+++ b/src/static/style.css
@@ -0,0 +1,150 @@
address@hidden 
url(https://fonts.googleapis.com/css?family=Roboto:400,500,700,300,100);
+
+body {
+  background-color: #aec4fc;
+  font-family: "Roboto", helvetica, arial, sans-serif;
+  font-size: 16px;
+  font-weight: 400;
+  text-rendering: optimizeLegibility;
+}
+caption {
+   color: #111144;
+   font-size: 30px;
+   font-weight: 400;
+   font-style:normal;
+   font-family: "Roboto", helvetica, arial, sans-serif;
+   text-shadow: -1px -1px 1px rgba(0, 0, 0, 0.1);
+}
+div.table-title {
+   display: block;
+  margin: auto;
+  max-width: 1000px;
+  padding:5px;
+  width: 100%;
+}
+
+.table-title h3 {
+   color: #fafafa;
+   font-size: 30px;
+   font-weight: 400;
+   font-style:normal;
+   font-family: "Roboto", helvetica, arial, sans-serif;
+   text-shadow: -1px -1px 1px rgba(0, 0, 0, 0.1);
+   text-transform:uppercase;
+}
+
+
+/*** Table Styles **/
+
+.table-fill {
+  background: white;
+  border-radius:3px;
+  border-collapse: collapse;
+  height: 60px;
+  margin: auto;
+  max-width: 1000px;
+  padding:5px;
+  width: 100%;
+  box-shadow: 0 5px 10px rgba(0, 0, 0, 0.1);
+  animation: float 5s infinite;
+}
+
+th {
+  color:#D5DDE5;;
+  background:#1b1e24;
+  border-bottom:4px solid #9ea7af;
+  border-right: 1px solid #343a45;
+  font-size:23px;
+  font-weight: 100;
+  padding:24px;
+  text-align:left;
+  text-shadow: 0 1px 1px rgba(0, 0, 0, 0.1);
+  vertical-align:middle;
+}
+
+th:first-child {
+  border-top-left-radius:3px;
+}
+
+th:last-child {
+  border-top-right-radius:3px;
+  border-right:none;
+}
+
+tr {
+  border-top: 1px solid #C1C3D1;
+  border-bottom-: 1px solid #C1C3D1;
+  color:#666B85;
+  font-size:16px;
+  font-weight:normal;
+  text-shadow: 0 1px 1px rgba(256, 256, 256, 0.1);
+}
+
+tr:hover td {
+  background:#4E5066;
+  color:#FFFFFF;
+  border-top: 1px solid #22262e;
+}
+
+tr:first-child {
+  border-top:none;
+}
+
+tr:last-child {
+  border-bottom:none;
+}
+
+tr:nth-child(odd) td {
+  background:#EBEBEB;
+}
+
+tr:nth-child(odd):hover td {
+  background:#4E5066;
+}
+
+tr:last-child td:first-child {
+  border-bottom-left-radius:3px;
+}
+
+tr:last-child td:last-child {
+  border-bottom-right-radius:3px;
+}
+
+td {
+  background:#FFFFFF;
+  padding:20px;
+  text-align:left;
+  vertical-align:middle;
+  font-weight:300;
+  font-size:18px;
+  text-shadow: -1px -1px 1px rgba(0, 0, 0, 0.1);
+  border-right: 1px solid #C1C3D1;
+}
+
+td:last-child {
+  border-right: 0px;
+}
+
+th.text-left {
+  text-align: left;
+}
+
+th.text-center {
+  text-align: center;
+}
+
+th.text-right {
+  text-align: right;
+}
+
+td.text-left {
+  text-align: left;
+}
+
+td.text-center {
+  text-align: center;
+}
+
+td.text-right {
+  text-align: right;
+}