diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,8 @@ +# CHANGELOG + +# Upcoming... + +# v0.0.1.5 + +- Batch metric requests to Cloudwatch, resulting in cheaper operations. + diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,20 @@ +# `ekg-cloudwatch` + +Register a thread, and suddenly all your [`ekg`][ekg] metrics get pushed to Amazon CloudWatch. Neat! + +Inspired (and copied) from the [`ekg-statsd`][ekg-statsd] package. + +# Usage: + +Pass your EKG `Store` and the Amazonka `Env` to the function: + +```haskell +import System.Metrics as EKG +import Network.AWS as AWS + +register :: EKG.Store -> AWS.Env -> IO CloudWatchId +register store env = + forkCloudWatch + (defaultCloudWatchEnv "MyApplication" env) + store +``` diff --git a/ekg-cloudwatch.cabal b/ekg-cloudwatch.cabal --- a/ekg-cloudwatch.cabal +++ b/ekg-cloudwatch.cabal @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.14.1. +-- This file has been generated from package.yaml by hpack version 0.17.1. -- -- see: https://github.com/sol/hpack name: ekg-cloudwatch -version: 0.0.1.4 +version: 0.0.1.5 synopsis: An ekg backend for Amazon Cloudwatch description: Push ekg metrics to Amazon Cloudwatch homepage: https://github.com/sellerlabs/ekg-cloudwatch#readme @@ -17,6 +17,10 @@ build-type: Simple cabal-version: >= 1.10 +extra-source-files: + CHANGELOG.md + README.md + source-repository head type: git location: https://github.com/sellerlabs/ekg-cloudwatch @@ -27,12 +31,17 @@ build-depends: base >=4.7 && <5 , ekg-core >= 0.1 && < 1.0 - , amazonka - , amazonka-cloudwatch + , amazonka >= 1.0.0 + , amazonka-core >= 1.0.0 + , amazonka-cloudwatch >= 1.0.0 + , aeson + , semigroups + , bytestring + , lens + , resourcet + , text , time , unordered-containers - , text - , lens exposed-modules: System.Remote.Monitoring.CloudWatch default-language: Haskell2010 @@ -45,12 +54,17 @@ build-depends: base >=4.7 && <5 , ekg-core >= 0.1 && < 1.0 - , amazonka - , amazonka-cloudwatch + , amazonka >= 1.0.0 + , amazonka-core >= 1.0.0 + , amazonka-cloudwatch >= 1.0.0 + , aeson + , semigroups + , bytestring + , lens + , resourcet + , text , time , unordered-containers - , text - , lens , base , ekg-cloudwatch , hspec diff --git a/src/System/Remote/Monitoring/CloudWatch.hs b/src/System/Remote/Monitoring/CloudWatch.hs --- a/src/System/Remote/Monitoring/CloudWatch.hs +++ b/src/System/Remote/Monitoring/CloudWatch.hs @@ -21,17 +21,25 @@ myThreadId, threadDelay) import Control.Exception import Control.Lens -import Control.Monad (void, guard, forM_) +import Control.Monad (forM_, guard, void) +import Data.Aeson +import qualified Data.ByteString as BS import qualified Data.HashMap.Strict as Map import Data.Int (Int64) +import Data.List (foldl') +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Maybe (mapMaybe) 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 Data.Traversable (for) import Network.AWS as AWS import Network.AWS.CloudWatch as AWS +import Network.AWS.Data.ByteString +import Network.AWS.Data.Query import System.IO (stderr) import qualified System.Metrics as Metrics import qualified System.Metrics.Distribution.Internal as Distribution @@ -121,7 +129,7 @@ Just old -> case diffMetric old new of Just val -> Map.insert name val m - Nothing -> m + Nothing -> m _ -> Map.insert name new m diffMetric :: Metrics.Value -> Metrics.Value -> Maybe Metrics.Value @@ -141,36 +149,61 @@ d2 {Distribution.count = Distribution.count d2 - Distribution.count d1} diffMetric _ _ = Nothing -flushSample :: CloudWatchEnv -> Metrics.Sample -> IO () -flushSample CloudWatchEnv{..} = void . Map.traverseWithKey flushMetric +metricToDatum :: [Dimension] -> Text -> Metrics.Value -> Maybe MetricDatum +metricToDatum dim name val = case val of + Metrics.Counter n -> + Just $ mkDatum (mdValue ?~ fromIntegral n) + Metrics.Gauge n -> + Just $ mkDatum (mdValue ?~ fromIntegral n) + Metrics.Distribution d -> + fmap (\dist -> mkDatum (mdStatisticValues ?~ dist)) (conv d) + Metrics.Label l -> + Nothing 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 -> - forM_ (conv d) $ \dist -> - sendMetric name (mdStatisticValues ?~ dist) - 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 () + mkDatum k = + metricDatum name & mdDimensions .~ dim & k conv :: Distribution.Stats -> Maybe StatisticSet conv Distribution.Stats {..} = do guard (count > 0) pure (statisticSet (fromIntegral count) sum min max) + +weighDatum :: MetricDatum -> Int +weighDatum = BS.length . toBS . toQueryList "member" . (:[]) + +data SplitAcc = SplitAcc + { splitAccData :: !(NonEmpty [MetricDatum]) + , splitAccSize :: !Int + } + +splitAt40KB :: [MetricDatum] -> NonEmpty [MetricDatum] +splitAt40KB = splitAccData . foldl' go (SplitAcc ([] :| []) 0) + where + limit = 40000 + fudge = 2000 + safety = limit - fudge + go (SplitAcc (acc :| accs) size) x + | size + weight >= safety = + SplitAcc ((x : acc) :| accs) (size + weight) + | otherwise = + SplitAcc ([x] :| (acc : accs)) 0 + where + weight = weighDatum x + + +flushSample :: CloudWatchEnv -> Metrics.Sample -> IO () +flushSample CloudWatchEnv{..} = void + . sendMetric + . mapMaybe (uncurry (metricToDatum cweDimensions)) + . Map.toList + where + sendMetric :: [MetricDatum] -> IO () + sendMetric metrics = do + -- TODO: This call is limited to 40KB in size. Any larger and it will + -- whine. + e <- trying _Error . void . runResourceT . runAWS cweAwsEnv . + forM_ (splitAt40KB metrics) $ \metrics -> + send (putMetricData cweNamespace & pmdMetricData .~ metrics) + case e of + Left err -> cweOnError err + Right _ -> pure ()