feat(monitoring): observe database connection opening/closing

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

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