branch master updated: Try to adapt the PostgreSQL paramstring to use with sqitch

[Christopher Baines]

This is an automated email from the git hooks/post-receive script.

cbaines pushed a commit to branch master
in repository data-service.

The following commit(s) were added to refs/heads/master by this push:
     new 0dc0598  Try to adapt the PostgreSQL paramstring to use with sqitch
0dc0598 is described below

commit 0dc05982cde052c985bb440dc026cbe3334ee50b
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Wed Jun 16 13:43:32 2021 +0100

    Try to adapt the PostgreSQL paramstring to use with sqitch
---
 guix-data-service/database.scm | 20 +++++++++++++++++++-
 scripts/guix-data-service.in   | 38 ++++++++++++++++++++++++++++----------
 2 files changed, 47 insertions(+), 11 deletions(-)

diff --git a/guix-data-service/database.scm b/guix-data-service/database.scm
index 546c678..1204bb4 100644
--- a/guix-data-service/database.scm
+++ b/guix-data-service/database.scm
@@ -21,7 +21,9 @@
   #:use-module (ice-9 threads)
   #:use-module (squee)
   #:use-module (guix-data-service config)
-  #:export (with-postgresql-connection
+  #:export (get-database-config
+
+            with-postgresql-connection
 
             with-postgresql-connection-per-thread
             with-thread-postgresql-connection
@@ -39,6 +41,22 @@
 (define pg-conn-finish
   (@@ (squee) pg-conn-finish))
 
+(define (paramstring->alist s)
+  (map
+   (lambda (param)
+     (match (string-split param #\=)
+       ((key val)
+        (cons key val))))
+   (string-split s #\space)))
+
+(define (get-database-config)
+  (let ((paramstring (getenv "GUIX_DATA_SERVICE_DATABASE_PARAMSTRING")))
+    (if paramstring
+        (paramstring->alist paramstring)
+        `(("dbname"   . ,(%config 'database-name))
+          ("user"     . ,(%config 'database-user))
+          ("host"     . ,(%config 'database-host))))))
+
 (define (open-postgresql-connection name statement-timeout)
   (define paramstring
     (string-append
diff --git a/scripts/guix-data-service.in b/scripts/guix-data-service.in
index ade3ca3..481e87d 100644
--- a/scripts/guix-data-service.in
+++ b/scripts/guix-data-service.in
@@ -141,18 +141,36 @@
            (list (%config 'sqitch)
                  "deploy"
                  "--db-client" (%config 'sqitch-psql)
-                 "--chdir" (dirname (%config 'sqitch-plan))
+                 "--chdir" (dirname (dirname (%config 'sqitch-plan)))
                  "--plan-file" (%config 'sqitch-plan)
-                 (string-append "db:pg://"
-                                (%config 'database-user)
-                                "@"
-                                (if (string=? (%config 'database-host)
-                                              "localhost")
-                                    ""  ; This means the unix socket
+                 (let* ((database-config (get-database-config))
+                        (params          (string-join
+                                          (map
+                                           (match-lambda
+                                             ((key . val)
+                                              (string-append key "=" val)))
+                                           (filter
+                                            (match-lambda
+                                              ((key . _)
+                                               (not (member key '("user"
+                                                                  "host"
+                                                                  "dbname")))))
+                                            database-config))
+                                          "&")))
+                   (string-append "db:pg://"
+                                  (assoc-ref database-config "user")
+                                  "@"
+                                  (if (string=? (assoc-ref database-config 
"host")
+                                                "localhost")
+                                      ""  ; This means the unix socket
                                         ; connection will be used
-                                    (%config 'database-host))
-                                "/"
-                                (%config 'database-name)))))
+                                      (assoc-ref database-config "host"))
+                                  "/"
+                                  (assoc-ref database-config "dbname")
+                                  (if (string-null? params)
+                                      ""
+                                      "?")
+                                  params)))))
       (simple-format #t "running command: ~A\n"
                      (string-join command))
       (unless (zero? (apply system* command))