network-metrics 0.1.7 → 0.1.9

raw patch · 8 files changed

+184/−111 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• network-metrics.cabal +3/−3
• src/GMetric.hs +21/−19
• src/Network/Metric.hs +7/−5
• src/Network/Metric/Internal.hs +75/−34
• src/Network/Metric/Sink/Ganglia.hs +17/−14
• src/Network/Metric/Sink/Graphite.hs +23/−16
• src/Network/Metric/Sink/Statsd.hs +16/−14
• src/Network/Metric/Sink/Stdout.hs +22/−6

@@ -1,5 +1,5 @@ name:               network-metrics-version:            0.1.7+version:            0.1.9 synopsis:           Send metrics to Ganglia, Graphite, and statsd. license:            OtherLicense license-file:       LICENSE@@ -46,7 +46,7 @@                   , TypeSynonymInstances                   , FlexibleInstances -  ghc-options:      -Wall -O2 -rtsopts+  ghc-options:      -Wall -rtsopts   ghc-prof-options: -prof -auto-all    build-depends:    base >= 4.3 && < 5@@ -70,7 +70,7 @@                   , TypeSynonymInstances                   , FlexibleInstances -  ghc-options:      -Wall -O2 -threaded -rtsopts+  ghc-options:      -Wall -rtsopts   ghc-prof-options: -prof -auto-all -with-rtsopts=-p    build-depends:    base >= 4.3 && < 5

@@ -17,13 +17,14 @@  import Control.Monad            (liftM, when) import Data.Binary.Put          (runPut)-import Data.ByteString.Char8    (pack)+import Data.Word                (Word16) import Network.Socket           (SocketType(..)) import System.Console.CmdArgs import System.Environment       (getArgs, withArgs) import System.Exit              (ExitCode(..), exitWith) import Network.Metric.Internal +import qualified Data.ByteString.Char8       as BS import qualified Network.Metric.Sink.Ganglia as G  data Options = Options@@ -52,24 +53,25 @@ --  emit :: Options -> IO ()-emit Options{..} = do-    sink@(G.Ganglia hd) <- liftM G.Ganglia (hOpen Datagram optHost optPort)-    _ <- push' G.putMetaData hd-    _ <- push' G.putValue hd-    G.close sink-  where-    push' f = flip hPush . runPut $ f metric-    metric  = G.GangliaMetric-        (pack optName)-        optType-        (pack optUnits)-        (pack optValue)-        ""-        (pack optSpoof)-        (pack optGroup)-        optSlope-        (fromInteger optTMax)-        (fromInteger optDMax)+emit Options{..} = return ()+  --   sink@(G.Ganglia hd) <- liftM G.Ganglia (hOpen Datagram optHost port)+  --   _ <- push' G.putMetaData hd+  --   _ <- push' G.putValue hd+  --   G.close sink+  -- where+  --   push' f = flip hPush . runPut $ f metric+  --   port    = PortNum (read optPort :: Word16)+  --   metric  = G.GangliaMetric+  --       (BS.pack optName)+  --       optType+  --       (BS.pack optUnits)+  --       (BS.pack optValue)+  --       ""+  --       (BS.pack optSpoof)+  --       (BS.pack optGroup)+  --       optSlope+  --       (fromInteger optTMax)+  --       (fromInteger optDMax)  -- -- Parsing

@@ -14,14 +14,16 @@     -- * Exported Types       SinkType(..) -    -- * Sink Functions-    , open-    , Sink(push, close)-     -- * Re-exports     , Group     , Bucket     , Metric(..)+    , Measurable(..)+    , Encodable(..)+    , Sink(..)+    , AnyMeasurable(..)+    , AnySink(..)+    , open     ) where  import Data.Data               (Data, Typeable)@@ -45,7 +47,7 @@ --  -- | Open a new sink specified by SinkType-open :: SinkType -> String -> String -> IO MetricSink+open :: SinkType -> Host -> HostName -> PortNumber -> IO AnySink open Ganglia  = GangliaSink.open open Graphite = GraphiteSink.open open Statsd   = StatsdSink.open

