packages feed

arbor-monad-metric-datadog 0.0.1 → 0.0.3

raw patch · 7 files changed

+163/−72 lines, 7 filesdep +exceptionsdep +fast-loggerdep +monad-loggerdep ~generic-lensdep ~lensdep ~networkPVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions, fast-logger, monad-logger

Dependency ranges changed: generic-lens, lens, network, resourcet, stm

API changes (from Hackage documentation)

Files

README.md view
@@ -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”
arbor-monad-metric-datadog.cabal view
@@ -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 <https://github.com/arbor/arbor-monad-metric-datadog#readme>-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
+ test/Arbor/Monad/Datadog/MetricApp.hs view
@@ -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 ()
+ test/Arbor/Monad/Datadog/MetricSpec.hs view
@@ -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]
+ test/Arbor/Monad/Datadog/UdpServer.hs view
@@ -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
− test/Arbor/Monad/MetricSpec.hs
@@ -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
− test/Arbor/Monad/UdpServer.hs
@@ -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