ridley 0.3.4.1 → 0.4.0.0
raw patch · 7 files changed
+352/−29 lines, 7 filesdep ~ekg-prometheus-adapter
Dependency ranges changed: ekg-prometheus-adapter
Files
- example/Main.hs +9/−6
- ridley.cabal +16/−12
- src/System/Metrics/Prometheus/Ridley.hs +3/−6
- src/System/Metrics/Prometheus/Ridley/Metrics/FD.hs +66/−0
- src/System/Metrics/Prometheus/Ridley/Metrics/PhysicalMemory.hs +117/−0
- src/System/Metrics/Prometheus/Ridley/Metrics/VirtualMemory.hs +133/−0
- src/System/Metrics/Prometheus/Ridley/Types.hs +8/−5
example/Main.hs view
@@ -15,6 +15,7 @@ import System.IO import qualified Network.Wai as Wai import qualified Network.Wai.Handler.Warp as Warp+import Control.Monad.Reader webApp :: RidleyCtx -> IO () webApp ctx = Warp.run 8080 (app ctx)@@ -32,9 +33,10 @@ customExpensiveMetric = CustomMetric "my-expensive" (Just $ 60 * 1_000_000) get_metric where- get_metric :: MonadIO m => RidleyOptions -> P.RegistryT m RidleyMetricHandler- get_metric opts = do- m <- P.registerGauge "current_time" (opts ^. prometheusOptions . labels)+ get_metric :: Ridley RidleyMetricHandler+ get_metric = do+ opts <- ask+ m <- lift $ P.registerGauge "current_time" (opts ^. prometheusOptions . labels) return $ mkRidleyMetricHandler "current_time" m update False update :: P.Gauge -> Bool -> IO ()@@ -47,9 +49,10 @@ customCrashfulMetric = CustomMetric "my-crashful" (Just $ 60 * 1_000_000) get_metric where- get_metric :: MonadIO m => RidleyOptions -> P.RegistryT m RidleyMetricHandler- get_metric opts = do- m <- P.registerGauge "crashful" (opts ^. prometheusOptions . labels)+ get_metric :: Ridley RidleyMetricHandler+ get_metric = do+ opts <- ask+ m <- lift $ P.registerGauge "crashful" (opts ^. prometheusOptions . labels) return $ mkRidleyMetricHandler "crashful" m (\_ _ -> throwIO $ userError "CRASH!!") False main :: IO ()
ridley.cabal view
@@ -1,5 +1,5 @@ name: ridley-version: 0.3.4.1+version: 0.4.0.0 synopsis: Quick metrics to grow your app strong. description: A collection of Prometheus metrics to monitor your app. Please see README.md homepage: https://github.com/iconnect/ridley#README@@ -7,10 +7,11 @@ license-file: LICENSE author: Alfredo Di Napoli & the IRIS Connect Engineering Team maintainer: engineering@irisconnect.co.uk-copyright: 2023 IRIS Connect Ltd.+copyright: 2024 IRIS Connect Ltd. category: Web build-type: Simple cabal-version: >=1.10+tested-with: GHC == 9.4.7 || == 9.4.8 || == 9.6.4 extra-source-files: cbits/helpers.c@@ -30,12 +31,22 @@ hs-source-dirs: src exposed-modules: System.Metrics.Prometheus.Ridley System.Metrics.Prometheus.Ridley.Types- System.Metrics.Prometheus.Ridley.Metrics.Memory- System.Metrics.Prometheus.Ridley.Metrics.DiskUsage System.Metrics.Prometheus.Ridley.Metrics.CPU+ System.Metrics.Prometheus.Ridley.Metrics.DiskUsage+ System.Metrics.Prometheus.Ridley.Metrics.FD+ System.Metrics.Prometheus.Ridley.Metrics.Memory System.Metrics.Prometheus.Ridley.Metrics.Network System.Metrics.Prometheus.Ridley.Metrics.Network.Types+ System.Metrics.Prometheus.Ridley.Metrics.PhysicalMemory+ System.Metrics.Prometheus.Ridley.Metrics.VirtualMemory other-modules: System.Metrics.Prometheus.Ridley.Types.Internal+ if os(darwin)+ c-sources: src/System/Metrics/Prometheus/Ridley/Metrics/CPU/Darwin.c+ other-modules: System.Metrics.Prometheus.Ridley.Metrics.Network.Darwin+ System.Metrics.Prometheus.Ridley.Metrics.CPU.Darwin+ else+ other-modules: System.Metrics.Prometheus.Ridley.Metrics.Network.Unix+ System.Metrics.Prometheus.Ridley.Metrics.CPU.Unix build-depends: async < 3.0.0, auto-update >= 0.1,@@ -58,7 +69,7 @@ microlens-th, process, string-conv,- ekg-prometheus-adapter >= 0.1.0.3,+ ekg-prometheus-adapter >= 0.1.0.5, inline-c, vector, unix,@@ -69,13 +80,6 @@ default-language: Haskell2010 if flag(lib-Werror) ghc-options: -Wall -Werror- if os(darwin)- c-sources: src/System/Metrics/Prometheus/Ridley/Metrics/CPU/Darwin.c- other-modules: System.Metrics.Prometheus.Ridley.Metrics.Network.Darwin- System.Metrics.Prometheus.Ridley.Metrics.CPU.Darwin- else- other-modules: System.Metrics.Prometheus.Ridley.Metrics.Network.Unix- System.Metrics.Prometheus.Ridley.Metrics.CPU.Unix test-suite ridley-test type: exitcode-stdio-1.0
src/System/Metrics/Prometheus/Ridley.hs view
@@ -144,18 +144,15 @@ $(logTM) sev "Registering DiskUsage metric..." pure diskUsage -registerCustomMetric :: T.Text- -> Maybe Int- -> (forall m. MonadIO m => RidleyOptions -> P.RegistryT m RidleyMetricHandler)- -> Ridley RidleyMetricHandler+registerCustomMetric :: T.Text -> Maybe Int -> Ridley RidleyMetricHandler -> Ridley RidleyMetricHandler registerCustomMetric metricName mb_timeout custom = do opts <- getRidleyOptions let sev = opts ^. katipSeverity le <- getLogEnv customMetric <- case mb_timeout of- Nothing -> lift (custom opts)+ Nothing -> custom Just microseconds -> do- RidleyMetricHandler mtr upd flsh lbl cs <- lift (custom opts)+ RidleyMetricHandler mtr upd flsh lbl cs <- custom doUpdate <- liftIO $ Auto.mkAutoUpdate Auto.defaultUpdateSettings { updateAction = upd mtr flsh `Ex.catch` logFailedUpdate le lbl cs , updateFreq = microseconds
+ src/System/Metrics/Prometheus/Ridley/Metrics/FD.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+module System.Metrics.Prometheus.Ridley.Metrics.FD where++import qualified Data.Text as T+import Lens.Micro+import Shelly+import Katip.Core+import qualified System.Metrics.Prometheus.Metric.Gauge as P+import qualified System.Metrics.Prometheus.RegistryT as P+import System.Metrics.Prometheus.Ridley.Types+import System.Posix.Types (ProcessID)+import System.Remote.Monitoring.Prometheus (labels)+import Katip.Monadic+import Data.String+import Control.Monad.Trans (lift)+import Control.Monad.Reader (ask)++logAndReturnFDs :: RidleyOptions -> LogEnv -> ProcessID -> [T.Text] -> IO Double+logAndReturnFDs opts le pid descriptors = do+ let !descriptorsNums = length descriptors+ when (descriptorsNums >= opts ^. openFDWarningTreshold) $+ runRidley opts le $ do+ $(logTM) WarningS $ fromString $ "Careful, number of open file descriptors for process " <> show pid <> " exceeded warning threshold (" <> show (opts ^. openFDWarningTreshold) <> "):\n" <> T.unpack (T.unlines descriptors)+ return $ (fromIntegral $ descriptorsNums)++--------------------------------------------------------------------------------+getOpenFD_unix :: RidleyOptions -> LogEnv -> ProcessID -> IO Double+getOpenFD_unix opts le pid = do+ descriptors <- shelly $ silently $ escaping False $+ T.lines . T.strip <$> run "ls" ["-l", "/proc/" <> T.pack (show pid) <> "/fd", "|"+ ,"grep", "^l"+ ]+ logAndReturnFDs opts le pid descriptors++--------------------------------------------------------------------------------+getOpenFD_darwin :: RidleyOptions -> LogEnv -> ProcessID -> IO Double+getOpenFD_darwin opts le pid = do+ descriptors <- shelly $ silently $ escaping False $+ T.lines . T.strip <$> run "lsof" ["-p", T.pack (show pid), "|"+ ,"grep", "REG", "|", "awk", "'{print $9}'"+ ]+ logAndReturnFDs opts le pid descriptors++--------------------------------------------------------------------------------+updateOpenFD :: RidleyOptions -> LogEnv -> ProcessID -> P.Gauge -> Bool -> IO ()+updateOpenFD opts le pid gauge _ = do+#ifdef darwin_HOST_OS+ openFd <- getOpenFD_darwin opts le pid+#else+ openFd <- getOpenFD_unix opts le pid+#endif+ P.set openFd gauge++--------------------------------------------------------------------------------+-- | Monitors the number of open file descriptors for a given `ProcessID`.+processOpenFD :: ProcessID+ -> Ridley RidleyMetricHandler+processOpenFD pid = do+ opts <- ask+ le <- getLogEnv+ let popts = opts ^. prometheusOptions+ openFD <- lift $ P.registerGauge "process_open_fd" (popts ^. labels)+ return $ mkRidleyMetricHandler "ridley-process-open-file-descriptors" openFD (updateOpenFD opts le pid) False
+ src/System/Metrics/Prometheus/Ridley/Metrics/PhysicalMemory.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}+module System.Metrics.Prometheus.Ridley.Metrics.PhysicalMemory where++import Data.Maybe (mapMaybe)+import Data.Word+import qualified Data.Text as T+import Lens.Micro+import Shelly+import qualified System.Metrics.Prometheus.Metric.Gauge as P+import qualified System.Metrics.Prometheus.RegistryT as P+import System.Metrics.Prometheus.Ridley.Types+import System.Remote.Monitoring.Prometheus (labels)+import Text.Read (readMaybe)+import Control.Monad.Reader++{- Calling 'free' will report+[service-runner@hermes-devel ~]$ free -k+ total used free shared buff/cache available+Mem: 962 377 251 36 333 377+Swap: 4095 0 4095+-}++--------------------------------------------------------------------------------+getFreeStats :: IO FreeReport+getFreeStats = do+ rawOutput <- shelly $ silently $ escaping False $+ mapMaybe (readMaybe @Word64 . T.unpack) . T.words . T.strip <$> run "free" ["-m" ,"|" , "tail", "-n", "-2" , "|", "awk", "-F", "\" \"", "'{printf \"%s %s %s %s %s %s %s\", $2, $3, $4, $5, $6, $7, $8}'"]+ case rawOutput of+ [ free_mem_total_mb+ , free_mem_used_mb+ , free_mem_free_mb+ , free_mem_shared_mb+ , free_mem_buff_cache_mb+ , free_mem_available_mb+ , free_swap_total_mb+ , free_swap_used_mb+ , free_swap_free_mb+ ] -> pure $ FreeReport{..}+ _ -> pure emptyFreeReport++--------------------------------------------------------------------------------+updateFreeStats :: FreeGauges -> Bool -> IO ()+updateFreeStats FreeGauges{..} _ = do+#ifdef darwin_HOST_OS+ let FreeReport{..} = emptyFreeReport-- "free" is not available on Darwin.+#else+ FreeReport{..} <- getFreeStats+#endif+ P.set (realToFrac free_mem_total_mb ) free_mem_total_mb_g+ P.set (realToFrac free_mem_used_mb ) free_mem_used_mb_g+ P.set (realToFrac free_mem_free_mb ) free_mem_free_mb_g+ P.set (realToFrac free_mem_shared_mb ) free_mem_shared_mb_g+ P.set (realToFrac free_mem_buff_cache_mb ) free_mem_buff_cache_mb_g+ P.set (realToFrac free_mem_available_mb ) free_mem_available_mb_g+ P.set (realToFrac free_swap_total_mb ) free_swap_total_mb_g+ P.set (realToFrac free_swap_used_mb ) free_swap_used_mb_g+ P.set (realToFrac free_swap_free_mb ) free_swap_free_mb_g++data FreeReport =+ FreeReport {+ free_mem_total_mb :: !Word64+ , free_mem_used_mb :: !Word64+ , free_mem_free_mb :: !Word64+ , free_mem_shared_mb :: !Word64+ , free_mem_buff_cache_mb :: !Word64+ , free_mem_available_mb :: !Word64+ , free_swap_total_mb :: !Word64+ , free_swap_used_mb :: !Word64+ , free_swap_free_mb :: !Word64+ } deriving (Show, Eq)++emptyFreeReport :: FreeReport+emptyFreeReport = FreeReport+ { free_mem_total_mb = 0+ , free_mem_used_mb = 0+ , free_mem_free_mb = 0+ , free_mem_shared_mb = 0+ , free_mem_buff_cache_mb = 0+ , free_mem_available_mb = 0+ , free_swap_total_mb = 0+ , free_swap_used_mb = 0+ , free_swap_free_mb = 0+ }+++data FreeGauges =+ FreeGauges {+ free_mem_total_mb_g :: !P.Gauge+ , free_mem_used_mb_g :: !P.Gauge+ , free_mem_free_mb_g :: !P.Gauge+ , free_mem_shared_mb_g :: !P.Gauge+ , free_mem_buff_cache_mb_g :: !P.Gauge+ , free_mem_available_mb_g :: !P.Gauge+ , free_swap_total_mb_g :: !P.Gauge+ , free_swap_used_mb_g :: !P.Gauge+ , free_swap_free_mb_g :: !P.Gauge+ }++--------------------------------------------------------------------------------+-- | Returns the physical memory total and free as sampled from 'free'.+systemPhysicalMemory :: Ridley RidleyMetricHandler+systemPhysicalMemory = do+ opts <- ask+ let popts = opts ^. prometheusOptions+ gauges <- lift $ FreeGauges <$> P.registerGauge "free_mem_total_mb" (popts ^. labels)+ <*> P.registerGauge "free_mem_used_mb" (popts ^. labels)+ <*> P.registerGauge "free_mem_free_mb" (popts ^. labels)+ <*> P.registerGauge "free_mem_shared_mb" (popts ^. labels)+ <*> P.registerGauge "free_mem_buff_cache_mb" (popts ^. labels)+ <*> P.registerGauge "free_mem_available_mb" (popts ^. labels)+ <*> P.registerGauge "free_swap_total_mb" (popts ^. labels)+ <*> P.registerGauge "free_swap_used_mb" (popts ^. labels)+ <*> P.registerGauge "free_swap_free_mb" (popts ^. labels)+ return $ mkRidleyMetricHandler "ridley-physical-memory-statistics" gauges updateFreeStats False
+ src/System/Metrics/Prometheus/Ridley/Metrics/VirtualMemory.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}+module System.Metrics.Prometheus.Ridley.Metrics.VirtualMemory where++import Control.Monad.Reader (ask, lift)+import Data.Maybe (mapMaybe)+import Data.Word+import Lens.Micro+import Shelly+import System.Metrics.Prometheus.Ridley.Types+import System.Remote.Monitoring.Prometheus (labels)+import Text.Read (readMaybe)+import qualified Data.Text as T+import qualified System.Metrics.Prometheus.Metric.Gauge as P+import qualified System.Metrics.Prometheus.RegistryT as P++{- Calling 'vmstat' will report++[centos@atlas-eu ~]$ vmstat -S M -s+ 130701440 M total memory+ 52971728 M used memory+ 92670416 M active memory+ 33348008 M inactive memory+ 852768 M free memory+ 0 M buffer memory+ 76876944 M swap cache+ 0 M total swap+ 0 M used swap+ 0 M free swap+ ...+-}++--------------------------------------------------------------------------------+getVmStats :: IO VmStatReport+getVmStats = do+ rawOutput <- shelly $ silently $ escaping False $+ mapMaybe (readMaybe @Word64 . T.unpack) . T.words . T.strip+ <$> run "vmstat" ["-S", "M", "-s" ,"|" , "head", "-n", "10" , "|" , "awk", "-F", "\" \"" , "'{print $1}'" ]+ case rawOutput of+ [ vmstat_total_memory_mb+ , vmstat_used_memory_mb+ , vmstat_active_memory_mb+ , vmstat_inactive_memory_mb+ , vmstat_free_memory_mb+ , vmstat_buffer_memory_mb+ , vmstat_swap_cache_mb+ , vmstat_total_swap_mb+ , vmstat_used_swap_mb+ , vmstat_free_swap_mb+ ] -> pure $ VmStatReport{..}+ _ -> pure emptyVmStatReport++--------------------------------------------------------------------------------+updateVmStat :: VmStatGauges -> Bool -> IO ()+updateVmStat VmStatGauges{..} _ = do+#ifdef darwin_HOST_OS+ let VmStatReport{..} = emptyVmStatReport-- "vmstat" is not available on Darwin.+#else+ VmStatReport{..} <- getVmStats+#endif+ P.set (realToFrac vmstat_total_memory_mb ) vmstat_total_memory_mb_g+ P.set (realToFrac vmstat_used_memory_mb ) vmstat_used_memory_mb_g+ P.set (realToFrac vmstat_active_memory_mb ) vmstat_active_memory_mb_g+ P.set (realToFrac vmstat_inactive_memory_mb ) vmstat_inactive_memory_mb_g+ P.set (realToFrac vmstat_free_memory_mb ) vmstat_free_memory_mb_g+ P.set (realToFrac vmstat_buffer_memory_mb ) vmstat_buffer_memory_mb_g+ P.set (realToFrac vmstat_swap_cache_mb ) vmstat_swap_cache_mb_g+ P.set (realToFrac vmstat_total_swap_mb ) vmstat_total_swap_mb_g+ P.set (realToFrac vmstat_used_swap_mb ) vmstat_used_swap_mb_g+ P.set (realToFrac vmstat_free_swap_mb ) vmstat_free_swap_mb_g++data VmStatReport =+ VmStatReport {+ vmstat_total_memory_mb :: !Word64+ , vmstat_used_memory_mb :: !Word64+ , vmstat_active_memory_mb :: !Word64+ , vmstat_inactive_memory_mb :: !Word64+ , vmstat_free_memory_mb :: !Word64+ , vmstat_buffer_memory_mb :: !Word64+ , vmstat_swap_cache_mb :: !Word64+ , vmstat_total_swap_mb :: !Word64+ , vmstat_used_swap_mb :: !Word64+ , vmstat_free_swap_mb :: !Word64+ } deriving (Show, Eq)++emptyVmStatReport :: VmStatReport+emptyVmStatReport = VmStatReport+ { vmstat_total_memory_mb = 0+ , vmstat_used_memory_mb = 0+ , vmstat_active_memory_mb = 0+ , vmstat_inactive_memory_mb = 0+ , vmstat_free_memory_mb = 0+ , vmstat_buffer_memory_mb = 0+ , vmstat_swap_cache_mb = 0+ , vmstat_total_swap_mb = 0+ , vmstat_used_swap_mb = 0+ , vmstat_free_swap_mb = 0+ }+++data VmStatGauges =+ VmStatGauges {+ vmstat_total_memory_mb_g :: !P.Gauge+ , vmstat_used_memory_mb_g :: !P.Gauge+ , vmstat_active_memory_mb_g :: !P.Gauge+ , vmstat_inactive_memory_mb_g :: !P.Gauge+ , vmstat_free_memory_mb_g :: !P.Gauge+ , vmstat_buffer_memory_mb_g :: !P.Gauge+ , vmstat_swap_cache_mb_g :: !P.Gauge+ , vmstat_total_swap_mb_g :: !P.Gauge+ , vmstat_used_swap_mb_g :: !P.Gauge+ , vmstat_free_swap_mb_g :: !P.Gauge+ }++--------------------------------------------------------------------------------+-- | Returns the virtual memory total and free as sampled from 'vmstat'.+systemVirtualMemory :: Ridley RidleyMetricHandler+systemVirtualMemory = do+ opts <- ask+ let popts = opts ^. prometheusOptions+ gauges <- lift $ VmStatGauges <$> P.registerGauge "vmstat_total_memory_mb" (popts ^. labels)+ <*> P.registerGauge "vmstat_used_memory_mb" (popts ^. labels)+ <*> P.registerGauge "vmstat_active_memory_mb" (popts ^. labels)+ <*> P.registerGauge "vmstat_inactive_memory_mb" (popts ^. labels)+ <*> P.registerGauge "vmstat_free_memory_mb" (popts ^. labels)+ <*> P.registerGauge "vmstat_buffer_memory_mb" (popts ^. labels)+ <*> P.registerGauge "vmstat_swap_cache_mb" (popts ^. labels)+ <*> P.registerGauge "vmstat_total_swap_mb" (popts ^. labels)+ <*> P.registerGauge "vmstat_used_swap_mb" (popts ^. labels)+ <*> P.registerGauge "vmstat_free_swap_mb" (popts ^. labels)+ return $ mkRidleyMetricHandler "ridley-virtual-memory-statistics" gauges updateVmStat False
src/System/Metrics/Prometheus/Ridley/Types.hs view
@@ -29,6 +29,7 @@ , katipScribes , katipSeverity , dataRetentionPeriod+ , openFDWarningTreshold , runHandler , ioLogger , getRidleyOptions@@ -86,7 +87,7 @@ -- will be updated using Ridley top-level setting, -- if 'Just' the underlying 'IO' action will be run -- only every @n@ seconds, or cached otherwise.- (forall m. MonadIO m => RidleyOptions -> P.RegistryT m RidleyMetricHandler)+ (Ridley RidleyMetricHandler) -- ^ An action to generate the handler. -- ^ A user-defined metric, identified by a name. @@ -159,12 +160,11 @@ , _katipScribes :: (Katip.Namespace, [(T.Text, Katip.Scribe)]) , _katipSeverity :: Katip.Severity , _dataRetentionPeriod :: Maybe NominalDiffTime+ , _openFDWarningTreshold :: !Int -- ^ How much to retain the data, in seconds. -- Pass `Nothing` to not flush the metrics. } -makeLenses ''RidleyOptions- -------------------------------------------------------------------------------- defaultMetrics :: [RidleyMetric] defaultMetrics = [ProcessMemory, CPULoad, GHCConc, Network, Wai, DiskUsage]@@ -179,6 +179,7 @@ , _katipSeverity = InfoS , _katipScribes = mempty , _dataRetentionPeriod = Nothing+ , _openFDWarningTreshold = 100 } --------------------------------------------------------------------------------@@ -196,8 +197,6 @@ , _ridleyWaiMetrics :: Maybe WaiMetrics } -makeLenses ''RidleyCtx- instance MonadThrow Ridley where throwM e = Ridley $ ReaderT $ \_ -> P.RegistryT $ StateT $ \_ -> throwM e @@ -238,3 +237,7 @@ noUpdate :: c -> Bool -> IO () noUpdate _ _ = pure ()++makeLenses ''RidleyCtx+makeLenses ''RidleyOptions+