statsd-client 0.2.0.1 → 0.3.0.0

raw patch · 5 files changed

+192/−135 lines, 5 filesdep ~basenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• src/Network/DogStatsd.hs +55/−0
• src/Network/Statsd.hs +26/−128
• src/Network/Statsd/Cluster.hs +5/−3
• src/Network/Statsd/UdpClient.hs +99/−0
• statsd-client.cabal +7/−4

@@ -0,0 +1,55 @@+module Network.DogStatsd (+ dogStatsdClient+, increment+, decrement+, count+, gauge+, timing+, histogram+) where++import Network.Statsd (Stat, Type(..), fmtDatagram)+import Network.Statsd.UdpClient(UdpClient, fromURI, send)++import Control.Monad+import Data.Maybe+import Data.List+import Data.Time.Units+import Text.Printf+import Network.URI++type Name = String+type Value = String+type Tags = [(Name, Value)]++dogStatsdClient :: String -> IO UdpClient+dogStatsdClient = fromURI . fromJust . parseURI++increment :: UdpClient -> Stat -> Tags -> IO ()+increment client stat = count client stat 1++decrement :: UdpClient -> Stat -> Tags -> IO ()+decrement client stat = count client stat (-1)++count :: UdpClient -> Stat -> Int -> Tags -> IO ()+count client stat value tags = void . send client $ fmtDogStatsdDatagram stat value Count tags++gauge :: UdpClient -> Stat -> Int -> Tags -> IO ()+gauge client stat value tags = void . send client $ fmtDogStatsdDatagram stat value Gauge tags++timing :: UdpClient -> Stat -> Millisecond -> Tags -> IO ()+timing client stat value tags = void . send client $ fmtDogStatsdDatagram stat (fromIntegral value) Timing tags++histogram :: UdpClient -> Stat -> Int -> Tags -> IO ()+histogram client stat value tags = void . send client $ fmtDogStatsdDatagram stat value Histogram tags++fmtTag :: (Name, Value) -> String+fmtTag (a, "") = a+fmtTag (a, b) = a ++ ":" ++ b++fmtDogStatsdDatagram :: Stat -> Int -> Type -> Tags -> String+fmtDogStatsdDatagram stat value statType [] = fmtDatagram stat value statType+fmtDogStatsdDatagram stat value statType tags =+  let statsdDatagram = fmtDatagram stat value statType+      tagSuffix = intercalate "," $ fmtTag <$> tags+  in printf "%s|#%s" statsdDatagram tagSuffix

