diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,9 @@ -# arbor-monad-metric +# arbor-monad-metric-datadog -[![CircleCI](https://circleci.com/gh/arbor/arbor-monad-metric.svg?style=svg)](https://circleci.com/gh/arbor/arbor-monad-metric) +[![CircleCI](https://circleci.com/gh/arbor/arbor-monad-metric-datadog.svg?style=svg)](https://circleci.com/gh/arbor/arbor-monad-metric-datadog) -This is a fork of `arbor-monad-counter` into a module namespace to add support for varied metric types. -The `arbor-monad-counter` is retained for backwards compatibility. +This is a fork of `arbor-monad-counter-datadog` into a module namespace to add support for varied metric types. +The `arbor-monad-counter-datadog` library is retained for backwards compatibility. + +# Release +Bump the version in the `*.cabal` version; create a new commit “New version x.x.x.x`, wait for tagged build in CI and find a link to hackage in the build output and open it. Log in with hackage credentials if necessary, then click “publish candidate” 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,7 +1,8 @@ name: arbor-monad-metric-datadog -version: 0.0.1 +version: 0.0.3 description: Please see the README on Github at -category: Services +synopsis: Metric library backend for datadog. +category: Metrics homepage: https://github.com/arbor/arbor-monad-metric-datadog#readme bug-reports: https://github.com/arbor/arbor-monad-metric-datadog/issues author: Arbor Networks @@ -34,12 +35,12 @@ , arbor-monad-metric >= 0.0.2 && < 0.1 , bytestring >= 0.10.8 && < 0.11 , containers >= 0.5.10 && < 0.6 - , generic-lens >= 1.1.0 && < 1.2 - , lens >= 4.17 && < 4.18 + , generic-lens >= 1.0.0.2 && < 1.2 + , lens >= 4.16 && < 4.18 , mtl >= 2.2.2 && < 2.3 - , network >= 2.8.0 && < 2.9 - , resourcet >= 1.2.2 && < 1.3 - , stm >= 2.5.0 && < 2.6 + , network >= 2.6.0 && < 2.9 + , 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 @@ -48,9 +49,10 @@ type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: - Arbor.Monad.MetricSpec - Arbor.Monad.UdpServer Arbor.Monad.Metric.Datadog + Arbor.Monad.Datadog.MetricApp + Arbor.Monad.Datadog.MetricSpec + Arbor.Monad.Datadog.UdpServer Paths_arbor_monad_metric_datadog hs-source-dirs: test @@ -64,11 +66,14 @@ , arbor-monad-metric-datadog , bytestring >= 0.10.8 && < 0.11 , containers >= 0.5.10 && < 0.6 + , exceptions + , fast-logger , generic-lens >= 1.1.0 && < 1.2 , hedgehog >= 0.6.1 && < 0.7 , hspec >= 2.6.0 && < 2.7 , hw-hspec-hedgehog >= 0.1.0.4 && < 0.2 , lens >= 4.17 && < 4.18 + , monad-logger , mtl >= 2.2.2 && < 2.3 , network >= 2.8.0 && < 2.9 , resourcet >= 1.2.2 && < 1.3 diff --git a/test/Arbor/Monad/Datadog/MetricApp.hs b/test/Arbor/Monad/Datadog/MetricApp.hs new file mode 100644 --- /dev/null +++ b/test/Arbor/Monad/Datadog/MetricApp.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +module Arbor.Monad.Datadog.MetricApp + ( runMetricApp + ) where + +import Arbor.Monad.Metric +import Control.Monad.Catch +import Control.Monad.Logger (LoggingT, MonadLogger, runLoggingT) +import Control.Monad.Reader +import Data.Generics.Product.Any +import GHC.Generics +import System.Log.FastLogger + +import qualified Arbor.Network.StatsD as S +import qualified Arbor.Network.StatsD.Type as Z + +data MiniConfig = MiniConfig + { metrics :: Metrics + , statsClient :: Z.StatsClient + } deriving (Generic) + +instance MonadMetrics MetricApp where + getMetrics = reader metrics + +instance S.MonadStats MetricApp where + getStatsClient = reader statsClient + +newtype MetricApp a = MetricApp + { unMetricApp :: ReaderT MiniConfig (LoggingT IO) a + } + deriving ( Functor + , Applicative + , Monad + , MonadIO + , MonadThrow + , MonadCatch + , MonadLogger + , MonadReader MiniConfig) + +runMetricApp :: MetricApp () -> IO () +runMetricApp f = do + let statsOpts = Z.DogStatsSettings "localhost" 5555 + statsClient <- S.createStatsClient statsOpts (Z.MetricName "MetricApp") [] + metrics <- newMetricsIO + let config = MiniConfig metrics statsClient + runLoggingT (runReaderT (unMetricApp f) config) $ \_ _ _ _ -> return () diff --git a/test/Arbor/Monad/Datadog/MetricSpec.hs b/test/Arbor/Monad/Datadog/MetricSpec.hs new file mode 100644 --- /dev/null +++ b/test/Arbor/Monad/Datadog/MetricSpec.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Arbor.Monad.Datadog.MetricSpec + ( spec + ) where + +import Control.Concurrent +import Control.Exception (bracket) +import Control.Monad.IO.Class +import Data.Proxy +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 +import qualified Network.Socket as S hiding (recv, recvFrom, send, sendTo) +import qualified Network.Socket.ByteString as S +import qualified System.IO as IO + +import HaskellWorks.Hspec.Hedgehog +import Hedgehog +import Test.Hspec + +{-# ANN module ("HLint: ignore Redundant do" :: String) #-} +{-# 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 $ 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 + liftIO $ A.runMetricApp $ do + M.metric (M.Counter "test.counter") 10 + M.metric (M.Gauge "test.gauge" ) 20 + M.logStats + liftIO $ threadDelay 3000000 + liftIO $ killThread threadId + messages <- liftIO $ STM.readTVarIO tMessages + messages === [counterExpected <> gaugeExpected] diff --git a/test/Arbor/Monad/Datadog/UdpServer.hs b/test/Arbor/Monad/Datadog/UdpServer.hs new file mode 100644 --- /dev/null +++ b/test/Arbor/Monad/Datadog/UdpServer.hs @@ -0,0 +1,36 @@ +module Arbor.Monad.Datadog.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 diff --git a/test/Arbor/Monad/MetricSpec.hs b/test/Arbor/Monad/MetricSpec.hs deleted file mode 100644 --- a/test/Arbor/Monad/MetricSpec.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Arbor.Monad.MetricSpec - ( spec - ) where - -import Control.Exception (bracket) -import Control.Monad.IO.Class - -import qualified Arbor.Monad.UdpServer as UDP -import qualified Data.ByteString.Char8 as BS -import qualified Network.Socket as S hiding (recv, recvFrom, send, sendTo) -import qualified Network.Socket.ByteString as S - -import HaskellWorks.Hspec.Hedgehog -import Hedgehog -import Test.Hspec - -{-# ANN module ("HLint: ignore Redundant do" :: String) #-} -{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} -{-# ANN module ("HLint: redundant bracket" :: String) #-} - -plainHandler :: UDP.UdpHandler -plainHandler addr msg = putStrLn $ "From " ++ show addr ++ ": " ++ show msg - -spec :: Spec -spec = describe "Arbor.Monad.MetricSpec" $ do - it "" $ do - -- liftIO $ UDP.runUdpServer "5555" plainHandler - True `shouldBe` True 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,31 +0,0 @@ -module Arbor.Monad.UdpServer - ( 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 () - -runUdpServer :: () - => String -- ^ Port number or name; 514 is default - -> UdpHandler -- ^ Function to handle incoming messages - -> IO () -runUdpServer port handler = 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) - - procMessages sock - where procMessages sock = do - (msg, addr) <- BS.recvFrom sock 1024 - handler addr msg - procMessages sock