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.Semigroup ((<>))
15 import Data.Text (Text)
18 import GHC.Exts (toList)
23 { _gelfVersion :: Version
25 , _gelfShortMessage :: Text
26 , _gelfFullMessage :: Maybe Text
27 , _gelfTimestamp :: Maybe UTCTime
28 , _gelfLevel :: Maybe SyslogLevel
29 , _gelfLine :: Maybe Word
30 , _gelfFile :: Maybe Text
31 , _gelfMeta :: HashMap Text MetaValue
33 deriving (Show, Typeable, Generic)
37 | NumberValue Scientific
40 instance ToJSON MetaValue where
41 toJSON (TextValue txt) = toJSON txt
42 toJSON (NumberValue n) = toJSON n
45 toMeta :: a -> MetaValue
47 instance ToMeta Text where
50 instance ToMeta Scientific where
53 instance ToMeta Integer where
54 toMeta = NumberValue . fromInteger
56 instance ToMeta Int where
57 toMeta = toMeta . toInteger
59 instance ToJSON GELF where
60 toJSON GELF{..} = object $ [ "version" .= _gelfVersion
62 , "short_message" .= _gelfShortMessage
63 , "full_message" .= _gelfFullMessage
64 , "timestamp" .= _gelfTimestamp
65 , "level" .= _gelfLevel
68 ] <> toList (toJSON <$> _gelfMeta)
74 deriving (Eq, Show, Typeable, Generic)
76 instance ToJSON Version where
77 toJSON Version1x1 = String "1.1"
90 deriving (Eq, Ord, Show, Typeable, Generic)
92 instance ToJSON SyslogLevel where
93 toJSON Emergency = Number 0
94 toJSON Alert = Number 1
95 toJSON Critical = Number 2
96 toJSON Error = Number 3
97 toJSON Warning = Number 4
98 toJSON Notice = Number 5
99 toJSON Informational = Number 6
100 toJSON Debug = Number 7
105 :: Text -- ^ Hostname
106 -> Text -- ^ Short message
108 simpleGelf host short =
109 GELF Version1x1 host short Nothing Nothing Nothing Nothing Nothing mempty