@@ -1,13 +1,10 @@ module Network.Statsd (-  StatsdClient,-  client,-+  statsdClient,   fromURI, -  Hostname,-  Port,   Stat,-  Key,+  Type(..),+  fmtDatagram,    increment,   decrement,@@ -17,141 +14,42 @@   histogram, ) where -import Control.Monad-import Control.Exception+import Network.Statsd.UdpClient(UdpClient, fromURI, send) -import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BLazy-import qualified Data.ByteString.Char8 as BC-import Data.ByteString.Lazy.Builder (int64LE, toLazyByteString)-import Data.Word-import Data.Byteable+import Control.Monad import Data.Maybe--import System.Time-import System.IO.Error--import Crypto.Hash-import Crypto.Random.DRBG--import Text.Printf import Data.Time.Units--import qualified Network.Socket as Net hiding (send, sendTo, recv, recvFrom)-import qualified Network.Socket.ByteString as Net+import Text.Printf import Network.URI  type Stat = String--data StatsdClient = StatsdClient { getSocket :: Net.Socket-                                 , getNamespace :: Stat-                                 , getSigningKey :: Maybe Key-                                 }--type Hostname = String-type Port = Int--fromURI :: URI -> IO StatsdClient-fromURI uri = case uriAuthority uri of-              Nothing   -> fail "invalid URI"-              Just auth -> let hostname = uriRegName' auth-                               port = let port' = (stripLeading ':' . uriPort) auth-                                       in if null port'-                                          then 8126-                                          else read port'-                               prefix = replace '/' '.' ((stripLeading '/' . uriPath) uri)-                               key = let userInfo = uriUserInfo auth-                                         init' = if null userInfo-                                                 then ""-                                                 else init userInfo-                                         (user, pass) = case break (==':') init' of-                                                        (u, ':':p) -> (u, p)-                                                        _          -> ("", "")-                                      in if null pass-                                         then Nothing-                                         else Just pass--                           in client hostname port prefix key--  where-    replace :: Eq a => a -> a -> [a] -> [a]-    replace from to list = (\a -> if a == from then to else a) <$> list--    uriRegName' :: URIAuth -> String-    uriRegName' auth = let hostname = uriRegName auth-                        in (takeWhile (/=']') . dropWhile (=='[')) hostname--    stripLeading :: Eq a => a -> [a] -> [a]-    stripLeading x y@(y':ys')-      | x == y'   = ys'-      | otherwise = y--client :: Hostname -> Port -> Stat -> Maybe Key -> IO StatsdClient-client host port namespace key = do-  (addr:_) <- Net.getAddrInfo Nothing (Just host) (Just $ show port)-  sock <- Net.socket (Net.addrFamily addr) Net.Datagram Net.defaultProtocol-  Net.connect sock (Net.addrAddress addr)+data Type = Count | Gauge | Timing | Histogram+instance Show Type where+  show Count = "c"+  show Gauge = "g"+  show Timing = "ms"+  show Histogram = "h" -  return $ StatsdClient sock namespace key+statsdClient :: String -> IO UdpClient+statsdClient = fromURI . fromJust . parseURI -increment :: StatsdClient -> Stat -> IO ()+increment :: UdpClient -> Stat -> IO () increment client stat = count client stat 1 -decrement :: StatsdClient -> Stat -> IO ()+decrement :: UdpClient -> Stat -> IO () decrement client stat = count client stat (-1) -count :: StatsdClient -> Stat -> Int -> IO ()-count client stat value = void . send client $ encode (getNamespace client) stat value Count--gauge :: StatsdClient -> Stat -> Int -> IO ()-gauge client stat value = void . send client $ encode (getNamespace client) stat value Gauge--timing :: StatsdClient -> Stat -> Millisecond -> IO ()-timing client stat value = void . send client $ encode (getNamespace client) stat (fromIntegral value) Timing--histogram :: StatsdClient -> Stat -> Int -> IO ()-histogram client stat value = void . send client $ encode (getNamespace client) stat value Histogram--encode :: Stat -> Stat -> Int -> Type -> Payload-encode namespace stat value stat_type =-  let prefix = if null namespace-               then ""-               else namespace ++ "."-      message = printf "%s%s:%s|%s" prefix stat (show value) (show stat_type)-  in BC.pack message--type Payload = B.ByteString--send :: StatsdClient -> Payload -> IO (Either IOError ())-send client payload = do-  signedPayload <- signed (getSigningKey client) payload-  tryIOError . void $ Net.send (getSocket client) signedPayload--type Nonce = B.ByteString-type Key = String--signed :: Maybe Key -> Payload -> IO Payload-signed Nothing payload = return payload-signed (Just key) payload = do-  (TOD sec _) <- getClockTime-  let timestamp = B.concat . BLazy.toChunks . toLazyByteString . int64LE $ fromIntegral sec--  gen <- newGenIO :: IO CtrDRBG-  let (nonce, _) = throwLeft $ genBytes 4 gen--  let newPayload = B.concat [timestamp, nonce, payload]+count :: UdpClient -> Stat -> Int -> IO ()+count client stat value = void . send client $ fmtDatagram stat value Count -  return $ sign key newPayload+gauge :: UdpClient -> Stat -> Int -> IO ()+gauge client stat value = void . send client $ fmtDatagram stat value Gauge -sign :: Key -> Payload -> Payload-sign key payload = let keyBytes = BC.pack key-                       signature = toBytes (hmac keyBytes payload :: HMAC SHA256)-                    in B.append signature payload+timing :: UdpClient -> Stat -> Millisecond -> IO ()+timing client stat value = void . send client $ fmtDatagram stat (fromIntegral value) Timing -data Type = Count | Gauge | Timing | Histogram+histogram :: UdpClient -> Stat -> Int -> IO ()+histogram client stat value = void . send client $ fmtDatagram stat value Histogram -instance Show Type where-  show Count = "c"-  show Gauge = "g"-  show Timing = "ms"-  show Histogram = "h"+fmtDatagram :: Stat -> Int -> Type -> String+fmtDatagram stat value statType = printf "%s:%s|%s" stat (show value) (show statType)

@@ -11,12 +11,14 @@ ) where  import Network.Statsd as Statsd+import Network.Statsd.UdpClient(UdpClient)+ import Data.Digest.Pure.CRC32 import qualified Data.ByteString.Char8 as BC import Data.Time.Units -data Cluster = Cluster [StatsdClient]-cluster :: [StatsdClient] -> Cluster+data Cluster = Cluster [UdpClient]+cluster :: [UdpClient] -> Cluster cluster clients   | null clients = error "empty client list"   | otherwise    = Cluster clients@@ -39,7 +41,7 @@ histogram :: Cluster -> Stat -> Int -> IO () histogram cluster stat = Statsd.histogram (collectorForStat cluster stat) stat -collectorForStat :: Cluster -> Stat -> StatsdClient+collectorForStat :: Cluster -> Stat -> UdpClient collectorForStat (Cluster collectors) stat = let statBytes = BC.pack stat                                                  idx = fromIntegral (crc32 statBytes) `mod` length collectors                                               in collectors !! idx