@@ -15,12 +15,17 @@ module Network.Metric.Internal (     -- * Exported Types       Handle(..)+    , Host     , Group     , Bucket     , Metric(..)-    , MetricSink(..) +    -- * Existential Types+    , AnyMeasurable(..)+    , AnySink(..)+     -- * Exported Type Classes+    , Measurable(..)     , Encodable(..)     , Sink(..) @@ -32,12 +37,17 @@     , hOpen     , hClose     , hPush++    -- * Re-exports+    , HostName+    , PortNumber(..)     ) where +import Control.Monad                  (liftM, unless) import Data.Typeable                  (Typeable)-import Control.Monad                  (liftM, unless, void) import Network.Socket                 hiding (send) import Network.Socket.ByteString.Lazy (send)+import Text.Printf                    (printf)  import qualified Data.ByteString.Char8      as BS import qualified Data.ByteString.Lazy.Char8 as BL@@ -45,69 +55,100 @@ -- | Socket handle data Handle = Handle Socket SockAddr deriving (Show) +-- | Metric host+type Host = BS.ByteString+ -- | Metric group type Group = BS.ByteString  -- | Metric bucket type Bucket = BS.ByteString -data Metric a =-      Counter Group Bucket Int+data Metric+    = Counter Group Bucket Integer     | Timer Group Bucket Double-    | Gauge Group Bucket a+    | Gauge Group Bucket Double       deriving (Show) --- | A Metric's value+--+-- Type Classes+--++-- | Measure a type for a collection of metrics+class Measurable a where+    -- | Convert a measurable instance from a host into a list of metrics+    measure :: a -> [Metric]++-- | Metric value to be encoded class (Show a, Typeable a) => Encodable a where     -- | Encode the value as a bytestring     encode :: a -> BS.ByteString -instance Encodable Int where-    encode = BS.pack . show--instance Encodable Double where-    encode = BS.pack . show--instance Encodable String where-    encode = BS.pack- -- | Sink resource to write metrics to class Sink a where     -- | Write a metric to the sink.-    push  :: Encodable b => a -> Metric b -> IO ()-+    push  :: Measurable b => a -> b -> IO ()     -- | Close the sink - subsequent writes will throw an error.     close :: a -> IO () -    -- | Effeciently write multiple metrics simultaneously.-    mpush :: Encodable b => a -> [Metric b] -> IO ()-    mpush s = void . mapM (push s)+--+-- Existential Types+-- --- | Existential sink type-data MetricSink = forall a. Sink a => MetricSink a+-- | Any instance of the Measurable type class+data AnyMeasurable = forall a. Measurable a => AnyMeasurable a +-- | Any instance of the Sink type class+data AnySink = forall a. Sink a => AnySink a++--+-- Instances+--++instance Measurable AnyMeasurable where+    measure (AnyMeasurable m) = measure m++instance Measurable Metric where+    measure = flip (:) [] . id++instance Encodable Int where+    encode = BS.pack . show++instance Encodable Integer where+    encode = BS.pack . show++instance Encodable Double where+    encode = BS.pack . printf "%.8f"++instance Encodable String where+    encode = BS.pack+ -- | Existential sink instance-instance Sink MetricSink where-    push  (MetricSink s) = push s-    mpush (MetricSink s) = mpush s-    close (MetricSink s) = close s+instance Sink AnySink where+    push  (AnySink s) = push s+    close (AnySink s) = close s  -- -- API -- --- | Combine a Group and Bucket into a single key-key :: Group -> Bucket -> BS.ByteString-key g b = BS.concat [g, ".", b]+-- | Combine a Host, Group and Bucket into a single key+key :: Host -> Group -> Bucket -> BS.ByteString+key h g b = BS.intercalate "." [h, g, b]  -- | Helper to curry a constructor function for a sink-fOpen :: Sink a => (Handle -> a) -> SocketType -> String -> String -> IO MetricSink-fOpen ctor typ = \host port -> liftM (MetricSink . ctor) (hOpen typ host port)+fOpen :: Sink a+      => (Handle -> a)+      -> SocketType+      -> HostName+      -> PortNumber+      -> IO AnySink+fOpen ctor typ host port = liftM (AnySink . ctor) (hOpen typ host port)  -- | Create a new socket handle (in a disconnected state) for UDP communication-hOpen :: SocketType -> String -> String -> IO Handle-hOpen typ host port = do-    (addr:_) <- getAddrInfo Nothing (Just host) (Just port)+hOpen :: SocketType -> HostName -> PortNumber -> IO Handle+hOpen typ host (PortNum port) = do+    (addr:_) <- getAddrInfo Nothing (Just host) (Just $ show port)     sock     <- socket (addrFamily addr) typ defaultProtocol     return $ Handle sock (addrAddress addr) 

