Add a couple of functions for PostgreSQL advisory locks

Use symbol-hash to convert a symbol to the number for the lock. I'm hoping
this is OK, and it seems to be stable.

1 files changed, 27 insertions, 1 deletions

diff --git a/guix-data-service/database.scm b/guix-data-service/database.scm
index acc6dea..140ea44 100644
--- a/guix-data-service/database.scm
+++ b/guix-data-service/database.scm
@@ -18,7 +18,10 @@
 (define-module (guix-data-service database)
   #:use-module (squee)
   #:export (with-postgresql-connection
-            with-postgresql-transaction))
+            with-postgresql-transaction
+
+            with-advisory-session-lock
+            obtain-advisory-transaction-lock))
 
 ;; TODO This isn't exported for some reason
 (define pg-conn-finish
@@ -54,3 +57,26 @@
         result))
     (lambda (key . args)
       (exec-query conn "ROLLBACK;"))))
+
+(define (with-advisory-session-lock conn lock f)
+  (let ((lock-number (number->string (symbol-hash lock))))
+    (exec-query conn
+                "SELECT pg_advisory_lock($1)"
+                (list lock-number))
+    (with-throw-handler #t
+      (lambda ()
+        (let ((result (f)))
+          (exec-query conn
+                      "SELECT pg_advisory_unlock($1)"
+                      (list lock-number))
+          result))
+      (lambda (key . args)
+        (exec-query conn
+                    "SELECT pg_advisory_unlock($1)"
+                    (list lock-number))))))
+
+(define (obtain-advisory-transaction-lock conn lock)
+  (let ((lock-number (number->string (symbol-hash lock))))
+    (exec-query conn
+                "SELECT pg_advisory_xact_lock($1)"
+                (list lock-number))))