module Statsd
(
StatsdT
, Statsd
, Bucket
, SamplePct
, runStatsd
, statsdCounter
, statsdSampledCounter
, statsdTimer
, statsdGauge
, statsdGaugePlus
, statsdGaugeMinus
, statsdSet
) where
import Control.Exception
import Control.Monad
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.Trans.Control
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import Network
import Network.Socket
import Network.Socket.ByteString (sendAll)
import System.Random (randomRIO)
newtype StatsdT m a = StatsdT (ReaderT Socket (WriterT [ByteString] m) a)
type Statsd a = StatsdT IO a
type Bucket = ByteString
type SamplePct = Double
runStatsd :: (MonadBaseControl IO m, MonadIO m)
=> Family
-> SocketType
-> ProtocolNumber
-> SockAddr
-> StatsdT m a -> m a
runStatsd family socket_type protocol_num sock_addr (StatsdT action) =
withSocket family socket_type protocol_num sock_addr $ \sock -> do
(a, bss) <- runWriterT (runReaderT action sock)
liftIO $ sendAll sock (BS.intercalate "\n" bss)
return a
statsdCounter :: MonadIO m => Bucket -> Int -> StatsdT m ()
statsdCounter bucket n = StatsdT . lift . tell $ [encodeSimpleMetric bucket n "c"]
statsdSampledCounter :: MonadIO m => Bucket -> Int -> SamplePct -> StatsdT m ()
statsdSampledCounter bucket n pct = StatsdT $ do
r <- liftIO $ randomRIO (0.0, 1.0)
when (r <= pct) $
lift $ tell [encodeSimpleMetric bucket n "c" <> "|@" <> BS.pack (show pct)]
statsdTimer :: MonadIO m => Bucket -> Int -> StatsdT m ()
statsdTimer bucket n = StatsdT . lift . tell $ [encodeSimpleMetric bucket n "ms"]
statsdGauge :: MonadIO m => Bucket -> Int -> StatsdT m ()
statsdGauge bucket n = StatsdT . lift . tell $ [encodeSimpleMetric bucket n "g"]
statsdGaugePlus :: MonadIO m => Bucket -> Int -> StatsdT m ()
statsdGaugePlus bucket n = StatsdT . lift . tell $ [bucket <> ":+" <> BS.pack (show n) <> "|g"]
statsdGaugeMinus :: MonadIO m => Bucket -> Int -> StatsdT m ()
statsdGaugeMinus bucket n = StatsdT . lift . tell $ [bucket <> ":-" <> BS.pack (show n) <> "|g"]
statsdSet :: MonadIO m => Bucket -> Int -> StatsdT m ()
statsdSet bucket n = StatsdT . lift . tell $ [encodeSimpleMetric bucket n "s"]
encodeSimpleMetric :: Bucket -> Int -> ByteString -> ByteString
encodeSimpleMetric bucket n typ = bucket <> ":" <> BS.pack (show n) <> "|" <> typ
withSocket :: MonadBaseControl IO m
=> Family
-> SocketType
-> ProtocolNumber
-> SockAddr
-> (Socket -> m a)
-> m a
withSocket family socket_type protocol_num sock_addr = liftBaseOp (bracket acquire close)
where
acquire :: IO Socket
acquire = do
sock <- socket family socket_type protocol_num
connect sock sock_addr
return sock