diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. 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-cloudwatch.cabal b/ekg-cloudwatch.cabal new file mode 100644 --- /dev/null +++ b/ekg-cloudwatch.cabal @@ -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 diff --git a/src/System/Remote/Monitoring/CloudWatch.hs b/src/System/Remote/Monitoring/CloudWatch.hs new file mode 100644 --- /dev/null +++ b/src/System/Remote/Monitoring/CloudWatch.hs @@ -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) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}