diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2016 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/ekg-prometheus-adapter.cabal b/ekg-prometheus-adapter.cabal new file mode 100644 --- /dev/null +++ b/ekg-prometheus-adapter.cabal @@ -0,0 +1,39 @@ +name: ekg-prometheus-adapter +version: 0.1.0.0 +synopsis: Initial project template from stack +description: Please see README.md +homepage: https://github.com/githubuser/ekg-prometheus-adapter#readme +license: BSD3 +license-file: LICENSE +author: Author name here +maintainer: example@example.com +copyright: 2016 Author name here +category: Web +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: System.Remote.Monitoring.Prometheus + build-depends: base >= 4.7 && < 5 + , prometheus < 0.5.0 + , ekg-core < 0.2.0.0 + , unordered-containers < 0.3.0.0 + , containers < 0.6.0.0 + , text < 1.3.0.0 + , transformers + default-language: Haskell2010 + +test-suite tests + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , ekg-prometheus-adapter + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/githubuser/ekg-prometheus-adapter diff --git a/src/System/Remote/Monitoring/Prometheus.hs b/src/System/Remote/Monitoring/Prometheus.hs new file mode 100644 --- /dev/null +++ b/src/System/Remote/Monitoring/Prometheus.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +module System.Remote.Monitoring.Prometheus + ( toPrometheusRegistry + , registerEKGStore + , AdapterOptions(..) + , defaultOptions + ) where + +import Control.Concurrent (forkIO, threadDelay) +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Trans.State.Strict +import qualified Data.HashMap.Strict as HMap +import qualified Data.Map.Strict as Map +import Data.Monoid +import qualified Data.Text as T +import qualified System.Metrics as EKG +import qualified System.Metrics.Prometheus.Metric.Counter as Counter +import qualified System.Metrics.Prometheus.Metric.Gauge as Gauge +import qualified System.Metrics.Prometheus.MetricId as Prometheus +import qualified System.Metrics.Prometheus.Registry as Prometheus +import System.Metrics.Prometheus.RegistryT (RegistryT(..)) + +-------------------------------------------------------------------------------- +data AdapterOptions = AdapterOptions { + labels :: Prometheus.Labels + , namespace :: Maybe T.Text + , samplingFrequency :: !Int + -- ^ How often update the registry (in seconds). + } + +-------------------------------------------------------------------------------- +data Metric = + C Counter.Counter + | G Gauge.Gauge + +type MetricsMap = Map.Map Prometheus.Name Metric + +-------------------------------------------------------------------------------- +defaultOptions :: Prometheus.Labels -> AdapterOptions +defaultOptions l = AdapterOptions l Nothing 15 + +-------------------------------------------------------------------------------- +registerEKGStore :: MonadIO m => EKG.Store -> AdapterOptions -> RegistryT m () +registerEKGStore store opts = RegistryT $ StateT $ \_ -> do + (r, mmap) <- liftIO $ toPrometheusRegistry' store opts + liftIO $ forkIO $ do + let loop = forever $ do + threadDelay (samplingFrequency opts * 10^6) + updateMetrics store opts mmap + loop + loop + return ((), r) + +-------------------------------------------------------------------------------- +toPrometheusRegistry' :: EKG.Store -> AdapterOptions -> IO (Prometheus.Registry, MetricsMap) +toPrometheusRegistry' store opts = do + let registry = Prometheus.new + samples <- EKG.sampleAll store + foldM (mkMetric opts) (registry, Map.empty) (HMap.toList samples) + +-------------------------------------------------------------------------------- +toPrometheusRegistry :: EKG.Store -> AdapterOptions -> IO Prometheus.Registry +toPrometheusRegistry store opts = fst <$> toPrometheusRegistry' store opts + +-------------------------------------------------------------------------------- +mkMetric :: AdapterOptions -> (Prometheus.Registry, MetricsMap) -> (T.Text, EKG.Value) -> IO (Prometheus.Registry, MetricsMap) +mkMetric AdapterOptions{..} (oldRegistry, mmap) (key, value) = do + let k = mkKey namespace key + case value of + EKG.Counter c -> do + (counter, newRegistry) <- Prometheus.registerCounter k labels oldRegistry + Counter.add (fromIntegral c) counter + return $! (newRegistry, Map.insert k (C counter) $! mmap) + EKG.Gauge g -> do + (gauge, newRegistry) <- Prometheus.registerGauge k labels oldRegistry + Gauge.set (fromIntegral g) gauge + return $! (newRegistry, Map.insert k (G gauge) $! mmap) + EKG.Label _ -> return $! (oldRegistry, mmap) + EKG.Distribution _ -> return $! (oldRegistry, mmap) + +-------------------------------------------------------------------------------- +updateMetrics :: EKG.Store -> AdapterOptions -> MetricsMap -> IO () +updateMetrics store opts mmap = do + samples <- EKG.sampleAll store + const () <$> foldM (updateMetric opts) mmap (HMap.toList samples) + + +-------------------------------------------------------------------------------- +mkKey :: Maybe T.Text -> T.Text -> Prometheus.Name +mkKey mbNs k = + Prometheus.Name $ (maybe mempty (\x -> x <> "_") mbNs) <> T.replace "." "_" k + +-------------------------------------------------------------------------------- +updateMetric :: AdapterOptions -> MetricsMap -> (T.Text, EKG.Value) -> IO MetricsMap +updateMetric AdapterOptions{..} mmap (key, value) = do + let k = mkKey namespace key + case liftM2 (,) (Map.lookup k mmap) (Just value) of + Just (C counter, EKG.Counter c) -> do + (Counter.CounterSample oldCounterValue) <- Counter.sample counter + let slack = c - fromIntegral oldCounterValue + when (slack >= 0) $ Counter.add (fromIntegral slack) counter + return $! mmap + Just (G gauge, EKG.Gauge g) -> do + Gauge.set (fromIntegral g) gauge + return $! mmap + _ -> return mmap diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"