freckle-app 1.6.0.3 → 1.7.0.0

raw patch · 6 files changed

+97/−73 lines, 6 filesdep +aws-xray-client-persistentdep +aws-xray-client-waiPVP ok

version bump matches the API change (PVP)

Dependencies added: aws-xray-client-persistent, aws-xray-client-wai

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−1
• freckle-app.cabal +3/−2
• library/Freckle/App/Database.hs +44/−2
• library/Freckle/App/Stats.hs +39/−4
• library/Freckle/App/Stats/Gauge.hs +0/−63
• package.yaml +3/−1

@@ -1,4 +1,11 @@-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.6.0.3...main)+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.7.0.0...main)++## [v1.7.0.0](https://github.com/freckle/freckle-app/compare/v1.6.0.3...v1.7.0.0)++- Add XRay and EKG support to freckle-app's runDB.++  This involves an breaking change in `runDB`'s constraints, thus the major version+  bump.  ## [v1.6.0.3](https://github.com/freckle/freckle-app/compare/v1.6.0.2...v1.6.0.3) 

@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               freckle-app-version:            1.6.0.3+version:            1.7.0.0 license:            MIT license-file:       LICENSE maintainer:         Freckle Education@@ -43,7 +43,6 @@         Freckle.App.Prelude         Freckle.App.Scientist         Freckle.App.Stats-        Freckle.App.Stats.Gauge         Freckle.App.Stats.Rts         Freckle.App.Test         Freckle.App.Test.DocTest@@ -74,6 +73,8 @@         Glob >=0.9.3,         MonadRandom >=0.5.1.1,         aeson >=1.5.2.0,+        aws-xray-client-persistent >=0.1.0.5,+        aws-xray-client-wai >=0.1.0.2,         base >=4.11.1.0 && <5,         bugsnag >=1.0.0.1,         bytestring >=0.10.8.2,

@@ -37,17 +37,23 @@   , createPostgresqlPoolModified   , createSqlPool   , openSimpleConn+  , runSqlConn   , runSqlPool   ) import Database.PostgreSQL.Simple   (Connection, Only(..), connectPostgreSQL, execute) import Database.PostgreSQL.Simple.SqlQQ (sql) import qualified Freckle.App.Env as Env+import Freckle.App.Stats (HasStatsClient)+import qualified Freckle.App.Stats as Stats+import Network.AWS.XRayClient.Persistent+import Network.AWS.XRayClient.WAI import qualified Prelude as Unsafe (read) import System.Process.Typed (proc, readProcessStdout_) import UnliftIO.Concurrent (threadDelay) import UnliftIO.Exception (displayException) import UnliftIO.IORef+import Yesod.Core (MonadHandler, MonadUnliftIO(withRunInIO), waiRequest)  type SqlPool = Pool SqlBackend @@ -65,12 +71,48 @@   makePostgresPoolWith conf  runDB-  :: (HasSqlPool app, MonadUnliftIO m, MonadReader app m)+  :: ( HasSqlPool app+     , HasStatsClient app+     , MonadHandler m+     , MonadUnliftIO m+     , MonadReader app m+     )   => SqlPersistT m a   -> m a runDB action = do   pool <- asks getSqlPool-  runSqlPool action pool+  mVaultData <- vaultDataFromRequest <$> waiRequest+  Stats.withGauge Stats.dbConnections $+    maybe+      runSqlPool+      (runSqlPoolXRay "runDB")+      mVaultData+      action+      pool++-- | @'runSqlPool'@ but with XRay tracing+runSqlPoolXRay+  :: (backend ~ SqlBackend, MonadUnliftIO m)+  => Text+  -- ^ Subsegment name+  --+  -- The top-level subsegment will be named @\"<this> runSqlPool\"@ and the,+  -- with a lower-level subsegment named @\"<this> query\"@.+  --+  -> XRayVaultData -- ^ Vault data to trace with+  -> ReaderT backend m a+  -> Pool backend+  -> m a+runSqlPoolXRay name vaultData action pool =+  traceXRaySubsegment' vaultData (name <> " runSqlPool") id+    $ withRunInIO+    $ \run -> withResource pool $ \backend -> do+        let+          sendTrace = atomicallyAddVaultDataSubsegment vaultData+          stdGenIORef = xrayVaultDataStdGen vaultData+          subsegmentName = name <> " query"+        run . runSqlConn action =<< liftIO+          (xraySqlBackend sendTrace stdGenIORef subsegmentName backend)  data PostgresConnectionConf = PostgresConnectionConf   { pccHost :: String

