diff --git a/ridley.cabal b/ridley.cabal --- a/ridley.cabal +++ b/ridley.cabal @@ -1,5 +1,5 @@ name: ridley -version: 0.3.0.0 +version: 0.3.1.1 synopsis: Quick metrics to grow you app strong. description: Please see README.md homepage: https://github.com/iconnect/ridley#readme @@ -15,6 +15,7 @@ cabal-version: >=1.10 flag lib-Werror + manual: True default: False description: Enable -Werror @@ -46,6 +47,7 @@ microlens, microlens-th, process, + string-conv, ekg-prometheus-adapter >= 0.1.0.3, inline-c, vector, @@ -53,9 +55,8 @@ c-sources: cbits/helpers.c cc-options: -Wall -std=c99 default-language: Haskell2010 - ghc-options: -Wall if flag(lib-Werror) - ghc-options: -Wall + ghc-options: -Wall -Werror if os(darwin) c-sources: src/System/Metrics/Prometheus/Ridley/Metrics/Network/Darwin.c src/System/Metrics/Prometheus/Ridley/Metrics/CPU/Darwin.c diff --git a/src/System/Metrics/Prometheus/Ridley.hs b/src/System/Metrics/Prometheus/Ridley.hs --- a/src/System/Metrics/Prometheus/Ridley.hs +++ b/src/System/Metrics/Prometheus/Ridley.hs @@ -32,8 +32,10 @@ import Data.IORef import qualified Data.List as List import Data.Map.Strict as M +import Data.Monoid ((<>)) import qualified Data.Set as Set import Data.String +import qualified Data.Text as T import Data.Time import GHC.Conc (getNumCapabilities, getNumProcessors) import Katip @@ -68,6 +70,10 @@ let popts = opts ^. prometheusOptions let sev = opts ^. katipSeverity case x of + CustomMetric metricName custom -> do + customMetric <- lift (custom opts) + $(logTM) sev $ "Registering CustomMetric '" <> fromString (T.unpack metricName) <> "'..." + (customMetric :) <$> (registerMetrics xs) ProcessMemory -> do processReservedMemory <- lift $ P.registerGauge "process_memory_kb" (popts ^. labels) let !m = processMemory processReservedMemory diff --git a/src/System/Metrics/Prometheus/Ridley/Metrics/CPU/Unix.hs b/src/System/Metrics/Prometheus/Ridley/Metrics/CPU/Unix.hs --- a/src/System/Metrics/Prometheus/Ridley/Metrics/CPU/Unix.hs +++ b/src/System/Metrics/Prometheus/Ridley/Metrics/CPU/Unix.hs @@ -5,6 +5,8 @@ , processCPULoad ) where +import Control.Applicative ((<|>)) +import Data.Maybe (fromJust) import qualified Data.Text as T import Data.Traversable import qualified Data.Vector as V @@ -16,11 +18,19 @@ -------------------------------------------------------------------------------- getLoadAvg :: IO (V.Vector Double) getLoadAvg = do - rawOutput <- shelly $ silently $ take 3 . T.lines . T.strip <$> run "cat" ["/proc/loadavg"] - let loads = case traverse (readMaybe . T.unpack) rawOutput of - Just [a,b,c] -> [a,b,c] - _ -> [-1.0, -1.0, -1.0] - return $ V.fromList loads + rawOutput <- shelly $ silently $ T.strip <$> run "cat" ["/proc/loadavg"] + let standardFormat = case traverse (readMaybe . T.unpack) (take 3 . T.lines $ rawOutput) of + Just [a,b,c] -> Just [a,b,c] + _ -> Nothing + + -- See: https://github.com/iconnect/ridley/issues/8 + let alternativeFormat = case traverse (readMaybe . T.unpack) (take 3 . T.splitOn " " $ rawOutput) of + Just [a,b,c] -> Just [a,b,c] + _ -> Nothing + + return . V.fromList . fromJust $ standardFormat <|> alternativeFormat <|> Just noAvgInfo + where + noAvgInfo = [-1.0, -1.0, -1.0] -------------------------------------------------------------------------------- -- | As we have 3 gauges, it makes no sense flushing them. diff --git a/src/System/Metrics/Prometheus/Ridley/Types.hs b/src/System/Metrics/Prometheus/Ridley/Types.hs --- a/src/System/Metrics/Prometheus/Ridley/Types.hs +++ b/src/System/Metrics/Prometheus/Ridley/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-} @@ -31,6 +32,7 @@ import Control.Monad.Reader (MonadReader) import Control.Monad.Trans.Class import Control.Monad.Trans.Reader +import Data.Monoid import qualified Data.Set as Set import qualified Data.Text as T import Data.Time @@ -46,16 +48,87 @@ type PrometheusOptions = AdapterOptions -------------------------------------------------------------------------------- +data RidleyMetricHandler = forall c. RidleyMetricHandler { + metric :: c + , updateMetric :: c -> Bool -> IO () + , flush :: !Bool + -- ^Whether or net to flush this Metric + } + +-------------------------------------------------------------------------------- data RidleyMetric = ProcessMemory - | CPULoad - | GHCConc - -- ^ Tap into the metrics exposed by GHC.Conc - | Network - | Wai - | DiskUsage - -- ^ Gets stats about Disk usage (free space, etc) - deriving (Show, Ord, Eq, Enum, Bounded) + | CPULoad + | GHCConc + -- ^ Tap into the metrics exposed by GHC.Conc + | Network + | Wai + | DiskUsage + -- ^ Gets stats about Disk usage (free space, etc) + | CustomMetric T.Text (forall m. MonadIO m => RidleyOptions -> P.RegistryT m RidleyMetricHandler) + -- ^ A user-defined metric, identified by a name. +instance Show RidleyMetric where + show ProcessMemory = "ProcessMemory" + show CPULoad = "CPULoad" + show GHCConc = "GHCConc" + show Network = "Network" + show Wai = "Wai" + show DiskUsage = "DiskUsage" + show (CustomMetric name _) = "Custom@" <> T.unpack name + +instance Eq RidleyMetric where + (==) ProcessMemory ProcessMemory = True + (==) CPULoad CPULoad = True + (==) GHCConc GHCConc = True + (==) Network Network = True + (==) Wai Wai = True + (==) DiskUsage DiskUsage = True + (==) (CustomMetric n1 _) (CustomMetric n2 _) = (==) n1 n2 + (==) _ _ = False + +instance Ord RidleyMetric where + compare ProcessMemory xs = case xs of + ProcessMemory -> EQ + _ -> GT + compare CPULoad xs = case xs of + ProcessMemory -> LT + CPULoad -> EQ + _ -> GT + compare GHCConc xs = case xs of + ProcessMemory -> LT + CPULoad -> LT + GHCConc -> EQ + _ -> GT + compare Network xs = case xs of + ProcessMemory -> LT + CPULoad -> LT + GHCConc -> LT + Network -> EQ + _ -> GT + compare Wai xs = case xs of + ProcessMemory -> LT + CPULoad -> LT + GHCConc -> LT + Network -> LT + Wai -> EQ + _ -> GT + compare DiskUsage xs = case xs of + ProcessMemory -> LT + CPULoad -> LT + GHCConc -> LT + Network -> LT + Wai -> LT + DiskUsage -> EQ + _ -> GT + compare (CustomMetric n1 _) xs = case xs of + ProcessMemory -> LT + CPULoad -> LT + GHCConc -> LT + Network -> LT + Wai -> LT + DiskUsage -> LT + (CustomMetric n2 _) -> compare n1 n2 + -------------------------------------------------------------------------------- data RidleyOptions = RidleyOptions { _prometheusOptions :: PrometheusOptions @@ -71,7 +144,7 @@ -------------------------------------------------------------------------------- defaultMetrics :: [RidleyMetric] -defaultMetrics = [minBound .. maxBound] +defaultMetrics = [ProcessMemory, CPULoad, GHCConc, Network, Wai, DiskUsage] -------------------------------------------------------------------------------- newOptions :: [(T.Text, T.Text)] @@ -83,14 +156,6 @@ , _katipSeverity = InfoS , _katipScribes = mempty , _dataRetentionPeriod = Nothing - } - --------------------------------------------------------------------------------- -data RidleyMetricHandler = forall c. RidleyMetricHandler { - metric :: c - , updateMetric :: c -> Bool -> IO () - , flush :: !Bool - -- ^Whether or net to flush this Metric } --------------------------------------------------------------------------------