diff --git a/arbor-monad-metric.cabal b/arbor-monad-metric.cabal --- a/arbor-monad-metric.cabal +++ b/arbor-monad-metric.cabal @@ -1,5 +1,5 @@ name: arbor-monad-metric -version: 0.0.4 +version: 1.0.0 description: Please see the README on Github at synopsis: Core metric library for publishing metrics. category: Metrics @@ -39,6 +39,7 @@ , mtl >= 2.2.2 && < 2.3 , resourcet >= 1.2.1 && < 1.3 , stm >= 2.4.0 && < 2.6 + , text >= 1.2.3 && < 1.3 , transformers >= 0.5.2 && < 0.6 default-language: Haskell2010 @@ -46,11 +47,10 @@ type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: - Arbor.Monad.MetricSpec - Arbor.Monad.UdpServer Arbor.Monad.Metric Arbor.Monad.Metric.Generic Arbor.Monad.Metric.Type + Arbor.Monad.MetricSpec Paths_arbor_monad_metric hs-source-dirs: test @@ -72,5 +72,6 @@ , network , resourcet , stm + , text , transformers default-language: Haskell2010 diff --git a/src/Arbor/Monad/Metric.hs b/src/Arbor/Monad/Metric.hs --- a/src/Arbor/Monad/Metric.hs +++ b/src/Arbor/Monad/Metric.hs @@ -10,13 +10,17 @@ , Metrics(..) , newMetricsIO , extractValues + + , counter + , gauge ) where import Arbor.Monad.Metric.Generic (metric) -import Arbor.Monad.Metric.Type (Counter (..), Gauge (..), MetricFamily (..), MetricMap, Metrics (Metrics), MonadMetrics) +import Arbor.Monad.Metric.Type (Counter, Gauge, MetricFamily (..), MetricMap, Metrics (Metrics), MonadMetrics) import Control.Concurrent.STM.TVar import Control.Monad.STM (STM) import Data.Proxy +import Data.Text (Text) import qualified Arbor.Monad.Metric.Type as Z import qualified Control.Concurrent.STM as STM @@ -37,3 +41,9 @@ let tvars = M.elems m nums <- fmap (metricStateToValue pk <$>) . sequence $ readTVar <$> tvars return (zip names nums, tvars) + +counter :: Text -> Counter +counter name = Z.Counter name [] + +gauge :: Text -> Gauge +gauge name = Z.Gauge name [] diff --git a/src/Arbor/Monad/Metric/Type.hs b/src/Arbor/Monad/Metric/Type.hs --- a/src/Arbor/Monad/Metric/Type.hs +++ b/src/Arbor/Monad/Metric/Type.hs @@ -16,18 +16,21 @@ import Data.Generics.Product.Any import Data.Proxy import Data.Semigroup +import Data.Text (Text) import GHC.Generics import qualified Control.Concurrent.STM as STM import qualified Data.Map.Strict as M -newtype Counter = Counter - { name :: String - } deriving (Eq, Ord, Show) +data Counter = Counter + { name :: Text + , tags :: [Text] + } deriving (Eq, Ord, Show, Generic) -newtype Gauge = Gauge - { name :: String - } deriving (Eq, Ord, Show) +data Gauge = Gauge + { name :: Text + , tags :: [Text] + } deriving (Eq, Ord, Show, Generic) type MetricMap k v = M.Map k (STM.TVar v) diff --git a/test/Arbor/Monad/MetricSpec.hs b/test/Arbor/Monad/MetricSpec.hs --- a/test/Arbor/Monad/MetricSpec.hs +++ b/test/Arbor/Monad/MetricSpec.hs @@ -1,14 +1,26 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE TypeApplications #-} + module Arbor.Monad.MetricSpec ( spec ) 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.Generics.Product.Any +import Data.Proxy +import Data.Semigroup -import qualified Arbor.Monad.UdpServer as UDP +import qualified Arbor.Monad.Metric as M +import qualified Arbor.Monad.Metric.Type as MT +import qualified Arbor.Monad.MetricApp as A import qualified Control.Concurrent.STM as STM import qualified Data.ByteString.Char8 as BS +import qualified Data.Map.Strict as M import qualified Network.Socket as S hiding (recv, recvFrom, send, sendTo) import qualified Network.Socket.ByteString as S @@ -20,19 +32,24 @@ {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} {-# ANN module ("HLint: redundant bracket" :: String) #-} -handler :: STM.TVar [BS.ByteString] -> UDP.UdpHandler -handler tMsgs addr msg = do - STM.atomically $ STM.modifyTVar tMsgs (msg:) - putStrLn $ "From " ++ show addr ++ ": " ++ show msg - spec :: Spec spec = describe "Arbor.Monad.MetricSpec" $ do - it "Metrics library actually sends statsd messages over UDP" $ requireTest $ do - tMessages <- liftIO $ STM.newTVarIO [] - sock <- liftIO $ UDP.createUdpServer "5555" - threadId <- liftIO $ forkIO $ do - UDP.runUdpServer sock (handler tMessages) - liftIO $ threadDelay 1000000 - liftIO $ killThread threadId - messages <- liftIO $ STM.readTVarIO tMessages - messages === [] + it "Metrics library actually tracks metrics it receives" $ requireTest $ do + metrics <- liftIO $ A.runMetricApp $ do + M.metric (M.counter "test.counter" ) 10 + M.metric (M.gauge "test.gauge" ) 20 + M.metric (M.gauge "test.gauge" & the @"tags" .~ ["foo"]) 30 + MT.getMetrics + + countersMap <- liftIO $ STM.readTVarIO $ metrics ^. the @"counters" + gaugesMap <- liftIO $ STM.readTVarIO $ metrics ^. the @"gauges" + + counters <- liftIO $ STM.atomically $ fst <$> M.extractValues @MT.Counter Proxy countersMap + gauges <- liftIO $ STM.atomically $ fst <$> M.extractValues @MT.Gauge Proxy gaugesMap + + counters === [ (M.counter "test.counter" , 10) + ] + + gauges === [ (M.gauge "test.gauge" , 20) + , (M.gauge "test.gauge" & the @"tags" .~ ["foo"] , 30) + ] diff --git a/test/Arbor/Monad/UdpServer.hs b/test/Arbor/Monad/UdpServer.hs deleted file mode 100644 --- a/test/Arbor/Monad/UdpServer.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Arbor.Monad.UdpServer - ( createUdpServer - , runUdpServer - , UdpHandler - ) where - -import Network.Socket - -import qualified Data.ByteString as BS -import qualified Network.Socket.ByteString as BS - -type UdpHandler = SockAddr -> BS.ByteString -> IO () - -createUdpServer :: () - => String -- ^ Port number or name; 514 is default - -> IO Socket -createUdpServer port = withSocketsDo $ do - addrinfos <- getAddrInfo - (Just (defaultHints {addrFlags = [AI_PASSIVE]})) - Nothing (Just port) - let serveraddr = head addrinfos - - sock <- socket (addrFamily serveraddr) Datagram defaultProtocol - - bind sock (addrAddress serveraddr) - return sock - -runUdpServer :: () - => Socket - -> UdpHandler - -> IO () -runUdpServer sock handler = withSocketsDo $ procMessages sock - where procMessages sock = do - (msg, addr) <- BS.recvFrom sock 1024 - handler addr msg - procMessages sock