arbor-monad-metric-datadog (empty) → 0.0.1
raw patch · 9 files changed
+233/−0 lines, 9 filesdep +arbor-datadogdep +arbor-monad-metricdep +arbor-monad-metric-datadogsetup-changed
Dependencies added: arbor-datadog, arbor-monad-metric, arbor-monad-metric-datadog, base, bytestring, containers, generic-lens, hedgehog, hspec, hw-hspec-hedgehog, lens, mtl, network, resourcet, stm, text, transformers
Files
- ChangeLog.md +3/−0
- LICENSE +21/−0
- README.md +6/−0
- Setup.hs +2/−0
- arbor-monad-metric-datadog.cabal +78/−0
- src/Arbor/Monad/Metric/Datadog.hs +63/−0
- test/Arbor/Monad/MetricSpec.hs +28/−0
- test/Arbor/Monad/UdpServer.hs +31/−0
- test/Spec.hs +1/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for arbor-monad-metric++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018 Arbor Networks++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,6 @@+# arbor-monad-metric++[](https://circleci.com/gh/arbor/arbor-monad-metric)++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ arbor-monad-metric-datadog.cabal view
@@ -0,0 +1,78 @@+name: arbor-monad-metric-datadog+version: 0.0.1+description: Please see the README on Github at <https://github.com/arbor/arbor-monad-metric-datadog#readme>+category: Services+homepage: https://github.com/arbor/arbor-monad-metric-datadog#readme+bug-reports: https://github.com/arbor/arbor-monad-metric-datadog/issues+author: Arbor Networks+maintainer: mayhem@arbor.net+copyright: Arbor Networks+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10+extra-source-files:+ ChangeLog.md+ README.md++source-repository head+ type: git+ location: https://github.com/arbor/arbor-monad-metric-datadog++library+ exposed-modules:+ Arbor.Monad.Metric.Datadog+ other-modules:+ Paths_arbor_monad_metric_datadog+ hs-source-dirs:+ src+ default-extensions: BangPatterns FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings TupleSections+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+ build-depends:+ base >= 4.7 && < 5+ , arbor-datadog >= 0.0.0 && < 0.1+ , 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+ , mtl >= 2.2.2 && < 2.3+ , network >= 2.8.0 && < 2.9+ , resourcet >= 1.2.2 && < 1.3+ , stm >= 2.5.0 && < 2.6+ , text >= 1.2.3 && < 1.3+ , transformers >= 0.5.2 && < 0.6+ default-language: Haskell2010++test-suite arbor-monad-metric-datadog-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Arbor.Monad.MetricSpec+ Arbor.Monad.UdpServer+ Arbor.Monad.Metric.Datadog+ Paths_arbor_monad_metric_datadog+ hs-source-dirs:+ test+ src+ default-extensions: BangPatterns FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses OverloadedStrings TupleSections+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >= 4.7 && < 5+ , arbor-datadog >= 0.0.0 && < 0.1+ , arbor-monad-metric >= 0.0.2 && < 0.1+ , arbor-monad-metric-datadog+ , bytestring >= 0.10.8 && < 0.11+ , containers >= 0.5.10 && < 0.6+ , 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+ , mtl >= 2.2.2 && < 2.3+ , network >= 2.8.0 && < 2.9+ , resourcet >= 1.2.2 && < 1.3+ , stm >= 2.5.0 && < 2.6+ , text >= 1.2.3 && < 1.3+ , transformers >= 0.5.2 && < 0.6+ default-language: Haskell2010
+ src/Arbor/Monad/Metric/Datadog.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Arbor.Monad.Metric.Datadog+ ( logStats+ , mkEvent+ ) where++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 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.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++ 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++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)] ++))++-- create metrics for each counter+mkMetricsCounterNonTagged :: [(Counter, Int)] -> [S.Metric]+mkMetricsCounterNonTagged =+ fmap (\(Counter n, i) -> S.addCounter (Z.MetricName (metricName n)) id i)++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
+ test/Arbor/Monad/MetricSpec.hs view
@@ -0,0 +1,28 @@+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 view
@@ -0,0 +1,31 @@+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
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}