From d801a2f84ae42862dfc357a58ee47dd6dc39eef8 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Tue, 23 Feb 2021 20:33:05 +0100
Subject: [PATCH] feat(monitoring): observe database connection opening/closing

---
 src/Application.hs   |  2 ++
 src/Utils/Metrics.hs | 17 +++++++++++++++++
 2 files changed, 19 insertions(+)

diff --git a/src/Application.hs b/src/Application.hs
index d32a05f0e..0fde61416 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -249,11 +249,13 @@ makeFoundation appSettings''@AppSettings{..} = do
               $logDebugS "SqlPool" "Opening connection..."
               conn <- liftIO . PG.connectPostgreSQL $ pgConnStr appDatabaseConf
               backend <- liftIO $ openSimpleConn logFunc conn
+              observeDatabaseConnectionOpened
               $logInfoS "SqlPool" "Opened connection"
               return backend
             destroy conn = do
               $logDebugS "SqlPool" "Closing connection..."
               liftIO $ connClose conn
+              observeDatabaseConnectionClosed
               $logInfoS "SqlPool" "Closed connection"
          in Custom.createPool (liftIO . flip runLoggingT logFunc) create destroy (Just . fromIntegral $ pgPoolIdleTimeout appDatabaseConf) (Just $ pgPoolSize appDatabaseConf)
       let sqlPool :: forall m. MonadIO m => Custom.Pool m SqlBackend
diff --git a/src/Utils/Metrics.hs b/src/Utils/Metrics.hs
index 738be7aaf..40024e23e 100644
--- a/src/Utils/Metrics.hs
+++ b/src/Utils/Metrics.hs
@@ -22,6 +22,7 @@ module Utils.Metrics
   , InjectInhibitMetrics, injectInhibitMetrics
   , PoolMetrics, PoolLabel(..)
   , poolMetrics
+  , observeDatabaseConnectionOpened, observeDatabaseConnectionClosed
   ) where
 
 import Import.NoModel hiding (Vector, Info)
@@ -218,6 +219,18 @@ rechunkedFilesBytes = unsafeRegister $ counter info
   where info = Info "uni2work_rechunked_files_bytes"
                     "Size of files rechunked within database"
 
+{-# NOINLINE databaseConnectionsOpened #-}
+databaseConnectionsOpened :: Counter
+databaseConnectionsOpened = unsafeRegister $ counter info
+  where info = Info "uni2work_database_connections_opened"
+                    "Number of new connections to database opened"
+
+{-# NOINLINE databaseConnectionsClosed #-}
+databaseConnectionsClosed :: Counter
+databaseConnectionsClosed = unsafeRegister $ counter info
+  where info = Info "uni2work_database_connections_closed"
+                    "Number of connections to database closed"
+
 data JobWorkerQueueDepth = MkJobWorkerQueueDepth
 
 jobWorkerQueueDepth :: TMVar JobState -> Metric JobWorkerQueueDepth
@@ -515,3 +528,7 @@ registerJobWorkerQueueDepth = liftIO . void . register . jobWorkerQueueDepth
 
 observeMissingFiles :: MonadIO m => Text -> Int -> m ()
 observeMissingFiles refIdent = liftIO . withLabel missingFiles refIdent . flip setGauge . fromIntegral
+
+observeDatabaseConnectionOpened, observeDatabaseConnectionClosed :: MonadIO m => m ()
+observeDatabaseConnectionOpened = liftIO $ incCounter databaseConnectionsOpened
+observeDatabaseConnectionClosed = liftIO $ incCounter databaseConnectionsClosed