gnu: datamash: Update to 1.1.1.
[jackhill/guix/guix.git] / gnu / services / web.scm
index a363522..11408d7 100644 (file)
@@ -1,8 +1,9 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
 ;;; Copyright © 2016 Julien Lepiller <julien@lepiller.eu>
+;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
   #:use-module (gnu packages web)
   #:use-module (guix records)
   #:use-module (guix gexp)
+  #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:export (nginx-configuration
             nginx-configuration?
             nginx-server-configuration
             nginx-server-configuration?
+            nginx-upstream-configuration
+            nginx-upstream-configuration?
+            nginx-location-configuration
+            nginx-location-configuration?
+            nginx-named-location-configuration
+            nginx-named-location-configuration?
             nginx-service
             nginx-service-type))
 
@@ -52,6 +60,8 @@
                        (default (list 'default)))
   (root                nginx-server-configuration-root
                        (default "/srv/http"))
+  (locations           nginx-server-configuration-locations
+                       (default '()))
   (index               nginx-server-configuration-index
                        (default (list "index.html")))
   (ssl-certificate     nginx-server-configuration-ssl-certificate
   (server-tokens?      nginx-server-configuration-server-tokens?
                        (default #f)))
 
+(define-record-type* <nginx-upstream-configuration>
+  nginx-upstream-configuration make-nginx-upstream-configuration
+  nginx-upstream-configuration?
+  (name                nginx-upstream-configuration-name)
+  (servers             nginx-upstream-configuration-servers))
+
+(define-record-type* <nginx-location-configuration>
+  nginx-location-configuration make-nginx-location-configuration
+  nginx-location-configuration?
+  (uri                 nginx-location-configuration-uri
+                       (default #f))
+  (body                nginx-location-configuration-body))
+
+(define-record-type* <nginx-named-location-configuration>
+  nginx-named-location-configuration make-nginx-named-location-configuration
+  nginx-named-location-configuration?
+  (name                nginx-named-location-configuration-name
+                       (default #f))
+  (body                nginx-named-location-configuration-body))
+
 (define-record-type* <nginx-configuration>
   nginx-configuration make-nginx-configuration
   nginx-configuration?
-  (nginx         nginx-configuration-nginx)         ;<package>
-  (log-directory nginx-configuration-log-directory) ;string
-  (run-directory nginx-configuration-run-directory) ;string
-  (file          nginx-configuration-file))         ;string | file-like
+  (nginx         nginx-configuration-nginx          ;<package>
+                 (default nginx))
+  (log-directory nginx-configuration-log-directory  ;string
+                 (default "/var/log/nginx"))
+  (run-directory nginx-configuration-run-directory  ;string
+                 (default "/var/run/nginx"))
+  (server-blocks nginx-configuration-server-blocks
+                 (default '()))          ;list of <nginx-server-configuration>
+  (upstream-blocks nginx-configuration-upstream-blocks
+                   (default '()))      ;list of <nginx-upstream-configuration>
+  (file          nginx-configuration-file         ;#f | string | file-like
+                 (default #f)))
 
 (define (config-domain-strings names)
  "Return a string denoting the nginx config representation of NAMES, a list
@@ -86,6 +124,19 @@ of index files."
         ((? string? str) (string-append str " ")))
        names)))
 
+(define nginx-location-config
+  (match-lambda
+    (($ <nginx-location-configuration> uri body)
+     (string-append
+      "      location " uri " {\n"
+      "        " (string-join body "\n    ") "\n"
+      "      }\n"))
+    (($ <nginx-named-location-configuration> name body)
+     (string-append
+      "      location @" name " {\n"
+      "        " (string-join body "\n    ") "\n"
+      "      }\n"))))
+
 (define (default-nginx-server-config server)
   (string-append
    "    server {\n"
@@ -114,11 +165,23 @@ of index files."
    "      index " (config-index-strings (nginx-server-configuration-index server)) ";\n"
    "      server_tokens " (if (nginx-server-configuration-server-tokens? server)
                               "on" "off") ";\n"
+   "\n"
+   (string-join
+    (map nginx-location-config (nginx-server-configuration-locations server))
+    "\n")
+   "    }\n"))
+
+(define (nginx-upstream-config upstream)
+  (string-append
+   "    upstream " (nginx-upstream-configuration-name upstream) " {\n"
+   (string-concatenate
+    (map (lambda (server)
+           (simple-format #f "      server ~A;\n" server))
+         (nginx-upstream-configuration-servers upstream)))
    "    }\n"))
 
-(define (default-nginx-config log-directory run-directory server-list)
-  (plain-file "nginx.conf"
-              (string-append
+(define (default-nginx-config log-directory run-directory server-list upstream-list)
+  (mixed-text-file "nginx.conf"
                "user nginx nginx;\n"
                "pid " run-directory "/pid;\n"
                "error_log " log-directory "/error.log info;\n"
@@ -129,12 +192,18 @@ of index files."
                "    uwsgi_temp_path " run-directory "/uwsgi_temp;\n"
                "    scgi_temp_path " run-directory "/scgi_temp;\n"
                "    access_log " log-directory "/access.log;\n"
+               "\n"
+               (string-join
+                (filter (lambda (section) (not (null? section)))
+                        (map nginx-upstream-config upstream-list))
+                "\n")
+               "\n"
                (let ((http (map default-nginx-server-config server-list)))
                  (do ((http http (cdr http))
                       (block "" (string-append (car http) "\n" block )))
                      ((null? http) block)))
                "}\n"
-               "events {}\n")))
+               "events {}\n"))
 
 (define %nginx-accounts
   (list (user-group (name "nginx") (system? #t))
@@ -148,7 +217,8 @@ of index files."
 
 (define nginx-activation
   (match-lambda
-    (($ <nginx-configuration> nginx log-directory run-directory config-file)
+    (($ <nginx-configuration> nginx log-directory run-directory server-blocks
+                              upstream-blocks config-file)
      #~(begin
          (use-modules (guix build utils))
 
@@ -164,17 +234,25 @@ of index files."
          (mkdir-p (string-append #$run-directory "/scgi_temp"))
          ;; Check configuration file syntax.
          (system* (string-append #$nginx "/sbin/nginx")
-                  "-c" #$config-file "-t")))))
+                  "-c" #$(or config-file
+                             (default-nginx-config log-directory
+                               run-directory server-blocks upstream-blocks))
+                  "-t")))))
 
 (define nginx-shepherd-service
   (match-lambda
-    (($ <nginx-configuration> nginx log-directory run-directory config-file)
+    (($ <nginx-configuration> nginx log-directory run-directory server-blocks
+                              upstream-blocks config-file)
      (let* ((nginx-binary (file-append nginx "/sbin/nginx"))
             (nginx-action
              (lambda args
                #~(lambda _
                    (zero?
-                    (system* #$nginx-binary "-c" #$config-file #$@args))))))
+                    (system* #$nginx-binary "-c"
+                             #$(or config-file
+                                   (default-nginx-config log-directory
+                                     run-directory server-blocks upstream-blocks))
+                             #$@args))))))
 
        ;; TODO: Add 'reload' action.
        (list (shepherd-service
@@ -192,14 +270,21 @@ of index files."
                        (service-extension activation-service-type
                                           nginx-activation)
                        (service-extension account-service-type
-                                          (const %nginx-accounts))))))
+                                          (const %nginx-accounts))))
+                (compose concatenate)
+                (extend (lambda (config servers)
+                          (nginx-configuration
+                            (inherit config)
+                            (server-blocks
+                              (append (nginx-configuration-server-blocks config)
+                              servers)))))))
 
 (define* (nginx-service #:key (nginx nginx)
                         (log-directory "/var/log/nginx")
                         (run-directory "/var/run/nginx")
-                        (server-list (list (nginx-server-configuration)))
-                        (config-file
-                         (default-nginx-config log-directory run-directory server-list)))
+                        (server-list '())
+                        (upstream-list '())
+                        (config-file #f))
   "Return a service that runs NGINX, the nginx web server.
 
 The nginx daemon loads its runtime configuration from CONFIG-FILE, stores log
@@ -209,4 +294,6 @@ files in LOG-DIRECTORY, and stores temporary runtime files in RUN-DIRECTORY."
             (nginx nginx)
             (log-directory log-directory)
             (run-directory run-directory)
+            (server-blocks server-list)
+            (upstream-blocks upstream-list)
             (file config-file))))