@@ -16,6 +16,12 @@   , withStatsClient   , HasStatsClient(..) +  -- * Gauges+  , Gauges+  , GaugeName+  , dbConnections+  , withGauge+   -- * Reporting   , tagged   , increment@@ -29,7 +35,7 @@ import Freckle.App.Prelude  import Blammo.Logging-import Control.Lens (Lens', lens, view, (&), (.~), (<>~))+import Control.Lens (Lens', lens, to, view, (&), (.~), (<>~)) import Control.Monad.Reader (local) import Data.Aeson (Value(..)) import Data.String@@ -37,6 +43,8 @@ import Freckle.App.Ecs import qualified Freckle.App.Env as Env import qualified Network.StatsD.Datadog as Datadog+import qualified System.Metrics.Gauge as EKG+import UnliftIO.Exception (bracket_) import Yesod.Core.Lens import Yesod.Core.Types (HandlerData) @@ -85,14 +93,32 @@         ]       <> tags +-- should be data but newtype for now because there's only one and only one planned+newtype Gauges = Gauges+  { gdbConnections :: EKG.Gauge+  -- ^ Track open db connections+  }++-- Opaque wrapper to hide EKG.Gauge+newtype GaugeName = GaugeName+  { unGaugeName :: Gauges -> EKG.Gauge+  }++dbConnections :: GaugeName+dbConnections = GaugeName gdbConnections+ data StatsClient = StatsClient   { scClient :: Datadog.StatsClient   , scTags :: [(Text, Text)]+  , scGauges :: Gauges   }  tagsL :: Lens' StatsClient [(Text, Text)] tagsL = lens scTags $ \x y -> x { scTags = y } +gaugesL :: Lens' StatsClient Gauges+gaugesL = lens scGauges $ \x y -> x { scGauges = y }+ class HasStatsClient env where   statsClientL :: Lens' env StatsClient @@ -108,16 +134,25 @@   -> (StatsClient -> m a)   -> m a withStatsClient StatsSettings {..} f = do+  gauges <- liftIO $ fmap Gauges EKG.new   if amsEnabled     then do       tags <- (amsTags <>) <$> getEcsMetadataTags-       Datadog.withDogStatsD amsSettings $ \client ->         -- Add the tags to the thread context so they're present in all logs         withThreadContext (map toPair tags)-          $ f StatsClient { scClient = client, scTags = tags }-    else f $ StatsClient { scClient = Datadog.Dummy, scTags = amsTags }+          $ f StatsClient { scClient = client, scTags = tags, scGauges = gauges }+    else do+      f $ StatsClient { scClient = Datadog.Dummy, scTags = amsTags, scGauges = gauges }   where toPair = bimap (fromString . unpack) String++withGauge :: (MonadReader app m, HasStatsClient app, MonadUnliftIO m) => GaugeName -> m a -> m a+withGauge gaugeName f = do+  gauge' <- view $ statsClientL . gaugesL . to (unGaugeName gaugeName)+  bracket_ (plus1 gauge') (minus1 gauge') f+  where+    plus1 g = liftIO $ EKG.add g 1+    minus1 g = liftIO $ EKG.subtract g 1  -- | Include the given tags on all metrics emitted from a block tagged

@@ -1,63 +0,0 @@--- | Stateful gauges for "Freckle.App.Stats"-module Freckle.App.Stats.Gauge-  ( Gauge-  , new-  , increment-  , decrement-  , add-  , subtract-  ) where--import Freckle.App.Prelude hiding (subtract)--import Freckle.App.Stats (HasStatsClient)-import qualified Freckle.App.Stats as Stats-import qualified System.Metrics.Gauge as EKG---- | A data type containing all reporting values for a gauge-data Gauge = Gauge-  { name :: Text-  , tags :: [(Text, Text)]-  , ekgGauge :: EKG.Gauge-  }---- | Create a gauge holding in memory state-new :: MonadIO m => Text -> [(Text, Text)] -> m Gauge-new name tags = Gauge name tags <$> liftIO EKG.new---- | Increment gauge state and report its current value-increment-  :: (MonadUnliftIO m, MonadReader env m, HasStatsClient env) => Gauge -> m ()-increment = add 1---- | Add to gauge state and report its current value-add-  :: (MonadUnliftIO m, MonadReader env m, HasStatsClient env)-  => Int64-  -> Gauge-  -> m ()-add i = withEKGGauge (`EKG.add` i)---- | Decrement gauge state and report its current value-decrement-  :: (MonadUnliftIO m, MonadReader env m, HasStatsClient env) => Gauge -> m ()-decrement = subtract 1---- | Subtract from gauge state and report its current value-subtract-  :: (MonadUnliftIO m, MonadReader env m, HasStatsClient env)-  => Int64-  -> Gauge-  -> m ()-subtract i = withEKGGauge (`EKG.subtract` i)--withEKGGauge-  :: (MonadUnliftIO m, MonadReader env m, HasStatsClient env)-  => (EKG.Gauge -> IO ())-  -> Gauge-  -> m ()-withEKGGauge f Gauge {..} = do-  current <- liftIO $ do-    f ekgGauge-    EKG.read ekgGauge-  Stats.tagged tags $ Stats.gauge name $ fromIntegral current

@@ -1,6 +1,6 @@ --- name: freckle-app-version: 1.6.0.3+version: 1.7.0.0 maintainer: Freckle Education category: Utils github: freckle/freckle-app@@ -50,6 +50,8 @@     - Glob     - MonadRandom     - aeson+    - aws-xray-client-persistent+    - aws-xray-client-wai     - bugsnag     - bytestring     - case-insensitive