diff --git a/arbor-monad-metric-datadog.cabal b/arbor-monad-metric-datadog.cabal --- a/arbor-monad-metric-datadog.cabal +++ b/arbor-monad-metric-datadog.cabal @@ -1,5 +1,5 @@ name: arbor-monad-metric-datadog -version: 0.0.3 +version: 1.0.0 description: Please see the README on Github at synopsis: Metric library backend for datadog. category: Metrics @@ -23,6 +23,8 @@ library exposed-modules: Arbor.Monad.Metric.Datadog + Arbor.Monad.Metric.Datadog.Internal + Arbor.Monad.Metric.Datadog.Internal.Show other-modules: Paths_arbor_monad_metric_datadog hs-source-dirs: @@ -32,7 +34,7 @@ build-depends: base >= 4.7 && < 5 , arbor-datadog >= 0.0.0 && < 0.1 - , arbor-monad-metric >= 0.0.2 && < 0.1 + , arbor-monad-metric >= 1.1.0 && < 1.2 , bytestring >= 0.10.8 && < 0.11 , containers >= 0.5.10 && < 0.6 , generic-lens >= 1.0.0.2 && < 1.2 @@ -49,10 +51,12 @@ type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: - Arbor.Monad.Metric.Datadog Arbor.Monad.Datadog.MetricApp Arbor.Monad.Datadog.MetricSpec Arbor.Monad.Datadog.UdpServer + Arbor.Monad.Metric.Datadog + Arbor.Monad.Metric.Datadog.Internal + Arbor.Monad.Metric.Datadog.Internal.Show Paths_arbor_monad_metric_datadog hs-source-dirs: test @@ -62,7 +66,7 @@ build-depends: base >= 4.7 && < 5 , arbor-datadog >= 0.0.0 && < 0.1 - , arbor-monad-metric >= 0.0.2 && < 0.1 + , arbor-monad-metric , arbor-monad-metric-datadog , bytestring >= 0.10.8 && < 0.11 , containers >= 0.5.10 && < 0.6 diff --git a/src/Arbor/Monad/Metric/Datadog.hs b/src/Arbor/Monad/Metric/Datadog.hs --- a/src/Arbor/Monad/Metric/Datadog.hs +++ b/src/Arbor/Monad/Metric/Datadog.hs @@ -7,57 +7,54 @@ , mkEvent ) where -import Arbor.Monad.Metric.Type (Counter (..), Gauge (..), MonadMetrics, getMetricMapTVar) +import Arbor.Monad.Metric.Datadog.Internal +import Arbor.Monad.Metric.Datadog.Internal.Show +import Arbor.Monad.Metric.Type (Counter, Gauge, MonadMetrics, getMetricMapTVar) import Control.Lens import Control.Monad.IO.Class import Data.Foldable import Data.Generics.Product.Any import Data.Proxy -import Data.Semigroup ((<>)) +import Data.Semigroup ((<>)) import qualified Arbor.Monad.Metric as C import qualified Arbor.Network.StatsD as S import qualified Arbor.Network.StatsD.Type as Z import qualified Control.Concurrent.STM as STM import qualified Data.Map.Strict as M +import qualified Data.Set as S import qualified Data.Text as T logStats :: (S.MonadStats m, MonadMetrics m) => m () logStats = do tCounterMap <- getMetricMapTVar (counters, _) <- liftIO . STM.atomically $ STM.swapTVar tCounterMap M.empty >>= C.extractValues (Proxy @Counter) - traverse_ S.sendMetric $ mkMetricsCounterTagged "counters" counters - traverse_ S.sendMetric $ mkMetricsCounterNonTagged counters + traverse_ S.sendMetric $ mkMetricsCounter counters tGaugeMap <- getMetricMapTVar (gauge, _) <- liftIO . STM.atomically $ STM.swapTVar tGaugeMap M.empty >>= C.extractValues (Proxy @Gauge) - traverse_ S.sendMetric $ mkMetricsGaugeTagged "gauge" gauge - traverse_ S.sendMetric $ mkMetricsGaugeNonTagged gauge + traverse_ S.sendMetric $ mkMetricsGauge gauge metricName :: String -> T.Text metricName n = T.replace " " "_" (T.pack n) --- create metric m, but tag with stat:[actual stat name] -mkMetricsGaugeTagged :: String -> [(Gauge, Double)] -> [Z.Metric] -mkMetricsGaugeTagged m = - fmap (\(Gauge n, i) -> S.gauge (Z.MetricName (metricName m)) id i & the @"tags" %~ ([S.tag "stat" (T.pack n)] ++)) - -- create metrics for each counter -mkMetricsGaugeNonTagged :: [(Gauge, Double)] -> [S.Metric] -mkMetricsGaugeNonTagged = - fmap (\(Gauge n, i) -> S.gauge (Z.MetricName (metricName n)) id i) - --- create metric m, but tag with stat:[actual stat name] -mkMetricsCounterTagged :: String -> [(Counter, Int)] -> [Z.Metric] -mkMetricsCounterTagged m = - fmap (\(Counter n, i) -> S.addCounter (Z.MetricName (metricName m)) id i & the @"tags" %~ ([S.tag "stat" (T.pack n)] ++)) +mkMetricsGauge :: [(Gauge, Double)] -> [S.Metric] +mkMetricsGauge = fmap (uncurry mkGauge) + where mkGauge :: Gauge -> Double -> S.Metric + mkGauge g v = S.gauge (Z.MetricName (metricName (T.unpack name))) id v & the @"tags" .~ (toStat <$> tags) + where name = g ^. the @"name" + tags = g ^. the @"tags" & S.toList -- create metrics for each counter -mkMetricsCounterNonTagged :: [(Counter, Int)] -> [S.Metric] -mkMetricsCounterNonTagged = - fmap (\(Counter n, i) -> S.addCounter (Z.MetricName (metricName n)) id i) +mkMetricsCounter :: [(Counter, Int)] -> [S.Metric] +mkMetricsCounter = fmap (uncurry mkCounter) + where mkCounter :: Counter -> Int -> S.Metric + mkCounter g v = S.addCounter (Z.MetricName (metricName (T.unpack name))) id v & the @"tags" .~ (toStat <$> tags) + where name = g ^. the @"name" + tags = g ^. the @"tags" & S.toList mkEvent :: [(String, Int)] -> String -> Z.Tag -> String -> Z.Event mkEvent stats etitle etag fn = S.event (T.pack etitle) desc & the @"tags" %~ ([etag] ++) where desc = T.intercalate "\n" $ T.pack <$> ("File processed: " <> fn) : info - info = (\(n, i) -> n <> ": " <> show i) <$> stats + info = (\(n, i) -> n <> ": " <> showInt i) <$> stats diff --git a/src/Arbor/Monad/Metric/Datadog/Internal.hs b/src/Arbor/Monad/Metric/Datadog/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Arbor/Monad/Metric/Datadog/Internal.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE TypeFamilies #-} + +module Arbor.Monad.Metric.Datadog.Internal where + +import qualified Arbor.Monad.Metric.Type as M +import qualified Arbor.Network.StatsD as S + +class ToStat a where + type StatType a + toStat :: a -> StatType a + +instance ToStat M.Tag where + type StatType M.Tag = S.Tag + toStat (M.Tag n v) = S.tag n v diff --git a/src/Arbor/Monad/Metric/Datadog/Internal/Show.hs b/src/Arbor/Monad/Metric/Datadog/Internal/Show.hs new file mode 100644 --- /dev/null +++ b/src/Arbor/Monad/Metric/Datadog/Internal/Show.hs @@ -0,0 +1,4 @@ +module Arbor.Monad.Metric.Datadog.Internal.Show where + +showInt :: Int -> String +showInt = show diff --git a/test/Arbor/Monad/Datadog/MetricSpec.hs b/test/Arbor/Monad/Datadog/MetricSpec.hs --- a/test/Arbor/Monad/Datadog/MetricSpec.hs +++ b/test/Arbor/Monad/Datadog/MetricSpec.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -6,16 +8,19 @@ ) where import Control.Concurrent -import Control.Exception (bracket) +import Control.Exception (bracket) +import Control.Lens +import Control.Monad import Control.Monad.IO.Class +import Data.Function +import Data.Generics.Product.Any import Data.Proxy -import Data.Semigroup ((<>)) +import Data.Semigroup ((<>)) import qualified Arbor.Monad.Datadog.MetricApp as A import qualified Arbor.Monad.Datadog.UdpServer as UDP import qualified Arbor.Monad.Metric as M import qualified Arbor.Monad.Metric.Datadog as M -import qualified Arbor.Monad.Metric.Type as M import qualified Control.Concurrent.STM as STM import qualified Data.ByteString.Char8 as BS import qualified Data.Map.Strict as MAP @@ -36,6 +41,9 @@ STM.atomically $ STM.modifyTVar tMsgs (msg:) putStrLn $ "From " ++ show addr ++ ": " ++ show msg +encodeMetrics :: [BS.ByteString] -> [BS.ByteString] +encodeMetrics = (:[]) . mconcat . fmap (<> "\n") + spec :: Spec spec = describe "Arbor.Monad.MetricSpec" $ do it "Metrics library actually sends statsd messages over UDP" $ requireTest $ do @@ -43,13 +51,18 @@ sock <- liftIO $ UDP.createUdpServer "5555" threadId <- liftIO $ forkIO $ UDP.runUdpServer sock (handler tMessages) liftIO $ threadDelay 1000000 - let counterExpected = "MetricApp.counters:10|c|#stat:test.counter\nMetricApp.test.counter:10|c\n" :: BS.ByteString - let gaugeExpected = "MetricApp.gauge:20.000000|g|#stat:test.gauge\nMetricApp.test.gauge:20.000000|g\n" :: BS.ByteString + -- let counterExpected = "MetricApp.counters:10|c|#stat:test.counter\nMetricApp.test.counter:10|c\n" :: BS.ByteString + -- let gaugeExpected = "MetricApp.gauge:20.000000|g|#stat:test.gauge\nMetricApp.test.gauge:20.000000|g\n" :: BS.ByteString liftIO $ A.runMetricApp $ do - M.metric (M.Counter "test.counter") 10 - M.metric (M.Gauge "test.gauge" ) 20 + M.metric (M.counter "test.counter" ) 10 + M.metric (M.gauge "test.gauge" ) 20 + M.metric (M.gauge "test.gauge" & the @"tags" .~ M.tags [("foo", "bar")]) 30 M.logStats liftIO $ threadDelay 3000000 liftIO $ killThread threadId - messages <- liftIO $ STM.readTVarIO tMessages - messages === [counterExpected <> gaugeExpected] + messages :: [BS.ByteString] <- liftIO $ STM.readTVarIO tMessages + mconcat (BS.lines <$> messages) === + [ "MetricApp.test.counter:10|c" + , "MetricApp.test.gauge:20.000000|g" + , "MetricApp.test.gauge:30.000000|g|#foo:bar" + ]