@@ -0,0 +1,99 @@+module Network.Statsd.UdpClient (+  UdpClient+, fromURI+, send+) where++import Control.Monad+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BLazy+import qualified Data.ByteString.Char8 as BC+import Data.ByteString.Lazy.Builder (int64LE, toLazyByteString)+import Data.Byteable+import System.Time+import System.IO.Error+import Crypto.Hash+import Crypto.Random.DRBG+import qualified Network.Socket as Net hiding (send, sendTo, recv, recvFrom)+import qualified Network.Socket.ByteString as Net+import Network.URI++type Hostname = String+type Port = Int+type Key = String+type Namespace = String+type Payload = B.ByteString+type Nonce = B.ByteString++data UdpClient = UdpClient { getSocket :: Net.Socket+                           , getNamespace :: Namespace+                           , getSigningKey :: Maybe Key+                           }++fromURI :: URI -> IO UdpClient+fromURI (URI "statsd:" (Just (URIAuth auth regname port)) path _ _) =+  let regname' = uriRegName' regname+      port' = if null port+              then 8126+              else read $ stripLeading ':' port+      prefix = replace '/' '.' $ stripLeading '/' path+      key = case break (==':') (stripTrailing '@' auth) of+              (u, ':':p) -> Just p+              _          -> Nothing+   in client regname' port' prefix key++  where+    replace :: Eq a => a -> a -> [a] -> [a]+    replace from to list = (\a -> if a == from then to else a) <$> list++    uriRegName' :: String -> String+    uriRegName' = takeWhile (/=']') . dropWhile (=='[')++    stripLeading :: Eq a => a -> [a] -> [a]+    stripLeading x [] = []+    stripLeading x y@(y':ys')+      | x == y'   = ys'+      | otherwise = y++    stripTrailing :: Eq a => a -> [a] -> [a]+    stripTrailing x [] = []+    stripTrailing x xs = let init' = init xs+                             last' = last xs+                          in if last' == x+                             then init'+                             else xs++fromURI uri = error $ "invalid URI" ++ show uri++client :: Hostname -> Port -> Namespace -> Maybe Key -> IO UdpClient+client host port namespace key = do+  (addr:_) <- Net.getAddrInfo Nothing (Just host) (Just $ show port)+  sock <- Net.socket (Net.addrFamily addr) Net.Datagram Net.defaultProtocol+  Net.connect sock (Net.addrAddress addr)++  return $ UdpClient sock namespace key++send :: UdpClient -> String -> IO (Either IOError ())+send client datagram = do+  let namespace = getNamespace client+  let message = if null namespace then datagram else namespace ++ "." ++ datagram+  signedPayload <- signed (getSigningKey client) (BC.pack message)+  tryIOError . void $ Net.send (getSocket client) signedPayload++signed :: Maybe Key -> Payload -> IO Payload+signed Nothing payload = return payload+signed (Just key) payload = do+  (TOD sec _) <- getClockTime+  let timestamp = B.concat . BLazy.toChunks . toLazyByteString . int64LE $ fromIntegral sec++  gen <- newGenIO :: IO CtrDRBG+  let (nonce, _) = throwLeft $ genBytes 4 gen++  let newPayload = B.concat [timestamp, nonce, payload]++  return $ sign key newPayload++sign :: Key -> Payload -> Payload+sign key payload = let keyBytes = BC.pack key+                       signature = toBytes (hmac keyBytes payload :: HMAC SHA256)+                    in B.append signature payload

@@ -1,5 +1,5 @@ name: statsd-client-version: 0.2.0.1+version: 0.3.0.0 cabal-version: >=1.10 build-type: Simple license: MIT@@ -10,6 +10,7 @@ homepage: https://github.com/keithduncan/statsd-client bug-reports: https://github.com/keithduncan/statsd-client/issues synopsis: Statsd UDP client+description: Statsd UDP client category: Network author: Keith Duncan @@ -18,11 +19,13 @@   location: https://github.com/keithduncan/statsd-client  library-  exposed-modules: Network.Statsd,-                   Network.Statsd.Cluster+  exposed-modules: Network.Statsd+                 , Network.DogStatsd+                 , Network.Statsd.UdpClient+                 , Network.Statsd.Cluster   default-language: Haskell2010   hs-source-dirs: src-  build-depends: base >= 4.8 && < 4.9+  build-depends: base >= 4.8 && < 4.10                , old-time >= 1.1 && <1.2                , random >= 1.1 && <1.2                , bytestring >= 0.10 && <0.11