[PATCH 2/2] gnu: services: web: Add support for NGinx location blocks

[Christopher Baines <mail@cbaines.net>]

* gnu/services/web.scm (<nginx-server-configuration>): Add field locations.
(<nginx-location-configuration>): New record type.
(<nginx-named-location-configuration>): New record type.
(nginx-location-config): New function.
(default-nginx-server-config): Inlcude locations.
* doc/guix.text (Web Services): Document the new nginx-location-configuration
and nginx-named-location-configuration data types, as well as the changes to
the nginx-server-configuration.
---
 doc/guix.texi        | 43 +++++++++++++++++++++++++++++++++++++++++++
 gnu/services/web.scm | 39 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 82 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 5603dd893..045dee76c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12339,6 +12339,11 @@ default server for connections matching no other server.
 @item @code{root} (default: @code{"/srv/http"})
 Root of the website nginx will serve.
 
+@item @code{locations} (default: @code{'()})
+A list of @dfn{nginx-location-configuration} or
+@dfn{nginx-named-location-configuration} records to use within this
+server block.
+
 @item @code{index} (default: @code{(list "index.html")})
 Index files to look for when clients ask for a directory.  If it cannot be found,
 Nginx will send the list of files in the directory.
@@ -12376,6 +12381,44 @@ explicitly.
 @end table
 @end deftp
 
+@deftp {Data Type} nginx-location-configuration
+Data type representing the configuration of an nginx location block.
+This type has the following parameters:
+
+@table @asis
+@item @code{uri}
+URI which this location block matches.
+
+@anchor{nginx-location-configuration body}
+@item @code{body}
+Body of the location block, specified as a string. This can contain many
+configuration directives. For example, to pass requests to a upstream
+server group defined using an @code{nginx-upstream-configuration} block,
+the following directive would be specified in the body @samp{proxy_pass
+http://upstream-name;}.
+
+@end table
+@end deftp
+
+@deftp {Data Type} nginx-named-location-configuration
+Data type representing the configuration of an nginx named location
+block.  Named location blocks are used for request redirection, and not
+used for regular request processing.  This type has the following
+parameters:
+
+@table @asis
+@item @code{name}
+Name to identify this location block.
+
+@item @code{body}
+@xref{nginx-location-configuration body}, as the body for named location
+blocks can be used in a similar way to the
+@code{nginx-location-configuration body}.  One restriction is that the
+body of a named location block cannot contain location blocks.
+
+@end table
+@end deftp
+
 @node Network File System
 @subsubsection Network File System
 @cindex NFS
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index d0ccd02e4..73ecf77fc 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -35,6 +35,10 @@
             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))
 
@@ -55,6 +59,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
@@ -70,6 +76,20 @@
   (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?
@@ -97,6 +117,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"
@@ -125,6 +158,12 @@ 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"
-- 
2.11.0