freckle-stats (empty) → 0.0.0.0
raw patch · 7 files changed
+592/−0 lines, 7 filesdep +Blammodep +aesondep +base
Dependencies added: Blammo, aeson, base, datadog, ekg-core, freckle-ecs, freckle-env, freckle-prelude, immortal, lens, mtl, time, unliftio, unordered-containers
Files
- CHANGELOG.md +5/−0
- LICENSE +21/−0
- README.md +3/−0
- freckle-stats.cabal +61/−0
- library/Freckle/App/Stats.hs +385/−0
- library/Freckle/App/Stats/Rts.hs +47/−0
- package.yaml +70/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-stats-v0.0.0.0...main)++## [v0.0.0.0](https://github.com/freckle/freckle-app/tree/freckle-stats-v0.0.0.0/freckle-stats)++First release, sprouted from `freckle-app-1.21.0.0`.
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2021-2024 Renaissance Learning Inc++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,3 @@+# freckle-stats++An intentionally-leaky StatsD interface to Datadog
+ freckle-stats.cabal view
@@ -0,0 +1,61 @@+cabal-version: 1.18+name: freckle-stats+version: 0.0.0.0+license: MIT+license-file: LICENSE+maintainer: Freckle Education+homepage: https://github.com/freckle/freckle-app#readme+bug-reports: https://github.com/freckle/freckle-app/issues+synopsis: An intentionally-leaky StatsD interface to Datadog+description: Please see README.md+category: Prelude+build-type: Simple+extra-source-files: package.yaml+extra-doc-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/freckle/freckle-app++library+ exposed-modules:+ Freckle.App.Stats+ Freckle.App.Stats.Rts++ hs-source-dirs: library+ other-modules: Paths_freckle_stats+ default-language: GHC2021+ default-extensions:+ DataKinds DeriveAnyClass DerivingVia DerivingStrategies GADTs+ LambdaCase NoImplicitPrelude NoMonomorphismRestriction+ OverloadedStrings RecordWildCards TypeFamilies++ ghc-options:+ -fignore-optim-changes -fwrite-ide-info -Weverything+ -Wno-all-missed-specialisations -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-kind-signatures+ -Wno-missing-local-signatures -Wno-missing-safe-haskell-mode+ -Wno-monomorphism-restriction -Wno-prepositive-qualified-module+ -Wno-safe -Wno-unsafe++ build-depends:+ Blammo >=2.1.0.0,+ aeson >=2.0.3.0,+ base >=4.16.4.0 && <5,+ datadog >=0.3.0.0,+ ekg-core >=0.1.1.7,+ freckle-ecs >=0.0.0.0,+ freckle-env >=0.0.1.1,+ freckle-prelude >=0.0.1.1,+ immortal >=0.3,+ lens >=5.1.1,+ mtl >=2.2.2,+ time >=1.11.1.1,+ unliftio >=0.2.25.0,+ unordered-containers >=0.2.19.1++ if impl(ghc >=9.8)+ ghc-options:+ -Wno-missing-role-annotations -Wno-missing-poly-kind-signatures
+ library/Freckle/App/Stats.hs view
@@ -0,0 +1,385 @@+{-# LANGUAGE TupleSections #-}++-- | An intentionally-leaky StatsD interface to Datadog+module Freckle.App.Stats+ ( -- $docs+ StatsSettings+ , defaultStatsSettings+ , setStatsSettingsTags+ , envParseStatsSettings++ -- * Client+ , StatsClient+ , tagsL+ , withStatsClient+ , HasStatsClient (..)++ -- * Gauges+ , Gauges+ , Gauge+ , dbConnections+ , dbEnqueuedAndProcessing+ , withGauge+ , lookupGauge+ , incGauge+ , decGauge++ -- * Reporting+ , tagged+ , increment+ , counter+ , gauge+ , histogram+ , histogramSince+ , histogramSinceMs+ ) where++import Freckle.App.Prelude++import Blammo.Logging.ThreadContext (MonadMask, withThreadContext)+import Control.Lens (Lens', lens, to, view, (&), (.~), (<>~))+import Control.Monad.Except (runExceptT)+import Control.Monad.Reader (local)+import Data.Aeson (Value (..))+import Data.String+import Data.Time (diffUTCTime)+import Freckle.App.Ecs+import Freckle.App.Env qualified as Env+import Network.StatsD.Datadog qualified as Datadog+import System.IO (hPutStrLn, stderr)+import System.Metrics.Gauge qualified as EKG+import UnliftIO.Exception (bracket_)++data StatsSettings = StatsSettings+ { amsEnabled :: Bool+ , amsSettings :: Datadog.DogStatsSettings+ , amsTags :: [(Text, Text)]+ }++defaultStatsSettings :: StatsSettings+defaultStatsSettings =+ StatsSettings+ { amsEnabled = False+ , amsSettings = Datadog.defaultSettings+ , amsTags = []+ }++setStatsSettingsTags :: [(Text, Text)] -> StatsSettings -> StatsSettings+setStatsSettingsTags x settings = settings {amsTags = x}++envParseStatsSettings :: Env.Parser Env.Error StatsSettings+envParseStatsSettings =+ StatsSettings+ <$> Env.switch "DOGSTATSD_ENABLED" mempty+ <*> ( buildSettings+ <$> optional (Env.var Env.str "DOGSTATSD_HOST" mempty)+ <*> optional (Env.var Env.auto "DOGSTATSD_PORT" mempty)+ )+ <*> ( buildTags+ <$> optional (Env.var Env.nonempty "DD_ENV" mempty)+ <*> optional (Env.var Env.nonempty "DD_SERVICE" mempty)+ <*> optional (Env.var Env.nonempty "DD_VERSION" mempty)+ <*> Env.var Env.keyValues "DOGSTATSD_TAGS" (Env.def [])+ )+ where+ buildSettings mHost mPort =+ Datadog.defaultSettings+ & maybe id (Datadog.host .~) mHost+ . maybe id (Datadog.port .~) mPort++ buildTags mEnv mService mVersion tags =+ catMaybes+ [ ("env",) <$> mEnv+ , ("environment",) <$> mEnv -- Legacy+ , ("service",) <$> mService+ , ("version",) <$> mVersion+ ]+ <> tags++data Gauges = Gauges+ { gdbConnections :: Gauge+ -- ^ Track open db connections+ , gdbEnqueuedAndProcessing :: Gauge+ -- ^ Track enqueued and processing queries+ }++data Gauge = Gauge+ { gName :: Text+ , gGauge :: EKG.Gauge+ }++dbConnections :: Gauges -> Gauge+dbConnections = gdbConnections++dbEnqueuedAndProcessing :: Gauges -> Gauge+dbEnqueuedAndProcessing = gdbEnqueuedAndProcessing++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++instance HasStatsClient StatsClient where+ statsClientL = id++withStatsClient+ :: (MonadMask m, MonadUnliftIO m)+ => StatsSettings+ -> (StatsClient -> m a)+ -> m a+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+ 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+ , 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)+ => (Gauges -> Gauge)+ -> m a+ -> m a+withGauge getGauge f = do+ gauge' <- lookupGauge getGauge+ bracket_ (inc gauge') (dec gauge') f+ where+ inc = incGauge+ dec = decGauge++lookupGauge+ :: (MonadReader app m, HasStatsClient app)+ => (Gauges -> Gauge)+ -> m Gauge+lookupGauge accessor = view $ statsClientL . gaugesL . to accessor++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+ :: (MonadReader env m, HasStatsClient env) => [(Text, Text)] -> m a -> m a+tagged tags = local $ statsClientL . tagsL <>~ tags++-- | Synonym for @'counter' 1@+increment+ :: (MonadUnliftIO m, MonadReader env m, HasStatsClient env) => Text -> m ()+increment name = counter name 1++counter+ :: (MonadUnliftIO m, MonadReader env m, HasStatsClient env)+ => Text+ -> Int+ -> m ()+counter = sendMetric Datadog.Counter++gauge+ :: (MonadUnliftIO m, MonadReader env m, HasStatsClient env)+ => Text+ -> Double+ -> m ()+gauge = sendMetric Datadog.Gauge++-- | Emit an elapsed duration (which Datadog calls a /histogram/)+--+-- The 'ToMetricValue' constraint can be satisfied by most numeric types and is+-- assumed to be seconds.+histogram+ :: ( MonadUnliftIO m+ , MonadReader env m+ , HasStatsClient env+ , Datadog.ToMetricValue n+ )+ => Text+ -> n+ -> m ()+histogram = sendMetric Datadog.Histogram++histogramSince+ :: (MonadUnliftIO m, MonadReader env m, HasStatsClient env)+ => Text+ -> UTCTime+ -> m ()+histogramSince = histogramSinceBy toSeconds where toSeconds = round @_ @Int++histogramSinceMs+ :: (MonadUnliftIO m, MonadReader env m, HasStatsClient env)+ => Text+ -> UTCTime+ -> m ()+histogramSinceMs = histogramSinceBy toMilliseconds+ where+ toMilliseconds = (* 1000) . realToFrac @_ @Double++histogramSinceBy+ :: ( MonadUnliftIO m+ , MonadReader env m+ , HasStatsClient env+ , Datadog.ToMetricValue n+ )+ => (NominalDiffTime -> n)+ -> Text+ -> UTCTime+ -> m ()+histogramSinceBy f name time = do+ now <- liftIO getCurrentTime+ let delta = f $ now `diffUTCTime` time+ sendMetric Datadog.Histogram name delta++sendMetric+ :: ( MonadUnliftIO m+ , MonadReader env m+ , HasStatsClient env+ , Datadog.ToMetricValue v+ )+ => Datadog.MetricType+ -> Text+ -> v+ -> m ()+sendMetric metricType name metricValue = do+ StatsClient {..} <- view statsClientL++ Datadog.send scClient+ $ Datadog.metric (Datadog.MetricName name) metricType metricValue+ & (Datadog.tags .~ map (uncurry Datadog.tag) scTags)++getEcsMetadataTags :: MonadIO m => m [(Text, Text)]+getEcsMetadataTags = do+ eMetadata <- runExceptT getEcsMetadata+ either (([] <$) . err) (pure . toTags) eMetadata+ where+ err e = liftIO $ hPutStrLn stderr $ "Error reading ECS Metadata: " <> show e++ toTags (EcsMetadata EcsContainerMetadata {..} EcsContainerTaskMetadata {..}) =+ [ ("container_id", ecmDockerId)+ , ("container_name", ecmDockerName)+ , ("docker_image", ecmImage)+ , ("image_tag", ecmImageID)+ , ("cluster_name", ectmCluster)+ , ("task_arn", ectmTaskARN)+ , ("task_family", ectmFamily)+ , ("task_version", ectmRevision)+ ]++-- $docs+--+-- == Usage+--+-- - Use 'envParseStatsSettings' to configure things+--+-- @+-- data AppSettings = AppSettings+-- { -- ...+-- , appStatsSettings :: StatsSettings+-- }+--+-- loadSettings :: IO AppSettings+-- loadSettings = Env.parse id $ AppSettings+-- <$> -- ...+-- <*> 'envParseStatsSettings'+-- @+--+-- This will read,+--+-- - @DOGSTATSD_ENABLED=x@+-- - @DOGSTATSD_HOST=127.0.0.1@+-- - @DOGSTATSD_PORT=8125@+-- - @DOGSTATSD_TAGS=[<key>:<value>,...]@+-- - Optionally @DD_ENV@, @DD_SERVICE@, and @DD_VERSION@+--+-- - Give your @App@ a 'HasStatsClient' instance+--+-- @+-- data App = App+-- { -- ...+-- , appStatsClient :: 'StatsClient'+-- }+--+-- instance 'HasStatsClient' App where+-- 'statsClientL' = lens appStatsClient $ \x y -> { appStatsClient = y }+-- @+--+-- - Use 'withStatsClient' to build and store a client on your @App@ when you+-- run it+--+-- @+-- 'withStatsClient' appStatsSettings $ \client -> do+-- app <- App+-- <$> ...+-- <*> pure client+--+-- 'runApp' app $ ...+-- @+--+-- - Throughout your application code, emit metrics as desired+--+-- @+-- import qualified Freckle.App.Stats as Stats+--+-- myFunction :: (MonadIO m, MonadReader env m, 'HasStatsClient' env) => m ()+-- myFunction = do+-- start <- liftIO getCurrentTime+-- result <- myAction+--+-- Stats.'increment' \"action.attempt\"+-- Stats.'histogramSinceMs' \"action.duration\" start+--+-- case result of+-- Left err -> do+-- Stats.'increment' \"action.failure\"+-- -- ...+-- Right x -. do+-- Stats.'increment' \"action.success\"+-- -- ...+-- @
+ library/Freckle/App/Stats/Rts.hs view
@@ -0,0 +1,47 @@+-- | Send RTS statistics via "Freckle.App.Stats"+module Freckle.App.Stats.Rts+ ( forkRtsStatPolling+ ) where++import Freckle.App.Prelude++import Control.Immortal qualified as Immortal+import Data.HashMap.Strict qualified as HashMap+import Freckle.App.Stats (HasStatsClient)+import Freckle.App.Stats qualified as Stats+import System.Metrics qualified as Ekg+import System.Metrics.Distribution.Internal qualified as Ekg+import UnliftIO.Concurrent (threadDelay)++-- | Initialize a thread to poll RTS stats+--+-- Stats are collected via `ekg-core` and 'System.Metrics.registerGcMetrics'+forkRtsStatPolling+ :: (MonadUnliftIO m, MonadReader env m, HasStatsClient env) => m ()+forkRtsStatPolling = do+ store <- liftIO Ekg.newStore+ liftIO $ Ekg.registerGcMetrics store++ void $ Immortal.create $ \_ -> do+ sample <- liftIO $ Ekg.sampleAll store+ traverse_ (uncurry flushEkgSample) $ HashMap.toList sample++ let seconds n = n * 1000000+ threadDelay $ seconds 1++flushEkgSample+ :: (MonadUnliftIO m, MonadReader env m, HasStatsClient env)+ => Text+ -> Ekg.Value+ -> m ()+flushEkgSample name = \case+ Ekg.Counter n -> Stats.counter name $ fromIntegral n+ Ekg.Gauge n -> Stats.gauge name $ fromIntegral n+ Ekg.Distribution d -> do+ Stats.gauge (name <> "." <> "mean") $ Ekg.mean d+ Stats.gauge (name <> "." <> "variance") $ Ekg.variance d+ Stats.gauge (name <> "." <> "sum") $ Ekg.sum d+ Stats.gauge (name <> "." <> "min") $ Ekg.min d+ Stats.gauge (name <> "." <> "max") $ Ekg.max d+ Stats.counter (name <> "." <> "count") $ fromIntegral $ Ekg.count d+ Ekg.Label _ -> pure ()
+ package.yaml view
@@ -0,0 +1,70 @@+name: freckle-stats+version: 0.0.0.0+maintainer: Freckle Education+category: Prelude+github: freckle/freckle-app+synopsis: An intentionally-leaky StatsD interface to Datadog+description: Please see README.md++extra-doc-files:+ - README.md+ - CHANGELOG.md++extra-source-files:+ - package.yaml++language: GHC2021++ghc-options:+ - -fignore-optim-changes+ - -fwrite-ide-info+ - -Weverything+ - -Wno-all-missed-specialisations+ - -Wno-missing-exported-signatures # re-enables missing-signatures+ - -Wno-missing-import-lists+ - -Wno-missing-kind-signatures+ - -Wno-missing-local-signatures+ - -Wno-missing-safe-haskell-mode+ - -Wno-monomorphism-restriction+ - -Wno-prepositive-qualified-module+ - -Wno-safe+ - -Wno-unsafe++when:+ - condition: "impl(ghc >= 9.8)"+ ghc-options:+ - -Wno-missing-role-annotations+ - -Wno-missing-poly-kind-signatures++dependencies:+ - base < 5++default-extensions:+ - DataKinds+ - DeriveAnyClass+ - DerivingVia+ - DerivingStrategies+ - GADTs+ - LambdaCase+ - NoImplicitPrelude+ - NoMonomorphismRestriction+ - OverloadedStrings+ - RecordWildCards+ - TypeFamilies++library:+ source-dirs: library+ dependencies:+ - aeson+ - Blammo+ - datadog+ - ekg-core+ - freckle-ecs+ - freckle-env+ - freckle-prelude+ - immortal+ - lens+ - mtl+ - time+ - unliftio+ - unordered-containers