{-|
Module      : Network.Monitoring.Riemann.Event
Description : A module for building Riemann events

Build an event which can then be sent to Riemann using a 'Network.Monitoring.Riemann.Client.Client'

Events are built by composing helper functions that set Riemann fields and applying to one of the Event constructors:

@
  E.ok "my service"
& E.description "my description"
& E.metric (length [ "some data" ])
& E.ttl 20
& E.tags ["tag1", "tag2"]
@

With this design you are encouraged to create an event with one of 'E.ok', 'E.warn' or 'E.failure'.

This has been done because we found that it is best to avoid services like @my.service.success@ and @my.service.error@ (that's what the Riemann state field is for).

You can use your own states using @E.info & E.state "trace"@ however this is discouraged as it doesn't show up nicely in riemann-dash.
-}
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 :: Event
emptyEvent = Event
forall a. Default a => a
P'.defaultValue

toField :: String -> Maybe Basic.Utf8
toField :: String -> Maybe Utf8
toField String
string = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just (Utf8 -> Maybe Utf8) -> Utf8 -> Maybe Utf8
forall a b. (a -> b) -> a -> b
$ ByteString -> Utf8
Basic.Utf8 (ByteString -> Utf8) -> ByteString -> Utf8
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BC.pack String
string

info :: Service -> Event
info :: String -> Event
info String
service = Event
forall a. Default a => a
P'.defaultValue {service :: Maybe Utf8
E.service = String -> Maybe Utf8
toField String
service}

state :: State -> Event -> Event
state :: String -> Event -> Event
state String
s Event
e = Event
e {state :: Maybe Utf8
E.state = String -> Maybe Utf8
toField String
s}

ok :: Service -> Event
ok :: String -> Event
ok String
service = String -> Event -> Event
state String
"ok" (Event -> Event) -> Event -> Event
forall a b. (a -> b) -> a -> b
$ String -> Event
info String
service

warn :: Service -> Event
warn :: String -> Event
warn String
service = String -> Event -> Event
state String
"warn" (Event -> Event) -> Event -> Event
forall a b. (a -> b) -> a -> b
$ String -> Event
info String
service

failure :: Service -> Event
failure :: String -> Event
failure String
service = String -> Event -> Event
state String
"failure" (Event -> Event) -> Event -> Event
forall a b. (a -> b) -> a -> b
$ String -> Event
info String
service

description :: String -> Event -> Event
description :: String -> Event -> Event
description String
d Event
e = Event
e {description :: Maybe Utf8
E.description = String -> Maybe Utf8
toField String
d}

class Metric a where
  setMetric :: a -> Event -> Event

instance Metric Int where
  setMetric :: Int -> Event -> Event
setMetric Int
m Event
e = Event
e {metric_sint64 :: Maybe Int64
E.metric_sint64 = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m}

instance Metric Integer where
  setMetric :: Integer -> Event -> Event
setMetric Integer
m Event
e = Event
e {metric_sint64 :: Maybe Int64
E.metric_sint64 = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
m}

instance Metric P'.Int64 where
  setMetric :: Int64 -> Event -> Event
setMetric Int64
m Event
e = Event
e {metric_sint64 :: Maybe Int64
E.metric_sint64 = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
m}

instance Metric Double where
  setMetric :: Double -> Event -> Event
setMetric Double
m Event
e = Event
e {metric_d :: Maybe Double
E.metric_d = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
m}

instance Metric Float where
  setMetric :: Float -> Event -> Event
setMetric Float
m Event
e = Event
e {metric_f :: Maybe Float
E.metric_f = Float -> Maybe Float
forall a. a -> Maybe a
Just Float
m}

{-|
    Note that since Riemann's protocol has separate types for integers, floats and doubles, you need to specify which
    type you are using. For example, this won't work:

    @
    metric 1 myEvent
    @

    Instead use:

    @
    metric (1 :: Int) myEvent
    @
-}
metric :: (Metric a) => a -> Event -> Event
metric :: a -> Event -> Event
metric = a -> Event -> Event
forall a. Metric a => a -> Event -> Event
setMetric

ttl :: Float -> Event -> Event
ttl :: Float -> Event -> Event
ttl Float
t Event
e = Event
e {ttl :: Maybe Float
E.ttl = Float -> Maybe Float
forall a. a -> Maybe a
Just Float
t}

