Associate a name with database connections

This helps when working out which connection to the database is doing what.

guix-data-service/database.scm

@@ -24,10 +24,12 @@
 (define pg-conn-finish
   (@@ (squee) pg-conn-finish))
 
-(define (with-postgresql-connection f)
+(define* (with-postgresql-connection name f)
   (define paramstring
-    (or (getenv "GUIX_DATA_SERVICE_DATABASE_PARAMSTRING")
-        "dbname=guix_data_service user=guix_data_service"))
+    (string-append
+     (or (getenv "GUIX_DATA_SERVICE_DATABASE_PARAMSTRING")
+         "dbname=guix_data_service user=guix_data_service")
+     " application_name='guix-data-service " name "'"))
 
   (let* ((conn (connect-to-postgres-paramstring paramstring)))
     (with-throw-handler

guix-data-service/jobs/load-new-guix-revision.scm

@@ -703,6 +703,7 @@ ORDER BY load_new_guix_revision_jobs.id DESC")
                      (lambda ()
                        (let ((result
                               (with-postgresql-connection
+                               (simple-format #f "load-new-guix-revision ~A logging" id)
                                (lambda (logging-conn)
                                  (insert-empty-log-entry logging-conn id)
                                  (let ((logging-port (log-port id logging-conn)))

guix-data-service/web/controller.scm

@@ -568,6 +568,7 @@
               #t
               (lambda ()
                 (with-postgresql-connection
+                 "web healthcheck"
                  (lambda (conn)
                    (number?
                     (string->number
@@ -585,6 +586,7 @@
                    500))))
     (_
      (with-postgresql-connection
+      "web"
       (lambda (conn)
         (controller-with-database-connection request
                                              method-and-path-components

scripts/guix-data-service-process-branch-updated-email.in

@@ -29,6 +29,7 @@
              (guix-data-service branch-updated-emails))
 
 (with-postgresql-connection
+ "process-branch-updated-email"
  (lambda (conn)
    (enqueue-job-for-email
     conn

scripts/guix-data-service-process-jobs.in

@@ -31,6 +31,7 @@
 (setvbuf (current-error-port) 'line)
 
 (with-postgresql-connection
+ "process-jobs"
  (lambda (conn)
    (simple-format #t "Ready to process jobs...\n")
    (process-jobs conn)))

scripts/guix-data-service-query-build-servers.in

@@ -25,4 +25,5 @@
              (squee)
              (guix-data-service builds))
 
-(with-postgresql-connection query-build-servers)
+(with-postgresql-connection "query-build-servers"
+                            query-build-servers)

tests/branch-updated-emails.scm

@@ -107,6 +107,7 @@ Summary of changes:
 (test-begin "test-branch-updated-emails")
 
 (with-postgresql-connection
+ "test-branch-updated-emails"
  (lambda (conn)
    (test-assert "enqueue-job-for-email works"
      (with-postgresql-transaction

tests/jobs-load-new-guix-revision.scm

@@ -12,6 +12,7 @@
 (test-begin "jobs-load-new-guix-revision")
 
 (with-postgresql-connection
+ "test-jobs-load-new-guix-revision"
  (lambda (conn)
    (test-equal "select-job-for-commit works"
      '()

tests/model-derivation.scm

@@ -6,6 +6,7 @@
 (test-begin "test-model-derivation")
 
 (with-postgresql-connection
+ "test-model-derivation"
  (lambda (conn)
    (test-equal "valid-systems"
      '()

tests/model-git-branch.scm

@@ -8,6 +8,7 @@
 (test-begin "test-model-git-branch")
 
 (with-postgresql-connection
+ "test-module-git-branch"
  (lambda (conn)
    (test-assert "insert-git-branch-entry works"
      (with-postgresql-transaction

tests/model-git-repository.scm

@@ -6,6 +6,7 @@
 (test-begin "test-model-git-repository")
 
 (with-postgresql-connection
+ "test-model-git-repository"
  (lambda (conn)
    (test-assert "returns an id for a non existent URL"
      (with-postgresql-transaction

tests/model-license-set.scm

@@ -25,6 +25,7 @@
         "https://example.com/why-license-2")))))
 
  (with-postgresql-connection
+  "test-model-license-set"
   (lambda (conn)
     (with-postgresql-transaction
      conn

tests/model-license.scm

@@ -23,6 +23,7 @@
         "https://example.com/why-license-2")))))
 
  (with-postgresql-connection
+  "test-model-license"
   (lambda (conn)
     (with-postgresql-transaction
      conn

tests/model-package-metadata.scm

@@ -37,6 +37,7 @@
                 (guix-data-service model package-metadata))
 
    (with-postgresql-connection
+    "test-model-package-metadata"
     (lambda (conn)
       (test-assert "inferior-packages->package-metadata-ids"
         (with-postgresql-transaction