Extract the database connection handling from the server

Previously, one of the first things that happened when responding to a request
was a database connection was made, even when serving the CSS. This is
unnecessary, so move the database connection handling in to the controller.

Also, to allow for separating it out from the assets, separate the assets out
from the parts of the controller that require a database connection.

guix-data-service/web/controller.scm

@@ -31,6 +31,7 @@
   #:use-module (squee)
   #:use-module (json)
   #:use-module (guix-data-service comparison)
+  #:use-module (guix-data-service database)
   #:use-module (guix-data-service model git-branch)
   #:use-module (guix-data-service model git-repository)
   #:use-module (guix-data-service model guix-revision)
@@ -537,7 +538,27 @@
 (define (parse-build-status s)
   s)
 
-(define (controller request method-and-path-components mime-types body conn)
+(define (controller request method-and-path-components mime-types body)
+  (match method-and-path-components
+    ((GET "assets" rest ...)
+     (or (render-static-asset (string-join rest "/")
+                              (request-headers request))
+         (not-found (request-uri request))))
+
+    (_
+     (with-postgresql-connection
+      (lambda (conn)
+        (controller-with-database-connection request
+                                             method-and-path-components
+                                             mime-types
+                                             body
+                                             conn))))))
+
+(define (controller-with-database-connection request
+                                             method-and-path-components
+                                             mime-types
+                                             body
+                                             conn)
   (define query-parameters
     (-> request
         request-uri
@@ -694,4 +715,4 @@
                                      target-commit
                                      target-revision-id)))))
     ((GET path ...)
-     (render-static-asset request))))
+     (not-found (request-uri request)))))

guix-data-service/web/render.scm

@@ -49,22 +49,13 @@
     ("ttf"  . (application/octet-stream))
     ("html" . (text/html))))
 
-(define (render-static-asset request)
+(define (render-static-asset path headers)
-  (render-static-file (%config 'assets-dir) request))
+  (render-static-file (%config 'assets-dir) path headers))
 
 (define %not-slash
   (char-set-complement (char-set #\/)))
 
-(define (render-static-file root request)
+(define (render-static-file root path headers)
-  (define path
-    (uri-path (request-uri request)))
-
-  (define failure
-    (not-found (build-uri 'http
-                          #:host (%config 'host)
-                          #:port (%config 'port)
-                          #:path path)))
-
   (let ((file-name (string-append root "/" path)))
     (if (not (any (cut string-contains <> "..")
                   (string-tokenize path %not-slash)))
@@ -79,7 +70,7 @@
                   (call-with-input-file file-name get-bytevector-all)))
 
           (if (and stat (not (eq? 'directory (stat:type stat))))
-              (cond ((assoc-ref (request-headers request) 'if-modified-since)
+              (cond ((assoc-ref headers 'if-modified-since)
                      =>
                      (lambda (client-date)
                        (if (time>? modified (date->time-utc client-date))
@@ -88,8 +79,8 @@
                                  #f))))
                     (else
                      (send-file)))
-              failure))
+              #f))
-        failure)))
+        #f)))
 
 (define* (render-html #:key sxml (extra-headers '())
                       (code 200))

guix-data-service/web/server.scm

@@ -23,22 +23,18 @@
   #:use-module (web request)
   #:use-module (web uri)
   #:use-module (fibers web server)
-  #:use-module (guix-data-service database)
   #:use-module (guix-data-service web controller)
   #:use-module (guix-data-service web util)
   #:export (start-guix-data-service-web-server))
 
 (define (run-controller controller request body)
-  (with-postgresql-connection
+  (let-values (((request-components mime-types)
-   (lambda (conn)
+                (request->path-components-and-mime-type request)))
-     (let-values (((request-components mime-types)
+    (controller request
-                   (request->path-components-and-mime-type request)))
+                (cons (request-method request)
-       (controller request
+                      request-components)
-                   (cons (request-method request)
+                mime-types
-                         request-components)
+                body)))
-                   mime-types
-                   body
-                   conn)))))
 
 (define (handler request body controller)
   (format #t "~a ~a\n"

guix-data-service/web/view/html.scm

@@ -74,18 +74,18 @@
        (@ (rel "stylesheet")
           (media "screen")
           (type "text/css")
-          (href "/css/reset.css")))
+          (href "/assets/css/reset.css")))
       (link
        (@ (rel "stylesheet")
           (media "screen")
           (type "text/css")
-          (href "/css/bootstrap.css")))
+          (href "/assets/css/bootstrap.css")))
       ,@head
       (link
        (@ (rel "stylesheet")
           (media "screen")
           (type "text/css")
-          (href "/css/screen.css"))))
+          (href "/assets/css/screen.css"))))
      (body ,@body
            (footer
             (p "Copyright © 2016—2019 by the GNU Guix community."