[bug#45860] [PATCH v2 5/5] services: postgresql: Add postgresql-role-service-type.

[Mathieu Othacehe]

* 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.
---
 doc/guix.texi              | 61 ++++++++++++++++++++++++
 gnu/services/databases.scm | 95 ++++++++++++++++++++++++++++++++++++++
 gnu/tests/databases.scm    | 44 +++++++++++++++++-
 3 files changed, 199 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 22674e2804..13d95b36d1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -19427,6 +19427,67 @@ here}.
 @end table
 @end deftp
 
+@deffn {Scheme Variable} postgresql-role-service-type
+This service allows to create PostgreSQL roles and databases after
+PostgreSQL service start.  Here is an example of its use.
+
+@lisp
+(service postgresql-role-service-type
+            (postgresql-role-configuration
+             (roles
+              (list (postgresql-role
+                     (name "test")
+                     (create-database? #t))))))
+@end lisp
+
+This service can be extended with extra roles, as in this
+example:
+
+@lisp
+(service-extension postgresql-role-service-type
+                   (const (postgresql-role
+                           (name "alice")
+                           (create-database? #t))))
+@end lisp
+@end deffn
+
+@deftp {Data Type} postgresql-role
+PostgreSQL manages database access permissions using the concept of
+roles.  A role can be thought of as either a database user, or a group
+of database users, depending on how the role is set up.  Roles can own
+database objects (for example, tables) and can assign privileges on
+those objects to other roles to control who has access to which objects.
+
+@table @asis
+@item @code{name}
+The role name.
+
+@item @code{permissions} (default: @code{'(createdb login)})
+The role permissions list.  Supported permissions are @code{createdb}
+and @code{login}.
+
+@item @code{create-database?} (default: @code{#f})
+Whether to create a database with the same name as the role.
+
+@end table
+@end deftp
+
+@deftp {Data Type} postgresql-role-configuration
+Data type representing the configuration of
+@var{postgresql-role-service-type}.
+
+@table @asis
+@item @code{host} (default: @code{"/var/run/postgresql"})
+The PostgreSQL host to connect to.
+
+@item @code{log} (default: @code{"/var/log/postgresql_roles.log"})
+File name of the log file.
+
+@item @code{roles} (default: @code{'()})
+The initial PostgreSQL roles to create.
+@end table
+@end deftp
+
 @subsubheading MariaDB/MySQL
 
 @defvr {Scheme Variable} mysql-service-type
diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm
index 0d60616156..88e4b1813a 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,89 @@ 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 '((createdb . "CREATEDB")
+                  (login    . "LOGIN"))))
+      (string-join (map (lambda (permission)
+                          (assq-ref dict permission))
+                        permissions)
+                   " ")))
+
+  (define (roles->queries roles)
+    (apply mixed-text-file "queries"
+           (append-map (lambda (role)
+                         (match-record role <postgresql-role>
+                           (name permissions create-database?)
+                           `("CREATE ROLE " ,name
+                             " WITH " ,(format-permissions permissions)
+                             ";\n"
+                             ,@(if create-database?
+                                   `("CREATE DATABASE " ,name
+                                     " OWNER " ,name ";\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)))))
 
-- 
2.29.2