[no subject]

[Tatiana]

branch: web-interface
commit 501d15b27d16f0ef0c1f808bf97e1340a62ac5f5
Author: TSholokhova <address@hidden>
Date:   Mon May 28 00:25:22 2018 +0300

    Add specification builds page.
    
    * src/cuirass/http.scm: Add handler for "/status/<repo_name>" 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 <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.
 ;;;
@@ -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)
+                          (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
index ff63469..f882e98 100644
--- a/src/cuirass/templates.scm
+++ b/src/cuirass/templates.scm
@@ -1,32 +1,94 @@
+
+;;;; 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 (templatize
-            specifications-table))
+  #:export (html-page
+            specifications-table
+            build-table))
 
 
-(define (templatize title body)
+(define (html-page title body)
+  "Return html page with given title and body"
   `(html 
-    ,(head title)
+    (head 
+      (meta (@ (charset "utf-8")))
+      (link (@ (rel "stylesheet") 
+               (type "text/css")
+               (href "/static/style.css")))
+      (title ,title))
     (body ,body)))
 
 
-(define (head title)
-  `(head 
-    (meta (@ (charset "utf-8"))) 
-    (title ,title)))
-
-
 (define (specifications-table specs)
+  "Return body for main (Status) html-page"
   `(table
     (@ (class "table-fill"))
-    (thead
-     (tr
-      (th (@ (class "text-left")) Name)
-      (th (@ (class "text-left")) Branch)))
-    (tbody
+    (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"))
-     ,@(map
-        (lambda (spec)
-          `(tr
-            (td ,(assq-ref spec #:name))
-            (td ,(assq-ref spec #:branch))))
-        specs))))
+     (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..2d4b243
--- /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;
+}