module Network.Monitoring.Riemann.Event where
import qualified Data.ByteString.Lazy.Char8 as BC
import Data.Maybe (isJust)
import Data.Monoid ((<>))
import Data.Sequence (Seq, fromList)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Network.HostName (getHostName)
import Network.Monitoring.Riemann.Json ()
import qualified Network.Monitoring.Riemann.Proto.Attribute as Attribute
import qualified Network.Monitoring.Riemann.Proto.Event as E
import qualified Text.ProtocolBuffers.Basic as Basic
import qualified Text.ProtocolBuffers.Header as P'
type Service = String
type State = String
type Event = E.Event
emptyEvent :: Event
emptyEvent = P'.defaultValue
toField :: String -> Maybe Basic.Utf8
toField string = Just $ Basic.Utf8 $ BC.pack string
info :: Service -> Event
info service = P'.defaultValue {E.service = toField service}
state :: State -> Event -> Event
state s e = e {E.state = toField s}
ok :: Service -> Event
ok service = state "ok" $ info service
warn :: Service -> Event
warn service = state "warn" $ info service
failure :: Service -> Event
failure service = state "failure" $ info service
description :: String -> Event -> Event
description d e = e {E.description = toField d}
class Metric a where
setMetric :: a -> Event -> Event
instance Metric Int where
setMetric m e = e {E.metric_sint64 = Just $ fromIntegral m}
instance Metric Integer where
setMetric m e = e {E.metric_sint64 = Just $ fromIntegral m}
instance Metric P'.Int64 where
setMetric m e = e {E.metric_sint64 = Just m}
instance Metric Double where
setMetric m e = e {E.metric_d = Just m}
instance Metric Float where
setMetric m e = e {E.metric_f = Just m}
metric :: (Metric a) => a -> Event -> Event
metric = setMetric
ttl :: Float -> Event -> Event
ttl t e = e {E.ttl = Just t}
tags :: [String] -> Event -> Event
tags ts e =
let tags' = fromList $ fmap (Basic.Utf8 . BC.pack) ts
in e {E.tags = tags' <> E.tags e}
attributes :: [Attribute.Attribute] -> Event -> Event
attributes as e = e {E.attributes = fromList as <> E.attributes e}
attribute :: String -> Maybe String -> Attribute.Attribute
attribute k mv =
let k' = (Basic.Utf8 . BC.pack) k
mv' = fmap (Basic.Utf8 . BC.pack) mv
in P'.defaultValue {Attribute.key = k', Attribute.value = mv'}
withDefaults :: Seq Event -> IO (Seq Event)
withDefaults e = do
now <- fmap round getPOSIXTime
hostname <- getHostName
pure $ addTimeAndHost now hostname <$> e
addTimeAndHost :: P'.Int64 -> String -> Event -> Event
addTimeAndHost now hostname e
| isJust (E.time e) && isJust (E.host e) = e
| isJust (E.time e) = e {E.host = toField hostname}
| isJust (E.host e) = e {E.time = Just now}
| otherwise = e {E.time = Just now, E.host = toField hostname}