services: postgresql: Add postgresql-role-service-type.

* gnu/services/databases.scm (postgresql-role,
postgresql-role?, postgresql-role-name,
postgresql-role-permissions, postgresql-role-create-database?,
postgresql-role-configuration, postgresql-role-configuration?,
postgresql-role-configuration-host, postgresql-role-configuration-roles,
postgresql-role-service-type): New procedures.
* gnu/tests/databases.scm: Test it.
* doc/guix.texi: Document it.

2 files changed, 145 insertions, 1 deletions

diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm
index 0d60616156..c11898693f 100644
--- a/gnu/services/databases.scm
+++ b/gnu/services/databases.scm
@@ -58,6 +58,18 @@
             postgresql-service
             postgresql-service-type
 
+            postgresql-role
+            postgresql-role?
+            postgresql-role-name
+            postgresql-role-permissions
+            postgresql-role-create-database?
+            postgresql-role-configuration
+            postgresql-role-configuration?
+            postgresql-role-configuration-host
+            postgresql-role-configuration-roles
+
+            postgresql-role-service-type
+
             memcached-service-type
             memcached-configuration
             memcached-configuration?
@@ -343,6 +355,96 @@ and stores the database cluster in @var{data-directory}."
             (data-directory data-directory)
             (extension-packages extension-packages))))
 
+(define-record-type* <postgresql-role>
+  postgresql-role make-postgresql-role
+  postgresql-role?
+  (name             postgresql-role-name) ;string
+  (permissions      postgresql-role-permissions
+                    (default '(createdb login))) ;list
+  (create-database? postgresql-role-create-database?  ;boolean
+                    (default #f)))
+
+(define-record-type* <postgresql-role-configuration>
+  postgresql-role-configuration make-postgresql-role-configuration
+  postgresql-role-configuration?
+  (host             postgresql-role-configuration-host ;string
+                    (default "/var/run/postgresql"))
+  (log              postgresql-role-configuration-log ;string
+                    (default "/var/log/postgresql_roles.log"))
+  (roles            postgresql-role-configuration-roles
+                    (default '()))) ;list
+
+(define (postgresql-create-roles config)
+  ;; See: https://www.postgresql.org/docs/current/sql-createrole.html for the
+  ;; complete permissions list.
+  (define (format-permissions permissions)
+    (let ((dict '(bypassrls createdb createrole login replication superuser)))
+      (string-join (filter-map (lambda (permission)
+                                 (and (member permission dict)
+                                      (string-upcase
+                                       (symbol->string permission))))
+                               permissions)
+                   " ")))
+
+  (define (roles->queries roles)
+    (apply mixed-text-file "queries"
+           (append-map
+            (lambda (role)
+              (match-record role <postgresql-role>
+                (name permissions create-database?)
+                `("SELECT NOT(EXISTS(SELECT 1 FROM pg_catalog.pg_roles WHERE \
+rolname = '" ,name "')) as not_exists;\n"
+"\\gset\n"
+"\\if :not_exists\n"
+"CREATE ROLE " ,name
+" WITH " ,(format-permissions permissions)
+";\n"
+,@(if create-database?
+      `("CREATE DATABASE " ,name
+        " OWNER " ,name ";\n")
+      '())
+"\\endif\n")))
+            roles)))
+
+  (let ((host (postgresql-role-configuration-host config))
+        (roles (postgresql-role-configuration-roles config)))
+    (program-file
+     "postgresql-create-roles"
+     #~(begin
+         (let ((psql #$(file-append postgresql "/bin/psql")))
+           (execl psql psql "-a"
+                  "-h" #$host
+                  "-f" #$(roles->queries roles)))))))
+
+(define (postgresql-role-shepherd-service config)
+  (match-record config <postgresql-role-configuration>
+    (log)
+    (list (shepherd-service
+           (requirement '(postgres))
+           (provision '(postgres-roles))
+           (one-shot? #t)
+           (start #~(make-forkexec-constructor
+                     (list #$(postgresql-create-roles config))
+                     #:user "postgres" #:group "postgres"
+                     #:log-file #$log))
+           (documentation "Create PostgreSQL roles.")))))
+
+(define postgresql-role-service-type
+  (service-type (name 'postgresql-role)
+                (extensions
+                 (list (service-extension shepherd-root-service-type
+                                          postgresql-role-shepherd-service)))
+                (compose concatenate)
+                (extend (lambda (config extended-roles)
+                          (match-record config <postgresql-role-configuration>
+                            (host roles)
+                            (postgresql-role-configuration
+                             (host host)
+                             (roles (append roles extended-roles))))))
+                (default-value (postgresql-role-configuration))
+                (description "Ensure the specified PostgreSQL roles are
+created after the PostgreSQL database is started.")))
+
 
 ;;;
 ;;; Memcached
diff --git a/gnu/tests/databases.scm b/gnu/tests/databases.scm
index d881a8c3ee..e831d69f5a 100644
--- a/gnu/tests/databases.scm
+++ b/gnu/tests/databases.scm
@@ -217,6 +217,9 @@
 (define %postgresql-log-directory
   "/var/log/postgresql")
 
+(define %role-log-file
+  "/var/log/postgresql_roles.log")
+
 (define %postgresql-os
   (simple-operating-system
    (service postgresql-service-type
@@ -229,7 +232,13 @@
                   ("random_page_cost" 2)
                   ("auto_explain.log_min_duration" "100 ms")
                   ("work_mem" "500 MB")
-                  ("debug_print_plan" #t)))))))))
+                  ("debug_print_plan" #t)))))))
+   (service postgresql-role-service-type
+            (postgresql-role-configuration
+             (roles
+              (list (postgresql-role
+                     (name "root")
+                     (create-database? #t))))))))
 
 (define (run-postgresql-test)
   "Run tests in %POSTGRESQL-OS."
@@ -282,6 +291,39 @@
                   #t))
              marionette))
 
+          (test-assert "database ready"
+            (begin
+              (marionette-eval
+               '(begin
+                  (let loop ((i 10))
+                    (unless (or (zero? i)
+                                (and (file-exists? #$%role-log-file)
+                                     (string-contains
+                                      (call-with-input-file #$%role-log-file
+                                        get-string-all)
+                                      ";\nCREATE DATABASE")))
+                      (sleep 1)
+                      (loop (- i 1)))))
+               marionette)))
+
+          (test-assert "database creation"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd)
+                             (ice-9 popen))
+                (current-output-port
+                 (open-file "/dev/console" "w0"))
+                (let* ((port (open-pipe*
+                              OPEN_READ
+                              #$(file-append postgresql "/bin/psql")
+                              "-tAh" "/var/run/postgresql"
+                              "-c" "SELECT 1 FROM pg_database WHERE
+ datname='root'"))
+                       (output (get-string-all port)))
+                  (close-pipe port)
+                  (string-contains output "1")))
+             marionette))
+
           (test-end)
           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))