@@ -25,8 +25,8 @@     , putValue      -- * Sink Functions+    , Sink(..)     , open-    , Sink(push, close)      -- * Re-exports     , Group@@ -60,13 +60,13 @@  -- | Concrete metric type used to emit metadata and value packets data GangliaMetric = GangliaMetric-    { name  :: BS.ByteString+    { name  :: Bucket     , type' :: GangliaType     , units :: BS.ByteString     , value :: BS.ByteString     , host  :: BS.ByteString     , spoof :: BS.ByteString-    , group :: BS.ByteString+    , group :: Group     , slope :: Slope     , tmax  :: Word32     , dmax  :: Word32@@ -76,16 +76,16 @@     def = defaultMetric  -- | A handle to a Ganglia sink-data Ganglia = Ganglia Handle deriving (Show)+data Ganglia = Ganglia Host Handle deriving (Show)  instance Sink Ganglia where-    push  (Ganglia h) = hPush h . enc+    push (Ganglia host hd) = mapM_ (hPush hd . enc) . measure       where-        enc (Counter g b v) = put g b v Positive-        enc (Timer g b v)   = put g b v Both-        enc (Gauge g b v)   = put g b v Both+        enc (Counter g b v) = put host g b v Positive+        enc (Timer g b v)   = put host g b v Both+        enc (Gauge g b v)   = put host g b v Both -    close (Ganglia h) = hClose h+    close (Ganglia _ hd) = hClose hd  -- -- API@@ -107,8 +107,8 @@     }  -- | Open a new Ganglia sink-open :: String -> String -> IO MetricSink-open = fOpen Ganglia Datagram+open :: Host -> HostName -> PortNumber -> IO AnySink+open host = fOpen (Ganglia host) Datagram  -- | Encode a GangliaMetric's metadata into a Binary.Put monad --@@ -144,17 +144,20 @@  -- | Oh, the horror put :: Encodable a-    => Group+    => Host+    -> Group     -> Bucket     -> a     -> Slope     -> BL.ByteString-put group bucket value slope = BL.concat $ map run [putMetaData, putValue]+put host group bucket value slope =+    BL.concat $ map run [putMetaData, putValue]   where      run f  = runPut $ f metric      metric = defaultMetric          { name  = bucket          , group = group+         , host  = host          , value = encode value          , type' = determineType value          , slope = slope@@ -162,7 +165,7 @@  -- | TODO: more horror determineType :: Typeable a => a -> GangliaType-determineType t = case show $ typeOf t of+determineType value = case show $ typeOf value of     "Int16"   -> Int16     "Int"     -> Int32     "Integer" -> Int32

@@ -12,8 +12,8 @@  module Network.Metric.Sink.Graphite (     -- * Sink Functions-      open-    , Sink(push, close)+      Sink(..)+    , open      -- * Re-exports     , Group@@ -21,42 +21,49 @@     , Metric(..)     ) where -import Control.Monad           (liftM)+import Data.Time.Clock.POSIX   (POSIXTime, getPOSIXTime) import Network.Socket          (SocketType(..))-import Data.Time.Clock.POSIX   (getPOSIXTime) import Network.Metric.Internal  import qualified Data.ByteString.Char8      as BS import qualified Data.ByteString.Lazy.Char8 as BL  -- | A handle to a Graphite sink-data Graphite = Graphite Handle deriving (Show)+data Graphite = Graphite Host Handle deriving (Show)  instance Sink Graphite where-    push  (Graphite h) m = enc m >>= hPush h+    push (Graphite host hd) m = do+        time <- getPOSIXTime+        mapM_ (hPush hd . enc time) (measure m)       where-        enc (Counter g b v) = put g b v-        enc (Timer g b v)   = put g b v-        enc (Gauge g b v)   = put g b v+        enc t (Counter g b v) = put host g b v t+        enc t (Timer g b v)   = put host g b v t+        enc t (Gauge g b v)   = put host g b v t -    close (Graphite h) = hClose h+    close (Graphite _ hd) = hClose hd  -- -- API --  -- | Open a new Graphite sink-open :: String -> String -> IO MetricSink-open = fOpen Graphite Stream+open :: Host -> HostName -> PortNumber -> IO AnySink+open host = fOpen (Graphite host) Stream  -- -- Private --  -- | Encode a metric into the Graphite format-put :: Encodable a => Group -> Bucket -> a -> IO BL.ByteString-put group bucket value = liftM bstr getPOSIXTime+put :: Encodable a+    => Host+    -> Group+    -> Bucket+    -> a+    -> POSIXTime+    -> BL.ByteString+put host group bucket value time =+    BL.fromChunks [key host group bucket, encode value, timestamp]   where-    timestamp n = BS.pack $ show (truncate n :: Integer)-    bstr n      = BL.fromChunks [key group bucket, encode value, timestamp n]+    timestamp = BS.pack $ show (truncate time :: Integer) 

@@ -12,13 +12,13 @@  module Network.Metric.Sink.Statsd (     -- * Sink Functions-      open-    , Sink(push, close)+      Sink(..)+    , open      -- * Re-exports     , Group     , Bucket-    , MetricSink(..)+    , AnySink(..)     ) where  import Control.Monad            (liftM)@@ -33,24 +33,24 @@ data Sampled = Sampled | Exact | Ignore  -- | A handle to a Statsd sink-data Statsd = Statsd Handle deriving (Show)+data Statsd = Statsd Host Handle deriving (Show)  instance Sink Statsd where-    push  (Statsd h) m  = enc m >>= hPush h+    push (Statsd host hd) m = mapM enc (measure m) >>= mapM_ (hPush hd)       where-        enc (Counter g b v) = put g b v "c" 1.0-        enc (Gauge g b v)   = put g b v "g" 1.0-        enc (Timer g b v)   = put g b v "ms" 1.0+        enc (Counter g b v) = put host g b v "c" 1.0+        enc (Gauge g b v)   = put host g b v "g" 1.0+        enc (Timer g b v)   = put host g b v "ms" 1.0 -    close (Statsd h) = hClose h+    close (Statsd _ hd) = hClose hd  -- -- API --  -- | Open a new Statsd sink-open :: String -> String -> IO MetricSink-open = fOpen Statsd Datagram+open :: Host -> HostName -> PortNumber -> IO AnySink+open host = fOpen (Statsd host) Datagram  -- -- Private@@ -58,15 +58,17 @@ -- | Encode a metric into the Statsd format -- *TODO:* Currently statsd sampling is not exposed via the global metric type put :: Encodable a-    => Group+    => Host+    -> Group     -> Bucket     -> a     -> BS.ByteString     -> Double     -> IO BL.ByteString-put group bucket value typ rate = liftM bstr (randomRIO (0.0, 1.0))+put host group bucket value typ rate =+    liftM bstr (randomRIO (0.0, 1.0))   where-    base   = [key group bucket, ":", encode value, "|", typ]+    base   = [key host group bucket, ":", encode value, "|", typ]     bstr n = BL.fromChunks $ case sample rate n of         Sampled -> base ++ ["@", BS.pack $ show rate]         Exact   -> base

@@ -13,7 +13,7 @@ module Network.Metric.Sink.Stdout (     -- * Sink Functions       open-    , Sink(push, close)+    , Sink(..)      -- * Re-exports     , Group@@ -23,11 +23,18 @@  import Network.Metric.Internal +import qualified Data.ByteString.Char8 as BS+ -- | A handle to a stdout sink-data StdoutSink = StdoutSink deriving (Show)+data Stdout = Stdout Host deriving (Show) -instance Sink StdoutSink where-    push  _ = print+instance Sink Stdout where+    push (Stdout host) = mapM_ enc . measure+      where+        enc (Counter g b v) = put "Counter" host g b v+        enc (Timer g b v)   = put "Timer" host g b v+        enc (Gauge g b v)   = put "Gauge" host g b v+     close _ = return ()  --@@ -35,5 +42,14 @@ --  -- | Open a new Stdout sink-open :: String -> String -> IO MetricSink-open _ _ = return $ MetricSink StdoutSink+open :: Host -> HostName -> PortNumber -> IO AnySink+open host _ _ = return . AnySink $ Stdout host++--+-- Private+--++put :: Encodable a => BS.ByteString -> Host -> Group -> Bucket -> a -> IO ()+put prefix host group bucket value = putStrLn s+  where+    s = BS.unpack $ BS.concat [prefix, ": ", key host group bucket, " ", encode value]