tissue: Reverse proxy tissue hosts using nginx.

* guix/forge/tissue.scm: Import (srfi srfi-26), (forge nginx), (gnu
services web) and (ice-9 match).
(socket->proxy-pass, tissue-nginx-server-blocks): New functions.
(tissue-service-type): Extend forge-nginx-service-type.

1 files changed, 59 insertions, 1 deletions

diff --git a/guix/forge/tissue.scm b/guix/forge/tissue.scm
index 0e7791e..1608728 100644
--- a/guix/forge/tissue.scm
+++ b/guix/forge/tissue.scm
@@ -19,13 +19,16 @@
 
 (define-module (forge tissue)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module ((forge guile-git) #:select (guile-git))
+  #:use-module (forge nginx)
   #:use-module (forge socket)
   #:use-module (gnu build linux-container)
   #:use-module ((gnu packages admin) #:select (shadow))
   #:use-module ((gnu packages web) #:select (tissue) #:prefix guix:)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
+  #:use-module (gnu services web)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system shadow)
   #:use-module (guix gexp)
@@ -34,6 +37,7 @@
   #:use-module (guix modules)
   #:use-module (guix packages)
   #:use-module (guix records)
+  #:use-module (ice-9 match)
   #:export (tissue-service-type
             <tissue-configuration>
             tissue-configuration
@@ -244,6 +248,58 @@
            #:log-file "/var/log/tissue.log")))
      (stop #~(make-kill-destructor)))))
 
+(define (socket->proxy-pass socket)
+  "Serialize @var{socket}, a forge socket, to an nginx @code{proxy_pass}
+directive."
+  (string-append
+   "proxy_pass "
+   (match socket
+     (($ <forge-host-socket> hostname port)
+      (string-append "http://" hostname ":" (number->string port)))
+     (($ <forge-ip-socket> (? ipv4-address? ip) port)
+      (string-append "http://" ip ":" (number->string port)))
+     (($ <forge-ip-socket> (? ipv6-address? ip) port)
+      (string-append "http://[" ip "]:" (number->string port)))
+     (($ <forge-unix-socket> path)
+      (string-append "http://unix:" path ":")))
+   ";"))
+
+(define (tissue-nginx-server-blocks config)
+  "Return list of @code{<nginx-server-configuration>} extensions for
+tissue configuration @var{config}."
+  (define (project->location state-directory project)
+    (nginx-location-configuration
+     (uri (tissue-project-base-path project))
+     (body (list (string-append "alias "
+                                state-directory
+                                "/"
+                                (tissue-project-name project)
+                                "/website/;")
+                 "try_files $uri $uri.html $uri/ @tissue-search;"))))
+
+  (match-record config <tissue-configuration>
+    (socket state-directory hosts)
+    (map (match-record-lambda <tissue-host>
+             (name projects)
+           (nginx-server-configuration
+            (server-name (list name))
+            (locations
+             (cons (nginx-location-configuration
+                    (uri "@tissue-search")
+                    (body (list (socket->proxy-pass socket)
+                                "proxy_set_header Host $host;")))
+                   (append (map (cut project->location state-directory <>)
+                                projects)
+                           ;; Reject all other locations, unless there
+                           ;; is a project with / as its base path.
+                           (if (member "/" (map tissue-project-base-path
+                                                projects))
+                               (list)
+                               (list (nginx-location-configuration
+                                      (uri "/")
+                                      (body (list "return 404;"))))))))))
+         hosts)))
+
 (define tissue-service-type
   (service-type
    (name 'tissue)
@@ -256,7 +312,9 @@
           (service-extension activation-service-type
                              tissue-activation)
           (service-extension shepherd-root-service-type
-                             (compose list tissue-shepherd-service))))
+                             (compose list tissue-shepherd-service))
+          (service-extension forge-nginx-service-type
+                             tissue-nginx-server-blocks)))
    (compose concatenate)
    (extend (lambda (config host-extensions)
              (tissue-configuration