ekg-cloudwatch 0.0.1.4 → 0.0.1.5
raw patch · 4 files changed
+114/−39 lines, 4 filesdep +aesondep +amazonka-coredep +bytestringdep ~amazonkadep ~amazonka-cloudwatchPVP ok
version bump matches the API change (PVP)
Dependencies added: aeson, amazonka-core, bytestring, resourcet, semigroups
Dependency ranges changed: amazonka, amazonka-cloudwatch
API changes (from Hackage documentation)
Files
- CHANGELOG.md +8/−0
- README.md +20/−0
- ekg-cloudwatch.cabal +24/−10
- src/System/Remote/Monitoring/CloudWatch.hs +62/−29
+ CHANGELOG.md view
@@ -0,0 +1,8 @@+# CHANGELOG++# Upcoming...++# v0.0.1.5++- Batch metric requests to Cloudwatch, resulting in cheaper operations.+
+ README.md view
@@ -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+```
ekg-cloudwatch.cabal view
@@ -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
src/System/Remote/Monitoring/CloudWatch.hs view
@@ -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 ()