freckle-app 1.12.0.0 → 1.12.0.1

raw patch · 5 files changed

+86/−19 lines, 5 files

Files

• CHANGELOG.md +6/−1
• freckle-app.cabal +1/−1
• library/Freckle/App/Database.hs +35/−4
• library/Freckle/App/Stats.hs +43/−12
• package.yaml +1/−1

@@ -1,4 +1,9 @@-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.12.0.0...main)+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.12.0.1...main)++## [v1.12.0.1](https://github.com/freckle/freckle-app/compare/v1.12.0.0...v1.12.0.1)++- Change how `active_pool_connections` metric is calculated.+- Add `queries_enqueued_and_processing` metric.  ## [v1.12.0.0](https://github.com/freckle/freckle-app/compare/v1.11.0.0...v1.12.0.0) 

@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               freckle-app-version:            1.12.0.0+version:            1.12.0.1 license:            MIT license-file:       LICENSE maintainer:         Freckle Education

@@ -56,6 +56,7 @@   , runSqlPoolWithExtensibleHooks   ) import Database.Persist.SqlBackend.SqlPoolHooks+import Database.Persist.SqlBackend.Internal.SqlPoolHooks(SqlPoolHooks(..)) import Database.PostgreSQL.Simple   ( Connection   , Only (..)@@ -137,11 +138,41 @@   -> m a runDB action = do   pool <- asks getSqlPool-  Stats.withGauge Stats.dbConnections $+  gauge <- Stats.lookupGauge Stats.dbConnections+  let+    hooks = setAlterBackend defaultSqlPoolHooks $ wrapSqlBackend mempty+    -- Setting the SqlPoolHooks for metrics collection:+    -- You may be wondering if this code contains a "double-decrement" bug, because+    -- perhaps when an exception occurs, both runAfter and runOnException are+    -- executed. The documentation isn't terribly clear to me on this point, but+    -- notice:+    -- https://hackage.haskell.org/package/persistent-2.14.6.0/docs/Database-Persist-SqlBackend-Internal-SqlPoolHooks.html#t:SqlPoolHooks+    -- especially this part regarding runOnException:+    -- > This action is performed when an exception is received. The exception is+    -- > provided as a convenience - it is rethrown once this cleanup function is+    -- > complete.+    -- Given that the exception is rethrown, then then typical runAfter handler+    -- is very likely to not run. Looking at the code to validate:+    -- https://hackage.haskell.org/package/persistent-2.14.6.0/docs/src/Database.Persist.Sql.Run.html#runSqlPoolWithExtensibleHooks+    -- we can see that this is indeed how the code operates today -- the+    -- exception is rethrown, and there aren't any other spots where other code+    -- might catch the exception that we need to worry about, so in the case of+    -- an exception, runAfter would not be executed.+    -- So, this appears to be the intended interpretation.+    hooks' = hooks+      { runBefore = \conn mi -> do+          Stats.incGauge gauge+          runBefore hooks conn mi+      , runAfter = \conn mi -> do+          Stats.decGauge gauge+          runAfter hooks conn mi+      , runOnException = \conn mi e -> do+          Stats.decGauge gauge+          runOnException hooks conn mi e+      }+  Stats.withGauge Stats.dbEnqueuedAndProcessing $     inSpan "runDB" clientSpanArguments $-      runSqlPoolWithExtensibleHooks action pool Nothing $-        setAlterBackend defaultSqlPoolHooks $-          wrapSqlBackend mempty+      runSqlPoolWithExtensibleHooks action pool Nothing hooks'  runDBSimple   :: (HasSqlPool app, MonadUnliftIO m, MonadReader app m)

@@ -17,7 +17,11 @@   , Gauges   , Gauge   , dbConnections+  , dbEnqueuedAndProcessing   , withGauge+  , lookupGauge+  , incGauge+  , decGauge      -- * Reporting   , tagged@@ -93,9 +97,11 @@       ]       <> tags -newtype Gauges = Gauges+data Gauges = Gauges   { gdbConnections :: Gauge   -- ^ Track open db connections+  , gdbEnqueuedAndProcessing :: Gauge+  -- ^ Track enqueued and processing queries   }  data Gauge = Gauge@@ -106,6 +112,9 @@ dbConnections :: Gauges -> Gauge dbConnections = gdbConnections +dbEnqueuedAndProcessing :: Gauges -> Gauge+dbEnqueuedAndProcessing = gdbEnqueuedAndProcessing+ data StatsClient = StatsClient   { scClient :: Datadog.StatsClient   , scTags :: [(Text, Text)]@@ -135,6 +144,7 @@ withStatsClient StatsSettings {..} f = do   gauges <- liftIO $ do     gdbConnections <- Gauge "active_pool_connections" <$> EKG.new+    gdbEnqueuedAndProcessing <- Gauge "queries_enqueued_and_processing" <$> EKG.new     pure Gauges {..}    if amsEnabled@@ -165,20 +175,41 @@   -> m a   -> m a withGauge getGauge f = do-  gauge' <- view $ statsClientL . gaugesL . to getGauge+  gauge' <- lookupGauge getGauge   bracket_ (inc gauge') (dec gauge') f- where-  inc g@Gauge {..} = do-    liftIO $ EKG.inc gGauge-    publish g+  where+    inc = incGauge+    dec = decGauge -  dec g@Gauge {..} = do-    liftIO $ EKG.dec gGauge-    publish g+lookupGauge+  :: (MonadReader app m, HasStatsClient app)+  => (Gauges -> Gauge)+  -> m Gauge+lookupGauge accessor = view $ statsClientL . gaugesL . to accessor -  publish Gauge {..} = do-    n <- liftIO $ EKG.read gGauge-    gauge gName $ fromIntegral n+incGauge+  :: (MonadReader app m, HasStatsClient app, MonadUnliftIO m)+  => Gauge+  -> m ()+incGauge g@Gauge {..} = do+  liftIO $ EKG.inc gGauge+  publishGauge g++decGauge+  :: (MonadReader app m, HasStatsClient app, MonadUnliftIO m)+  => Gauge+  -> m ()+decGauge g@Gauge {..} = do+  liftIO $ EKG.dec gGauge+  publishGauge g++publishGauge+  :: (MonadReader app m, HasStatsClient app, MonadUnliftIO m)+  => Gauge+  -> m ()+publishGauge Gauge {..} = do+  n <- liftIO $ EKG.read gGauge+  gauge gName $ fromIntegral n  -- | Include the given tags on all metrics emitted from a block tagged

@@ -1,5 +1,5 @@ name: freckle-app-version: 1.12.0.0+version: 1.12.0.1 maintainer: Freckle Education category: Utils github: freckle/freckle-app