1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE DeriveGeneric #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# LANGUAGE RecordWildCards #-}
6 -- | Default formatting for Graylog messages,
7 -- see http://docs.graylog.org/en/latest/pages/gelf.html
8 module Graylog.Gelf where
10 import Data.Aeson (ToJSON (..), Value (..), object, toJSON,
12 import Data.HashMap.Strict (HashMap)
13 import Data.Scientific (Scientific)
14 import Data.Text (Text)
17 import GHC.Exts (toList)
22 { _gelfVersion :: Version
24 , _gelfShortMessage :: Text
25 , _gelfFullMessage :: Maybe Text
26 , _gelfTimestamp :: Maybe UTCTime
27 , _gelfLevel :: Maybe SyslogLevel
28 , _gelfLine :: Maybe Word
29 , _gelfFile :: Maybe Text
30 , _gelfMeta :: HashMap Text MetaValue
32 deriving (Show, Typeable, Generic)
36 | NumberValue Scientific
39 instance ToJSON MetaValue where
40 toJSON (TextValue txt) = toJSON txt
41 toJSON (NumberValue n) = toJSON n
44 toMeta :: a -> MetaValue
46 instance ToMeta Text where
49 instance ToMeta Scientific where
52 instance ToMeta Integer where
53 toMeta = NumberValue . fromInteger
55 instance ToMeta Int where
56 toMeta = toMeta . toInteger
58 instance ToJSON GELF where
59 toJSON GELF{..} = object $ [ "version" .= _gelfVersion
61 , "short_message" .= _gelfShortMessage
62 , "full_message" .= _gelfFullMessage
63 , "timestamp" .= _gelfTimestamp
64 , "level" .= _gelfLevel
67 ] <> toList (toJSON <$> _gelfMeta)
73 deriving (Eq, Show, Typeable, Generic)
75 instance ToJSON Version where
76 toJSON Version1x1 = String "1.1"
89 deriving (Eq, Ord, Show, Typeable, Generic)
91 instance ToJSON SyslogLevel where
92 toJSON Emergency = Number 0
93 toJSON Alert = Number 1
94 toJSON Critical = Number 2
95 toJSON Error = Number 3
96 toJSON Warning = Number 4
97 toJSON Notice = Number 5
98 toJSON Informational = Number 6
99 toJSON Debug = Number 7
104 :: Text -- ^ Hostname
105 -> Text -- ^ Short message
107 simpleGelf host short =
108 GELF Version1x1 host short Nothing Nothing Nothing Nothing Nothing mempty