{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module Network.Carbon.Plaintext
(
Connection(..)
, connect
, disconnect
, sendMetrics
, sendMetric
, Metric(..)
, encodeMetric
)
where
import Control.Exception (bracketOnError)
import Data.Typeable (Typeable)
import System.IO.Error
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
#if !MIN_VERSION_base(4, 14, 0)
import GHC.IO.Exception ( IOErrorType( ResourceVanished ) )
isResourceVanishedError :: IOError -> Bool
isResourceVanishedError err = (ioeGetErrorType err) == ResourceVanished
#endif
data Connection = Connection
{ Connection -> Socket
connectionSocket :: !Network.Socket
}
deriving (Connection -> Connection -> Bool
(Connection -> Connection -> Bool)
-> (Connection -> Connection -> Bool) -> Eq Connection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Connection -> Connection -> Bool
$c/= :: Connection -> Connection -> Bool
== :: Connection -> Connection -> Bool
$c== :: Connection -> Connection -> Bool
Eq, Int -> Connection -> ShowS
[Connection] -> ShowS
Connection -> String
(Int -> Connection -> ShowS)
-> (Connection -> String)
-> ([Connection] -> ShowS)
-> Show Connection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Connection] -> ShowS
$cshowList :: [Connection] -> ShowS
show :: Connection -> String
$cshow :: Connection -> String
showsPrec :: Int -> Connection -> ShowS
$cshowsPrec :: Int -> Connection -> ShowS
Show, Typeable)
connect :: Network.SockAddr -> IO Connection
connect :: SockAddr -> IO Connection
connect SockAddr
sockAddr = (Socket -> Connection) -> IO Socket -> IO Connection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Socket -> Connection
Connection (IO Socket -> IO Connection) -> IO Socket -> IO Connection
forall a b. (a -> b) -> a -> b
$ do
let openSocket :: IO Socket
openSocket = Family -> SocketType -> ProtocolNumber -> IO Socket
Network.socket Family
Network.AF_INET SocketType
Network.Stream ProtocolNumber
Network.defaultProtocol
IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError IO Socket
openSocket
Socket -> IO ()
Network.close
(\Socket
s -> (() -> Socket) -> IO () -> IO Socket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Socket -> () -> Socket
forall a b. a -> b -> a
const Socket
s) (Socket -> SockAddr -> IO ()
Network.connect Socket
s SockAddr
sockAddr))
disconnect :: Connection -> IO ()
disconnect :: Connection -> IO ()
disconnect (Connection Socket
s) = Socket -> IO ()
Network.close Socket
s
reconnect :: Connection -> IO ()
reconnect :: Connection -> IO ()
reconnect (Connection Socket
s) = do
SockAddr
peer <- Socket -> IO SockAddr
Network.getPeerName Socket
s
Socket -> SockAddr -> IO ()
Network.connect Socket
s SockAddr
peer
data Metric = Metric
{ Metric -> Text
metricPath :: !Text.Text
, Metric -> Double
metricValue :: !Double
, Metric -> UTCTime
metricTimeStamp :: !Time.UTCTime
}
deriving (Metric -> Metric -> Bool
(Metric -> Metric -> Bool)
-> (Metric -> Metric -> Bool) -> Eq Metric
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metric -> Metric -> Bool
$c/= :: Metric -> Metric -> Bool
== :: Metric -> Metric -> Bool
$c== :: Metric -> Metric -> Bool
Eq, Int -> Metric -> ShowS
[Metric] -> ShowS
Metric -> String
(Int -> Metric -> ShowS)
-> (Metric -> String) -> ([Metric] -> ShowS) -> Show Metric
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metric] -> ShowS
$cshowList :: [Metric] -> ShowS
show :: Metric -> String
$cshow :: Metric -> String
showsPrec :: Int -> Metric -> ShowS
$cshowsPrec :: Int -> Metric -> ShowS
Show, Typeable)
sendMetrics :: Connection -> V.Vector Metric -> IO ()
sendMetrics :: Connection -> Vector Metric -> IO ()
sendMetrics Connection
c Vector Metric
ms = do
let socket :: Socket
socket = Connection -> Socket
connectionSocket Connection
c
IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError
(Socket -> ByteString -> IO ()
Network.sendAll Socket
socket (Builder -> ByteString
Builder.toLazyByteString ((Builder -> Builder -> Builder)
-> Builder -> Vector Builder -> Builder
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend Builder
forall a. Monoid a => a
mempty ((Metric -> Builder) -> Vector Metric -> Vector Builder
forall a b. (a -> b) -> Vector a -> Vector b
V.map Metric -> Builder
encodeMetric Vector Metric
ms))))
(\IOError
e -> if IOError -> Bool
isResourceVanishedError IOError
e then Connection -> IO ()
reconnect Connection
c IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Connection -> Vector Metric -> IO ()
sendMetrics Connection
c Vector Metric
ms else IOError -> IO ()
forall a. IOError -> IO a
ioError IOError
e)
sendMetric :: Connection -> Text.Text -> Double -> Time.UTCTime -> IO ()
sendMetric :: Connection -> Text -> Double -> UTCTime -> IO ()
sendMetric Connection
c Text
k Double
v UTCTime
t = Connection -> Vector Metric -> IO ()
sendMetrics Connection
c (Metric -> Vector Metric
forall a. a -> Vector a
V.singleton (Text -> Double -> UTCTime -> Metric
Metric Text
k Double
v UTCTime
t))
encodeMetric :: Metric -> Builder.Builder
encodeMetric :: Metric -> Builder
encodeMetric (Metric Text
k Double
v UTCTime
t) =
ByteString -> Builder
Builder.byteString (Text -> ByteString
Text.encodeUtf8 Text
k) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Builder
Builder.stringUtf8 (Double -> String
forall a. Show a => a -> String
show Double
v) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
String -> Builder
Builder.stringUtf8 (Int -> String
forall a. Show a => a -> String
show (POSIXTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (UTCTime -> POSIXTime
Time.utcTimeToPOSIXSeconds UTCTime
t) :: Int)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n"