From aad2c9d9e835d7af362febae9bf3cb7bf6225c6b Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Thu, 6 Jun 2019 20:39:06 +0100
Subject: [PATCH] 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 | 25 +++++++++++++++++++++++--
 guix-data-service/web/render.scm     | 21 ++++++---------------
 guix-data-service/web/server.scm     | 18 +++++++-----------
 guix-data-service/web/view/html.scm  |  6 +++---
 4 files changed, 39 insertions(+), 31 deletions(-)

diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 8482272..c06b24c 100644
--- a/guix-data-service/web/controller.scm
+++ b/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)))))
diff --git a/guix-data-service/web/render.scm b/guix-data-service/web/render.scm
index 2318a19..5b0ff7a 100644
--- a/guix-data-service/web/render.scm
+++ b/guix-data-service/web/render.scm
@@ -49,22 +49,13 @@
     ("ttf"  . (application/octet-stream))
     ("html" . (text/html))))
 
-(define (render-static-asset request)
-  (render-static-file (%config 'assets-dir) request))
+(define (render-static-asset path headers)
+  (render-static-file (%config 'assets-dir) path headers))
 
 (define %not-slash
   (char-set-complement (char-set #\/)))
 
-(define (render-static-file root request)
-  (define path
-    (uri-path (request-uri request)))
-
-  (define failure
-    (not-found (build-uri 'http
-                          #:host (%config 'host)
-                          #:port (%config 'port)
-                          #:path path)))
-
+(define (render-static-file root path headers)
   (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))
-        failure)))
+              #f))
+        #f)))
 
 (define* (render-html #:key sxml (extra-headers '())
                       (code 200))
diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm
index f390da1..8072dfe 100644
--- a/guix-data-service/web/server.scm
+++ b/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
-   (lambda (conn)
-     (let-values (((request-components mime-types)
-                   (request->path-components-and-mime-type request)))
-       (controller request
-                   (cons (request-method request)
-                         request-components)
-                   mime-types
-                   body
-                   conn)))))
+  (let-values (((request-components mime-types)
+                (request->path-components-and-mime-type request)))
+    (controller request
+                (cons (request-method request)
+                      request-components)
+                mime-types
+                body)))
 
 (define (handler request body controller)
   (format #t "~a ~a\n"
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index cec4c19..61a24f2 100644
--- a/guix-data-service/web/view/html.scm
+++ b/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."