feat: add metrics for used and created connections

cabal.project

@@ -2,3 +2,5 @@ packages: postgrest.cabal
 tests: true
 package *
   ghc-options: -split-sections
+packages:
+  /home/laurence/Projects/hasql-notifications

nix/overlays/haskell-packages.nix

@@ -57,21 +57,22 @@ let
           }
           { });
 
-      hasql-pool = lib.dontCheck prev.hasql-pool_1_0_1;
+      hasql-pool = lib.dontCheck (prev.callHackageDirect
+        {
+          pkg = "hasql-pool";
+          ver = "1.1";
+          sha256 = "sha256-TJZdUwsBo4pLLYydc8FgxYFI37Tj5K+E7idf4fQYEjU=";
+        }
+        { }
+      );
 
       postgresql-libpq = lib.dontCheck
         (prev.postgresql-libpq.override {
           postgresql = super.libpq;
         });
 
-      hasql-notifications = lib.dontCheck (prev.callHackageDirect
-        {
-          pkg = "hasql-notifications";
-          ver = "0.2.1.1";
-          sha256 = "sha256-oPhKA/pSQGJvgQyhsi7CVr9iDT7uWpKUz0iJfXsaxXo=";
-        }
-        { }
-      );
+      hasql-notifications = lib.dontCheck
+      (prev.callCabal2nixWithOptions "hasql-notifications" /home/laurence/Projects/hasql-notifications "--subpath=." {} );
 
     };
 in

postgrest.cabal

@@ -110,7 +110,7 @@ library
                     , hasql                     >= 1.6.1.1 && < 1.7
                     , hasql-dynamic-statements  >= 0.3.1 && < 0.4
                     , hasql-notifications       >= 0.2.1.1 && < 0.3
-                    , hasql-pool                >= 1.0.1 && < 1.1
+                    , hasql-pool                >= 1.0.1 && < 1.2
                     , hasql-transaction         >= 1.0.1 && < 1.1
                     , heredoc                   >= 0.2 && < 0.3
                     , http-types                >= 0.12.2 && < 0.13
@@ -256,7 +256,7 @@ test-suite spec
                     , bytestring        >= 0.10.8 && < 0.13
                     , case-insensitive  >= 1.2 && < 1.3
                     , containers        >= 0.5.7 && < 0.7
-                    , hasql-pool        >= 1.0.1 && < 1.1
+                    , hasql-pool        >= 1.0.1 && < 1.2
                     , hasql-transaction >= 1.0.1 && < 1.1
                     , heredoc           >= 0.2 && < 0.3
                     , hspec             >= 2.3 && < 2.12

src/PostgREST/Metrics.hs

@@ -14,29 +14,45 @@ import PostgREST.Observation
 
 import Protolude
 
-data MetricsState =
-  MetricsState Prom.Counter Prom.Gauge Prom.Gauge Prom.Gauge Prom.Counter Prom.Gauge
+data MetricsState = MetricsState
+  { msPoolTimeouts      :: Prom.Counter
+  , msPoolCreated       :: Prom.Counter
+  , msPoolAvailable     :: Prom.Gauge
+  , msPoolWaiting       :: Prom.Gauge
+  , msPoolUsed          :: Prom.Gauge
+  , msPoolMaxSize       :: Prom.Gauge
+  , msSchCacheLoads     :: Prom.Counter
+  , msSchCacheQueryTime :: Prom.Gauge
+  }
 
 init :: Int -> IO MetricsState
 init configDbPoolSize = do
   poolTimeouts <- Prom.register $ Prom.counter (Prom.Info "pgrst_db_pool_timeouts_total" "The total number of pool connection timeouts")
+  poolCreated <- Prom.register $ Prom.counter (Prom.Info "pgrst_db_pool_created" "The total number of created pool connections")
   poolAvailable <- Prom.register $ Prom.gauge (Prom.Info "pgrst_db_pool_available" "Available connections in the pool")
   poolWaiting <- Prom.register $ Prom.gauge (Prom.Info "pgrst_db_pool_waiting" "Requests waiting to acquire a pool connection")
+  poolUsed <- Prom.register $ Prom.gauge (Prom.Info "pgrst_db_pool_used" "Used connections in the pool")
   poolMaxSize <- Prom.register $ Prom.gauge (Prom.Info "pgrst_db_pool_max" "Max pool connections")
   schemaCacheLoads <- Prom.register $ Prom.counter (Prom.Info "pgrst_schema_cache_loads_total" "The total number of times the schema cache was loaded")
   schemaCacheQueryTime <- Prom.register $ Prom.gauge (Prom.Info "pgrst_schema_cache_query_time_seconds" "The query time in seconds of the last schema cache load")
   Prom.setGauge poolMaxSize (fromIntegral configDbPoolSize)