tags :: [String] -> Event -> Event
tags :: [String] -> Event -> Event
tags [String]
ts Event
e =
  let tags' :: Seq Utf8
tags' = [Utf8] -> Seq Utf8
forall a. [a] -> Seq a
fromList ([Utf8] -> Seq Utf8) -> [Utf8] -> Seq Utf8
forall a b. (a -> b) -> a -> b
$ (String -> Utf8) -> [String] -> [Utf8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Utf8
Basic.Utf8 (ByteString -> Utf8) -> (String -> ByteString) -> String -> Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BC.pack) [String]
ts
   in Event
e {tags :: Seq Utf8
E.tags = Seq Utf8
tags' Seq Utf8 -> Seq Utf8 -> Seq Utf8
forall a. Semigroup a => a -> a -> a
<> Event -> Seq Utf8
E.tags Event
e}

attributes :: [Attribute.Attribute] -> Event -> Event
attributes :: [Attribute] -> Event -> Event
attributes [Attribute]
as Event
e = Event
e {attributes :: Seq Attribute
E.attributes = [Attribute] -> Seq Attribute
forall a. [a] -> Seq a
fromList [Attribute]
as Seq Attribute -> Seq Attribute -> Seq Attribute
forall a. Semigroup a => a -> a -> a
<> Event -> Seq Attribute
E.attributes Event
e}

attribute :: String -> Maybe String -> Attribute.Attribute
attribute :: String -> Maybe String -> Attribute
attribute String
k Maybe String
mv =
  let k' :: Utf8
k' = (ByteString -> Utf8
Basic.Utf8 (ByteString -> Utf8) -> (String -> ByteString) -> String -> Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BC.pack) String
k
      mv' :: Maybe Utf8
mv' = (String -> Utf8) -> Maybe String -> Maybe Utf8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Utf8
Basic.Utf8 (ByteString -> Utf8) -> (String -> ByteString) -> String -> Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BC.pack) Maybe String
mv
   in Attribute
forall a. Default a => a
P'.defaultValue {key :: Utf8
Attribute.key = Utf8
k', value :: Maybe Utf8
Attribute.value = Maybe Utf8
mv'}

{-|
    Add local hostname and current time to an Event

    This will not override any host or time in the provided event
-}
withDefaults :: Seq Event -> IO (Seq Event)
withDefaults :: Seq Event -> IO (Seq Event)
withDefaults Seq Event
e = do
  Int64
now <- (POSIXTime -> Int64) -> IO POSIXTime -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap POSIXTime -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round IO POSIXTime
getPOSIXTime
  String
hostname <- IO String
getHostName
  Seq Event -> IO (Seq Event)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seq Event -> IO (Seq Event)) -> Seq Event -> IO (Seq Event)
forall a b. (a -> b) -> a -> b
$ Int64 -> String -> Event -> Event
addTimeAndHost Int64
now String
hostname (Event -> Event) -> Seq Event -> Seq Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Event
e

addTimeAndHost :: P'.Int64 -> String -> Event -> Event
addTimeAndHost :: Int64 -> String -> Event -> Event
addTimeAndHost Int64
now String
hostname Event
e
  | Maybe Int64 -> Bool
forall a. Maybe a -> Bool
isJust (Event -> Maybe Int64
E.time Event
e) Bool -> Bool -> Bool
&& Maybe Utf8 -> Bool
forall a. Maybe a -> Bool
isJust (Event -> Maybe Utf8
E.host Event
e) = Event
e
  | Maybe Int64 -> Bool
forall a. Maybe a -> Bool
isJust (Event -> Maybe Int64
E.time Event
e) = Event
e {host :: Maybe Utf8
E.host = String -> Maybe Utf8
toField String
hostname}
  | Maybe Utf8 -> Bool
forall a. Maybe a -> Bool
isJust (Event -> Maybe Utf8
E.host Event
e) = Event
e {time :: Maybe Int64
E.time = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
now}
  | Bool
otherwise = Event
e {time :: Maybe Int64
E.time = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
now, host :: Maybe Utf8
E.host = String -> Maybe Utf8
toField String
hostname}