Generalise Docker service and use it to run Grafana

2 files changed, 171 insertions, 28 deletions

diff --git a/tw/services/docker.scm b/tw/services/docker.scm
new file mode 100644
index 00000000..02ba25e4
--- /dev/null
+++ b/tw/services/docker.scm
@@ -0,0 +1,139 @@
+(define-module (tw services docker)
+  #:use-module ((gnu packages docker) #:select (docker-cli))
+  #:use-module (gnu services)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu services shepherd)
+  #:use-module (guix gexp)
+  #:use-module (guix packages)
+  #:use-module (guix records)
+  #:use-module (ice-9 match)
+  #:use-module ((srfi srfi-1) #:select (every append-map concatenate))
+  #:use-module ((srfi srfi-26) #:select (cut))
+  #:export (docker-container-service-type
+            docker-container-configuration))
+
+(define-maybe/no-serialization string)
+
+(define docker-volume?
+  (match-lambda
+    (((? string? host-path)
+      (? string? container-path))
+     #t)
+    (((? string? host-path)
+      (? string? container-path)
+      (? boolean? read-write?))
+     #t)
+    (_ #f)))
+
+(define (list-of-volumes? thing)
+  (and (list? thing)
+       (every docker-volume? thing)))
+
+(define (list-of-files? thing)
+  (and (list? thing)
+       (every (lambda (item)
+                (or (string? item) (file-like? item)))
+              thing)))
+
+(define-configuration/no-serialization docker-container-configuration
+  (name maybe-string "The name to assign to the running container, if given.")
+  (user maybe-string "The user to run the container as.")
+  (image string "The Docker image to run.")
+  (volumes (list-of-volumes '()) "A list of Docker volumes to mount in the
+container. Each volume is given as a list containing the path on the host (or
+volume name), the path in the container and an optional boolean (defaulting to
+false) specifying whether to allow the container write access to the given
+volume.")
+  (environment-variables (list-of-strings '()) "A list of
+@code{VARIABLE=value} strings specifying environment variables to set inside
+the container.  Warning: it is not safe to pass secrets using this method; use
+@code{environment-files} instead!")
+  (environment-files (list-of-files '()) "A list of files containing
+environment variable assignments, to be applied inside the container.")
+  (network-type (string "none") "Allow the container to connect to the network?")
+  (read-only-root? (boolean #t) "Run the container with a read-only root file system?")
+  (remove-after-stop? (boolean #t) "Delete the container once it has stopped?
+Enable this if you set a @code{name} to avoid blocking the name for the
+following run.")
+  (docker-args (list-of-strings '()) "Extra command-line arguments to pass to
+@code{docker run}.")
+  (docker-cli (package docker-cli) "The package containing the Docker
+executable to use."))
+
+(define (docker-container-shepherd-service config)
+  (match-record config <docker-container-configuration>
+                (image
+                 volumes
+                 name
+                 user
+                 environment-variables
+                 environment-files
+                 network-type
+                 read-only-root?
+                 remove-after-stop?
+                 docker-args
+                 docker-cli)
+
+    (let ((docker-run-args
+           `(,@(if read-only-root? '("--read-only") '())
+             ,@(if remove-after-stop? '("--rm") '())
+             "--network" ,network-type
+             ,@(if (maybe-value-set? name) `("--name" ,name) '())
+             ,@(if (maybe-value-set? user) `("--user" ,user) '())
+             ,@(append-map (cut list "--env-file" <>) environment-files)
+             ,@(append-map (cut list "-e" <>) environment-variables)
+             ,@(append-map
+                (match-lambda
+                  (((? string? host-path)
+                    (? string? container-path))
+                   `("-v" ,(string-append host-path ":" container-path)))
+                  (((? string? host-path)
+                    (? string? container-path)
+                    (? boolean? read-write?))
+                   `("-v" ,(string-append host-path ":" container-path ":"
+                                          (if read-write? "rw" "ro")))))
+                volumes))))
+
+      (shepherd-service
+       (provision (list (string->symbol
+                         (string-append "docker-container-" (maybe-value name image)))))
+       (requirement (if (string=? network-type "none") '() '(networking)))
+       (documentation (format #f "Run a Docker container called ~s from the image ~s."
+                              (maybe-value name) image))
+       (start #~(lambda ()
+                  (use-modules ((srfi srfi-1) #:select (every))
+                               ((srfi srfi-26) #:select (cut))
+                               (ice-9 popen)
+                               (ice-9 textual-ports))
+                  (let* ((hex (char-set #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9
+                                        #\a #\b #\c #\d #\e #\f #\A #\B #\C #\D #\E #\F))
+                         (pipe
+                          (open-pipe* OPEN_READ #$(file-append docker-cli "/bin/docker")
+                                      "run" "-d" #$@docker-run-args #$@docker-args #$image))
+                         (container-id
+                          (string-trim-both (get-string-all pipe) char-whitespace?)))
+                    (close-pipe pipe)
+                    ;; We expect a hexadecimal container ID from `docker run'.
+                    (and (every (cut char-set-contains? hex <>)
+                                (string->list container-id))
+                         container-id))))
+       ;; First arg is shepherd's "running value", i.e. whatever `start' returned.
+       (stop #~(lambda* (#:optional (container-id #$(maybe-value name #f)))
+                 (if (zero?
+                      (status:exit-val
+                       (system* #$(file-append docker-cli "/bin/docker") "stop" container-id)))
+                     #f  ; #f means the service stopped and can be restarted again.
+                     container-id)))))))
+
+(define (docker-container-shepherd-services configs)
+  (map docker-container-shepherd-service configs))
+
+(define docker-container-service-type
+  (service-type
+   (name 'docker-container)
+   (extensions
+    (list (service-extension shepherd-root-service-type docker-container-shepherd-services)))
+   (default-value '())
+   (compose concatenate)
+   (extend append)
+   (description "Run Docker containers under Shepherd.")))
diff --git a/tw/services/grafana.scm b/tw/services/grafana.scm
index a796ba19..2fdb9695 100644
--- a/tw/services/grafana.scm
+++ b/tw/services/grafana.scm
@@ -1,13 +1,12 @@
 (define-module (tw services grafana)
   #:use-module (gnu)
   #:use-module ((gnu packages admin) #:select (shadow))
-  #:use-module ((gnu packages docker) #:select (docker-cli))
   #:use-module (gnu services)
   #:use-module (gnu services configuration)
   #:use-module (gnu services databases)
-  #:use-module (gnu services shepherd)
   #:use-module (guix records)
   #:use-module (tw services web)
+  #:use-module (tw services docker)
   #:export (grafana-service-type
             grafana-configuration))
 
@@ -42,31 +41,36 @@ variables."))
          (home-directory (grafana-configuration-data-path config))
          (shell (file-append shadow "/sbin/nologin")))))
 
-(define (grafana-shepherd-service config)
-  (list (shepherd-service
-         (provision '(grafana))
-         (requirement '(networking))
-         (documentation "Run a Grafana instance using Docker.")
-         (start #~(make-forkexec-constructor
-                   ;; https://grafana.com/docs/grafana/latest/setup-grafana/installation/docker/
-                   (list #$(file-append docker-cli "/bin/docker") "run" "--rm" "--network=host"
-                         "--name" "grafana" "--user" '#$%grafana-user
-                         "-v" '#$(format #f "~a:/var/lib/grafana" (grafana-configuration-data-path config))
-                         "--env-file" '#$(grafana-configuration-metrics-credentials-file config)
-                         ;; https://grafana.com/docs/grafana/latest/setup-grafana/configure-docker/
-                         "-e" "GF_SERVER_PROTOCOL=http"  ; use Wireguard for encryption
-                         "-e" '#$(format #f "GF_SERVER_HTTP_ADDR=~a" (grafana-configuration-bind-address config))
-                         "-e" '#$(format #f "GF_SERVER_HTTP_PORT=~a" (grafana-configuration-host-port config))
-                         "-e" "GF_SERVER_ENABLE_GZIP=true"  ; recommended by docs
-                         "-e" "GF_ANALYTICS_REPORTING_ENABLED=false"
-                         "-e" "GF_ANALYTICS_CHECK_FOR_UPDATES=false"
-                         "-e" "GF_ANALYTICS_CHECK_FOR_PLUGIN_UPDATES=false"
-                         "-e" "GF_SNAPSHOTS_ENABLED=false"  ; disable publishing dashboard snapshots to the internet
-                         "-e" "GF_DATE_FORMATS_INTERVAL_HOUR=DD.MM. HH:mm"  ; use sensible date format
-                         "-e" "GF_DATE_FORMATS_INTERVAL_DAY=DD.MM."         ; use sensible date format
-                         ;; TODO: https://grafana.com/docs/grafana/latest/setup-grafana/configure-grafana/#smtp
-                         '#$(grafana-configuration-container config))))
-         (stop #~(make-kill-destructor)))))
+(define (grafana-environment config)
+  (match-record config <grafana-configuration> (bind-address host-port)
+    (mixed-text-file "grafana.env" "\
+# https://grafana.com/docs/grafana/latest/setup-grafana/configure-docker/
+GF_SERVER_PROTOCOL=http
+GF_SERVER_HTTP_ADDR=" bind-address "
+GF_SERVER_HTTP_PORT=" host-port "
+# gzip compression is recommended by docs, but is not the default
+GF_SERVER_ENABLE_GZIP=true
+GF_ANALYTICS_REPORTING_ENABLED=false
+GF_ANALYTICS_CHECK_FOR_UPDATES=false
+GF_ANALYTICS_CHECK_FOR_PLUGIN_UPDATES=false
+# disable publishing dashboard snapshots to the internet
+GF_SNAPSHOTS_ENABLED=false
+# use sensible date and time formats
+GF_DATE_FORMATS_INTERVAL_HOUR=DD.MM. HH:mm
+GF_DATE_FORMATS_INTERVAL_DAY=DD.MM.
+# TODO: https://grafana.com/docs/grafana/latest/setup-grafana/configure-grafana/#smtp
+")))
+
+(define (grafana-docker-service config)
+  (match-record config <grafana-configuration> (container data-path metrics-credentials-file)
+    (list (docker-container-configuration
+           (name "grafana")
+           (user %grafana-user)
+           (image container)
+           (volumes `((,data-path "/var/lib/grafana" #t)))
+           (environment-files
+            (list (grafana-environment config) metrics-credentials-file))
+           (network-type "host")))))
 
 (define (grafana-reverse-proxy config)
   (match-record config <grafana-configuration> (domain bind-address host-port)
@@ -83,7 +87,7 @@ variables."))
   (service-type
    (name 'grafana)
    (extensions
-    (list (service-extension shepherd-root-service-type grafana-shepherd-service)
+    (list (service-extension docker-container-service-type grafana-docker-service)
           (service-extension account-service-type grafana-accounts)
           (service-extension https-reverse-proxy-service-type grafana-reverse-proxy)))
    (default-value (grafana-configuration))