-  pure $ MetricsState poolTimeouts poolAvailable poolWaiting poolMaxSize schemaCacheLoads schemaCacheQueryTime
+  pure $ MetricsState poolTimeouts poolCreated poolAvailable poolWaiting poolUsed poolMaxSize schemaCacheLoads schemaCacheQueryTime
 
 observationMetrics :: MetricsState -> ObservationHandler
-observationMetrics (MetricsState poolTimeouts poolAvailable poolWaiting _ schemaCacheLoads schemaCacheQueryTime) obs = case obs of
+observationMetrics (MetricsState poolTimeouts poolCreated poolAvailable poolWaiting poolUsed _ schemaCacheLoads schemaCacheQueryTime) obs = case obs of
   (PoolAcqTimeoutObs _) -> do
     Prom.incCounter poolTimeouts
   (HasqlPoolObs (SQL.ConnectionObservation _ status)) -> case status of
-     SQL.ReadyForUseConnectionStatus  -> do
-      Prom.incGauge poolAvailable
+     SQL.ReadyForUseConnectionStatus reason -> case reason of
+      SQL.EstablishedConnectionReadyForUseReason -> do
+        Prom.incCounter poolCreated
+        Prom.incGauge poolAvailable
+      _ -> do
+        Prom.decGauge poolUsed
+        Prom.incGauge poolAvailable
      SQL.InUseConnectionStatus        -> do
       Prom.decGauge poolAvailable
+      Prom.incGauge poolUsed
      SQL.TerminatedConnectionStatus  _ -> do
       Prom.decGauge poolAvailable
      SQL.ConnectingConnectionStatus -> pure ()

src/PostgREST/Observation.hs

@@ -118,14 +118,15 @@ observationMessage = \case
   HasqlPoolObs (SQL.ConnectionObservation uuid status) ->
     "Connection " <> show uuid <> (
       case status of
-        SQL.ConnectingConnectionStatus   -> " is being established"
-        SQL.ReadyForUseConnectionStatus  -> " is available"
-        SQL.InUseConnectionStatus        -> " is used"
+        SQL.ConnectingConnectionStatus    -> " is being established"
+        SQL.ReadyForUseConnectionStatus _ -> " is available"
+        SQL.InUseConnectionStatus         -> " is used"
         SQL.TerminatedConnectionStatus reason -> " is terminated due to " <> case reason of
           SQL.AgingConnectionTerminationReason          -> "max lifetime"
           SQL.IdlenessConnectionTerminationReason       -> "max idletime"
           SQL.ReleaseConnectionTerminationReason        -> "release"
           SQL.NetworkErrorConnectionTerminationReason _ -> "network error" -- usage error is already logged, no need to repeat the same message.
+          SQL.InitializationErrorTerminationReason _    -> "session initialization error"
     )
   _ -> mempty
   where

stack.yaml

@@ -12,7 +12,7 @@ nix:
 extra-deps:
   - configurator-pg-0.2.7
   - fuzzyset-0.2.4
-  - hasql-notifications-0.2.1.1
-  - hasql-pool-1.0.1
+  - /home/laurence/Projects/hasql-notifications
+  - hasql-pool-1.1
   - megaparsec-9.2.2
   - postgresql-libpq-0.10.0.0

stack.yaml.lock

@@ -19,19 +19,12 @@ packages:
   original:
     hackage: fuzzyset-0.2.4
 - completed:
-    hackage: hasql-notifications-0.2.1.1@sha256:e4f41f462e96f3af3f088b747daeeb2275ceaebd0e4b0d05187bd10d329afada,2021
+    hackage: hasql-pool-1.1@sha256:409cd9e35cf28bcfe591964d992e4f2cf9a1b0ecab88a459a3c9e3e9868961a9,2368
     pantry-tree:
-      sha256: f9041b1c242436324372f6be9a4f2e5cf70203c3efad36a4e9ea4cca5113a2ec
-      size: 452
+      sha256: 8c1a592b8d8e22f79e3ae051eb3fc7c5c4712c3060bc6f5e867316001bfe5432
+      size: 888
   original:
-    hackage: hasql-notifications-0.2.1.1
-- completed:
-    hackage: hasql-pool-1.0.1@sha256:3cfb4c7153a6c536ac7e126c17723e6d26ee03794954deed2d72bcc826d05a40,2302
-    pantry-tree:
-      sha256: d98e1269bdd60989b0eb0b84e1d5357eaa9f92821439d9f206663b7251ee95b2
-      size: 799
-  original:
-    hackage: hasql-pool-1.0.1
+    hackage: hasql-pool-1.1
 - completed:
     hackage: megaparsec-9.2.2@sha256:c306a135ec25d91d252032c6128f03598a00e87ea12fcf5fc4878fdffc75c768,3219
     pantry-tree: