module Logstash.Message where
import Data.Aeson
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Control.Applicative
import Control.Monad
import qualified Data.HashMap.Strict as HM
import qualified Data.Vector as V
import Data.Time
import Data.Text.Format
import Data.Attoparsec.Text
data LogstashMessage = LogstashMessage
{ logstashType :: T.Text
, logstashSource :: T.Text
, logstashTags :: [T.Text]
, logstashFields :: Value
, logstashContent :: T.Text
, logstashTime :: Maybe UTCTime
} deriving (Show, Eq)
instance FromJSON LogstashMessage where
parseJSON (Object v) = LogstashMessage
<$> v .: "@type"
<*> v .: "@source"
<*> v .: "@tags"
<*> v .: "@fields"
<*> v .: "@message"
<*> v .:? "@timestamp"
parseJSON _ = mzero
emptyLSMessage :: T.Text -> LogstashMessage
emptyLSMessage m = LogstashMessage "empty" "dummy" [] (object []) m Nothing
instance ToJSON LogstashMessage where
toJSON (LogstashMessage ty s ta f c ts) = object $ [ "@type" .= ty
, "@source" .= s
, "@tags" .= ta
, "@fields" .= f
, "@message" .= c
] ++ case ts of
Nothing -> []
Just t -> [ "@timestamp" .= t ]
logstashTimestamp :: UTCTime -> T.Text
logstashTimestamp (UTCTime d t) = TL.toStrict $! format "{}-{}-{}T{}:{}:{}.{}Z" (year, tc month, tc day, tc hours, tc minutes, tc seconds, left 3 '0' imicro)
where
tc = left 2 '0'
reduce :: Int -> Int -> (Int, Int)
reduce a b = (a `mod` b, a `div` b)
(year, month, day) = toGregorian d
(fseconds, micro) = properFraction t
imicro = truncate (micro * 1000) :: Int
(seconds, fminutes) = reduce fseconds 60
(minutes, hours) = reduce fminutes 60
parseLogstashTime :: T.Text -> Maybe UTCTime
parseLogstashTime t = case parseOnly prs t of
Right r -> Just r
Left _ -> Nothing
where
prs = do
ye <- decimal <* char '-' :: Parser Integer
mo <- decimal <* char '-' :: Parser Int
da <- decimal <* char 'T' :: Parser Int
ho <- decimal <* char ':' :: Parser Int
mi <- decimal <* char ':' :: Parser Int
se <- decimal <* char '.' :: Parser Int
ms <- decimal <* char 'Z' :: Parser Int
endOfInput
let !seconds = ho*3600 + mi*60 + se
!micro = fromIntegral ms / 1000
!secs = secondsToDiffTime (fromIntegral seconds) + micro
return $! UTCTime (fromGregorian ye mo da) secs
value2logstash :: Value -> Maybe LogstashMessage
value2logstash (Object m) =
let mtype = HM.lookup "@type" m
msrc = HM.lookup "@source" m
mflds = case HM.lookup "@fields" m of
Just x -> x
Nothing -> Null
mtags = case HM.lookup "@tags" m of
Just (Array v) -> toTags (V.toList v)
_ -> Nothing
mmsg = case HM.lookup "@message" m of
Just (String x) -> x
_ -> ""
mts = case HM.lookup "@timestamp" m of
Just (String u) -> parseLogstashTime u
_ -> Nothing
toTags :: [Value] -> Maybe [T.Text]
toTags v =
let isString (String _) = True
isString _ = False
toText (String x) = x
toText _ = ""
in if null (filter (not . isString) v)
then Just (map toText v)
else Nothing
in case (mtype, msrc, mtags) of
(Just (String t), Just (String s), Just tags) -> Just $ LogstashMessage t s tags mflds mmsg mts
_ -> Nothing
value2logstash _ = Nothing
addLogstashTime :: LogstashMessage -> IO LogstashMessage
addLogstashTime msg = case logstashTime msg of
Just _ -> return msg
Nothing -> do
curtime <- getCurrentTime
return msg { logstashTime = Just curtime }
addLogstashTag :: T.Text
-> LogstashMessage
-> LogstashMessage
addLogstashTag tag msg = msg { logstashTags = tag : logstashTags msg }