{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Carbon.Plaintext
(
Connection(..)
, connect
, disconnect
, sendMetrics
, sendMetric
, Metric(..)
, encodeMetric
)
where
import Control.Exception (bracketOnError)
import Control.Monad (unless)
import Data.Monoid ((<>), mempty, mappend)
import Data.Typeable (Typeable)
import qualified Data.ByteString.Builder as Builder
import qualified Data.Time as Time
import qualified Data.Time.Clock.POSIX as Time
import qualified Data.Vector as V
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.Socket as Network
import qualified Network.Socket.ByteString.Lazy as Network
data Connection = Connection
{ connectionSocket :: !Network.Socket
}
deriving (Eq, Show, Typeable)
connect :: Network.SockAddr -> IO Connection
connect sockAddr = fmap Connection $ do
let openSocket = Network.socket Network.AF_INET Network.Stream Network.defaultProtocol
bracketOnError openSocket
Network.close
(\s -> fmap (const s) (Network.connect s sockAddr))
disconnect :: Connection -> IO ()
disconnect (Connection s) = Network.close s
reconnect :: Connection -> IO ()
reconnect (Connection s) = do
peer <- Network.getPeerName s
Network.connect s peer
data Metric = Metric
{ metricPath :: !Text.Text
, metricValue :: !Double
, metricTimeStamp :: !Time.UTCTime
}
deriving (Eq, Show, Typeable)
sendMetrics :: Connection -> V.Vector Metric -> IO ()
sendMetrics c ms = do
let socket = connectionSocket c
do isWritable <- Network.isWritable socket
unless isWritable (reconnect c)
Network.sendAll socket (Builder.toLazyByteString (V.foldl' mappend mempty (V.map encodeMetric ms)))
sendMetric :: Connection -> Text.Text -> Double -> Time.UTCTime -> IO ()
sendMetric c k v t = sendMetrics c (V.singleton (Metric k v t))
encodeMetric :: Metric -> Builder.Builder
encodeMetric (Metric k v t) =
Builder.byteString (Text.encodeUtf8 k) <> " " <>
Builder.stringUtf8 (show v) <> " " <>
Builder.stringUtf8 (show (round (Time.utcTimeToPOSIXSeconds t) :: Int)) <> "\n"