unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Christopher Baines <mail@cbaines.net>
To: Mathieu Othacehe <othacehe@gnu.org>
Cc: 45860@debbugs.gnu.org
Subject: [bug#45860] [PATCH v2 5/5] services: postgresql: Add postgresql-role-service-type.
Date: Wed, 27 Jan 2021 08:48:53 +0000	[thread overview]
Message-ID: <87eei6hiiy.fsf@cbaines.net> (raw)
In-Reply-To: <20210118101628.202607-6-othacehe@gnu.org>

[-- Attachment #1: Type: text/plain, Size: 7507 bytes --]


Mathieu Othacehe <othacehe@gnu.org> writes:

> * 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}.

Why only support these two permissions/options? Accepting strings or
symbols, and then just converting to an upper case string would allow
all the permission options to be specified.

> +@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.")))))

I'm guessing this service will fail if it's run twice, as the
role/database will already exist?

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 987 bytes --]

  reply	other threads:[~2021-01-27  8:49 UTC|newest]

Thread overview: 14+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-01-14 13:36 [bug#45860] Improve PostgreSQL service Mathieu Othacehe
2021-01-14 21:56 ` Christopher Baines
2021-01-15  8:56   ` Mathieu Othacehe
2021-01-16 11:44     ` Christopher Baines
2021-01-18 10:16 ` [bug#45860] [PATCH v2 0/5] services: postgresql: Improve service Mathieu Othacehe
2021-01-18 10:16   ` [bug#45860] [PATCH v2 1/5] services: postgresql: Use Guile datatypes Mathieu Othacehe
2021-01-18 10:16   ` [bug#45860] [PATCH v2 2/5] services: postgresql: Add socket directory support Mathieu Othacehe
2021-01-27  8:35     ` Christopher Baines
2021-01-28 12:04       ` Mathieu Othacehe
2021-01-18 10:16   ` [bug#45860] [PATCH v2 3/5] services: postgresql: Add log " Mathieu Othacehe
2021-01-18 10:16   ` [bug#45860] [PATCH v2 4/5] services: postgresql: Wrap long lines Mathieu Othacehe
2021-01-18 10:16   ` [bug#45860] [PATCH v2 5/5] services: postgresql: Add postgresql-role-service-type Mathieu Othacehe
2021-01-27  8:48     ` Christopher Baines [this message]
2021-01-28 12:05       ` bug#45860: " Mathieu Othacehe

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87eei6hiiy.fsf@cbaines.net \
    --to=mail@cbaines.net \
    --cc=45860@debbugs.gnu.org \
    --cc=othacehe@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).