ekg-cloudwatch (empty) → 0.0.1.3
raw patch · 5 files changed
+264/−0 lines, 5 filesdep +amazonkadep +amazonka-cloudwatchdep +basesetup-changed
Dependencies added: amazonka, amazonka-cloudwatch, base, ekg-cloudwatch, ekg-core, hspec, lens, text, time, unordered-containers
Files
- LICENSE +28/−0
- Setup.hs +2/−0
- ekg-cloudwatch.cabal +58/−0
- src/System/Remote/Monitoring/CloudWatch.hs +175/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2016, Seller Labs++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the copyright holder nor the names of its 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 HOLDER 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ekg-cloudwatch.cabal view
@@ -0,0 +1,58 @@+-- This file has been generated from package.yaml by hpack version 0.14.1.+--+-- see: https://github.com/sol/hpack++name: ekg-cloudwatch+version: 0.0.1.3+synopsis: An ekg backend for Amazon Cloudwatch+description: Push ekg metrics to Amazon Cloudwatch+homepage: https://github.com/sellerlabs/ekg-cloudwatch#readme+bug-reports: https://github.com/sellerlabs/ekg-cloudwatch/issues+license: BSD3+license-file: LICENSE+author: Matt Parsons+maintainer: matt@sellerlabs.com+copyright: 2016 Seller Labs+category: Web+build-type: Simple+cabal-version: >= 1.10++source-repository head+ type: git+ location: https://github.com/sellerlabs/ekg-cloudwatch++library+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , ekg-core >= 0.1 && < 1.0+ , amazonka+ , amazonka-cloudwatch+ , time+ , unordered-containers+ , text+ , lens+ exposed-modules:+ System.Remote.Monitoring.CloudWatch+ default-language: Haskell2010++test-suite ekg-cloudwatch-test+ type: exitcode-stdio-1.0+ hs-source-dirs:+ test+ main-is: Spec.hs+ build-depends:+ base >=4.7 && <5+ , ekg-core >= 0.1 && < 1.0+ , amazonka+ , amazonka-cloudwatch+ , time+ , unordered-containers+ , text+ , lens+ , base+ , ekg-cloudwatch+ , hspec+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010
+ src/System/Remote/Monitoring/CloudWatch.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE RecordWildCards #-}++-- | This module allows you to periodically push your 'ekg' metrics to the+-- Amazon CloudWatch backend. Inspired by the 'ekg-statsd' module.+--+-- To use, run 'forkCloudWatch' with the 'CloudWatchEnv' and metrics 'Store'.+module System.Remote.Monitoring.CloudWatch+ ( CloudWatchId+ , cloudWatchThreadId+ , forkCloudWatch+ , CloudWatchEnv(..)+ , defaultCloudWatchEnv+ ) where++import Control.Concurrent (ThreadId, forkFinally,+ myThreadId, threadDelay)+import Control.Exception+import Control.Lens+import Control.Monad (void, guard)+import qualified Data.HashMap.Strict as Map+import Data.Int (Int64)+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import Data.Time (NominalDiffTime)+import Data.Time.Clock.POSIX (getPOSIXTime)+import Network.AWS as AWS+import Network.AWS.CloudWatch as AWS+import System.IO (stderr)+import qualified System.Metrics as Metrics+import qualified System.Metrics.Distribution.Internal as Distribution++-- | The 'ThreadID' for the 'CloudWatch' process.+newtype CloudWatchId = CloudWatchId+ { cloudWatchThreadId :: ThreadId+ }++-- | The environment for the CloudWatch EKG metric pusher.+data CloudWatchEnv = CloudWatchEnv+ { cweFlushInterval :: !Int+ -- ^ The interval of time to flush, in milliseconds.+ , cweAwsEnv :: !AWS.Env+ -- ^ The AWS Environment that connects to the CloudWatch services.+ , cweDimensions :: ![AWS.Dimension]+ -- ^ The extra dimensions to pass for each metric. These can be used to+ -- configure process-level metric information, like "ServerGroup",+ -- "RegionName", "Environment", etc.+ , cweNamespace :: !Text+ -- ^ The namespace that the service runs in.+ , cweOnError :: !(forall e. Exception e => e -> IO ())+ -- ^ The function used to handle exceptions coming from 'amazonka' library.+ }++-- | The default 'CloudWatchEnv', requiring an Amazon environment and namespace.+-- Equal to:+-- @+-- 'CloudWatchEnv'+-- { 'cweFlushInterval' = 1000+-- , 'cweAwsEnv' = x+-- , 'cweNamespace' = namespace+-- , 'cweDimensions' = []+-- , 'cweOnError' = 'defaultOnError'+-- }+-- @+defaultCloudWatchEnv :: Text -> AWS.Env -> CloudWatchEnv+defaultCloudWatchEnv namespace x =+ CloudWatchEnv+ { cweFlushInterval = 1000+ , cweAwsEnv = x+ , cweNamespace = namespace+ , cweDimensions = []+ , cweOnError = defaultOnError+ }++-- | The default error handler is to 'show' the exception and log it to+-- @stderr@.+defaultOnError :: Exception e => e -> IO ()+defaultOnError =+ Text.hPutStrLn stderr . Text.pack . show . toException++-- | Use this if you don't want to do anything with the error.+swallowOnError :: Exception e => e -> IO ()+swallowOnError _ = pure ()++-- | Forks a thread to periodically publish metrics to Amazon's CloudWatch+-- service for the given 'Store'.+forkCloudWatch :: CloudWatchEnv -> Metrics.Store -> IO CloudWatchId+forkCloudWatch env store = do+ me <- myThreadId+ fmap CloudWatchId . forkFinally (loop env store mempty) $ \case+ Left e -> throwTo me e+ Right _ -> pure ()++loop :: CloudWatchEnv -> Metrics.Store -> Metrics.Sample -> IO ()+loop env store lastSample = do+ start <- time+ sample <- Metrics.sampleAll store+ flushSample env (diffSamples lastSample sample)+ end <- time+ threadDelay (cweFlushInterval env * 1000 - fromIntegral (end - start))+ loop env store sample++-- | Microseconds since epoch. Vendored from `ekg-statsd`+time :: IO Int64+time = round . (* 1000000.0) . toDouble <$> getPOSIXTime+ where+ toDouble = realToFrac :: NominalDiffTime -> Double++-- | Vendored from `ekg-statsd`+diffSamples :: Metrics.Sample -> Metrics.Sample -> Metrics.Sample+diffSamples prev !curr = Map.foldlWithKey' combine Map.empty curr+ where+ combine m name new =+ case Map.lookup name prev of+ Just old ->+ case diffMetric old new of+ Just val -> Map.insert name val m+ Nothing -> m+ _ -> Map.insert name new m++ diffMetric :: Metrics.Value -> Metrics.Value -> Maybe Metrics.Value+ diffMetric (Metrics.Counter n1) (Metrics.Counter n2)+ | n1 == n2 = Nothing+ | otherwise = Just $! Metrics.Counter $ n2 - n1+ diffMetric (Metrics.Gauge n1) (Metrics.Gauge n2)+ | n1 == n2 = Nothing+ | otherwise = Just $ Metrics.Gauge n2+ diffMetric (Metrics.Label n1) (Metrics.Label n2)+ | n1 == n2 = Nothing+ | otherwise = Just $ Metrics.Label n2+ diffMetric (Metrics.Distribution d1) (Metrics.Distribution d2)+ | Distribution.count d1 == Distribution.count d2 = Nothing+ | otherwise =+ Just . Metrics.Distribution $+ d2 {Distribution.count = Distribution.count d2 - Distribution.count d1}+ diffMetric _ _ = Nothing++flushSample :: CloudWatchEnv -> Metrics.Sample -> IO ()+flushSample CloudWatchEnv{..} = void . Map.traverseWithKey flushMetric+ where+ flushMetric :: Text -> Metrics.Value -> IO ()+ flushMetric name =+ \case+ Metrics.Counter n ->+ sendMetric name (mdValue ?~ fromIntegral n)+ Metrics.Gauge n ->+ sendMetric name (mdValue ?~ fromIntegral n)+ Metrics.Distribution d ->+ sendMetric name (mdStatisticValues .~ conv d)+ Metrics.Label l ->+ pure ()++ sendMetric :: Text -> (MetricDatum -> MetricDatum) -> IO ()+ sendMetric name k = do+ e <- trying _Error . void . runResourceT . runAWS cweAwsEnv . send $+ putMetricData cweNamespace+ & pmdMetricData .~+ [ metricDatum name+ & mdDimensions .~ cweDimensions+ & k+ ]+ case e of+ Left err -> cweOnError err+ Right _ -> pure ()++ conv :: Distribution.Stats -> Maybe StatisticSet+ conv Distribution.Stats {..} = do+ guard (count > 0)+ pure (statisticSet (fromIntegral count) sum min max)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}