packages feed

statsd-client (empty) → 0.1.0.0

raw patch · 5 files changed

+257/−0 lines, 5 filesdep +DRBGdep +basedep +byteablesetup-changed

Dependencies added: DRBG, base, byteable, bytestring, crypto-api, cryptohash, digest-pure, network, network-uri, old-time, random, time-units

Files

+ LICENSE view
@@ -0,0 +1,22 @@+The MIT License (MIT)++Copyright (c) 2015 Keith Duncan++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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Network/Statsd.hs view
@@ -0,0 +1,152 @@+module Network.Statsd (+  StatsdClient,+  client,++  fromURI,++  Hostname,+  Port,+  Stat,++  increment,+  decrement,+  count,+  gauge,+  timing,+  histogram,+) where++import Control.Monad+import Control.Exception++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 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 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 (Maybe StatsdClient)+fromURI uri = case uriAuthority uri of+              Nothing   -> return Nothing+              Just auth -> let hostname = uriRegName auth+                               port = fromMaybe 8126 $ (actualPort . uriPort) auth+                               prefix = replace '/' '.' (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++    actualPort :: String -> Maybe Int+    actualPort (':':xs) = (Just . read) xs+    actualPort _        = Nothing++client :: Hostname -> Port -> Stat -> Maybe Key -> IO (Maybe StatsdClient)+client host port namespace key = do+  socket <- tryIOError (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 sock)++  return $ case socket of+    Left e  -> Nothing+    Right s -> Just $ StatsdClient s namespace key++increment :: StatsdClient -> Stat -> IO ()+increment client stat = count client stat 1++decrement :: StatsdClient -> 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]++  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++data Type = Count | Gauge | Timing | Histogram++instance Show Type where+  show Count = "c"+  show Gauge = "g"+  show Timing = "ms"+  show Histogram = "h"
+ src/Network/Statsd/Cluster.hs view
@@ -0,0 +1,45 @@+module Network.Statsd.Cluster (+  Cluster,+  cluster,++  Network.Statsd.Cluster.increment,+  Network.Statsd.Cluster.decrement,+  Network.Statsd.Cluster.count,+  Network.Statsd.Cluster.gauge,+  Network.Statsd.Cluster.timing,+  Network.Statsd.Cluster.histogram,+) where++import Network.Statsd as Statsd+import Data.Digest.Pure.CRC32+import qualified Data.ByteString.Char8 as BC+import Data.Time.Units++data Cluster = Cluster [StatsdClient]+cluster :: [StatsdClient] -> Cluster+cluster clients+  | null clients = error "empty client list"+  | otherwise    = Cluster clients++increment :: Cluster -> Stat -> IO ()+increment cluster stat = Statsd.increment (collectorForStat cluster stat) stat++decrement :: Cluster -> Stat -> IO ()+decrement cluster stat = Statsd.decrement (collectorForStat cluster stat) stat++count :: Cluster -> Stat -> Int -> IO ()+count cluster stat = Statsd.count (collectorForStat cluster stat) stat++gauge :: Cluster -> Stat -> Int -> IO ()+gauge cluster stat = Statsd.gauge (collectorForStat cluster stat) stat++timing :: Cluster -> Stat -> Millisecond -> IO ()+timing cluster stat = Statsd.timing (collectorForStat cluster stat) stat++histogram :: Cluster -> Stat -> Int -> IO ()+histogram cluster stat = Statsd.histogram (collectorForStat cluster stat) stat++collectorForStat :: Cluster -> Stat -> StatsdClient+collectorForStat (Cluster collectors) stat = let statBytes = BC.pack stat+                                                 idx = fromIntegral (crc32 statBytes) `mod` length collectors+                                              in collectors !! idx
+ statsd-client.cabal view
@@ -0,0 +1,36 @@+name: statsd-client+version: 0.1.0.0+cabal-version: >=1.10+build-type: Simple+license: MIT+license-file: LICENSE+copyright: © Keith Duncan+maintainer: Keith Duncan+stability: experimental+homepage: https://github.com/keithduncan/statsd-client+bug-reports: https://github.com/keithduncan/statsd-client/issues+synopsis: Statsd UDP client+category: Network+author: Keith Duncan++source-repository head+  type: git+  location: https://github.com/keithduncan/statsd-client++library+  exposed-modules: Network.Statsd,+                   Network.Statsd.Cluster+  default-language: Haskell2010+  hs-source-dirs: src+  build-depends: base >= 4.8.1 && < 4.9+               , old-time >= 1.1.0.3+               , random >= 1.1+               , bytestring >= 0.10.6+               , byteable >= 0.1.1+               , cryptohash >= 0.11.6+               , network >= 2.6.2.1+               , network-uri >=2.6.0.3 && <2.7+               , digest-pure >= 0.0.3+               , time-units >= 1.0.0+               , crypto-api >= 0.13.2+               , DRBG >= 0.5.5