aboutsummaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
authorThomas Crevoisier <crevoisier.thomas@gmail.com>2019-01-15 15:30:19 +0100
committerGitHub <noreply@github.com>2019-01-15 15:30:19 +0100
commita48cebd4e30ae25777d1934f83e348a1affa214c (patch)
tree6f4bb1ef345f3db21c004bc11391da5a0c26767c /src
parent0edc7f5650ba94ba36f83ed410a412368dd1e561 (diff)
parent4b6637800bf7813570cf7a628794a0351835711b (diff)
downloadhaskell-graylog-a48cebd4e30ae25777d1934f83e348a1affa214c.tar.gz
haskell-graylog-a48cebd4e30ae25777d1934f83e348a1affa214c.tar.zst
haskell-graylog-a48cebd4e30ae25777d1934f83e348a1affa214c.zip
Merge pull request #1 from fretlink/support-additional-metav2019-01-15
Support additional meta in GELF messages
Diffstat (limited to 'src')
-rw-r--r--src/Graylog/Gelf.hs49
1 files changed, 43 insertions, 6 deletions
diff --git a/src/Graylog/Gelf.hs b/src/Graylog/Gelf.hs
index ee17e3d..8ffe24f 100644
--- a/src/Graylog/Gelf.hs
+++ b/src/Graylog/Gelf.hs
@@ -1,17 +1,21 @@
1{-# LANGUAGE DeriveDataTypeable #-} 1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric #-} 2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE OverloadedStrings #-} 3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE RecordWildCards #-}
4 5
5-- | Default formatting for Graylog messages, 6-- | Default formatting for Graylog messages,
6-- see http://docs.graylog.org/en/latest/pages/gelf.html 7-- see http://docs.graylog.org/en/latest/pages/gelf.html
7module Graylog.Gelf where 8module Graylog.Gelf where
8 9
9import Data.Aeson (ToJSON (..), Value (..), genericToJSON, 10import Data.Aeson (ToJSON (..), Value (..), object, toJSON,
10 toJSON) 11 (.=))
11import Data.Aeson.Casing 12import Data.HashMap.Strict (HashMap)
12import Data.Text (Text) 13import Data.Scientific (Scientific)
14import Data.Semigroup ((<>))
15import Data.Text (Text)
13import Data.Time 16import Data.Time
14import Data.Typeable 17import Data.Typeable
18import GHC.Exts (toList)
15import GHC.Generics 19import GHC.Generics
16 20
17data GELF 21data GELF
@@ -24,11 +28,44 @@ data GELF
24 , _gelfLevel :: Maybe SyslogLevel 28 , _gelfLevel :: Maybe SyslogLevel
25 , _gelfLine :: Maybe Word 29 , _gelfLine :: Maybe Word
26 , _gelfFile :: Maybe Text 30 , _gelfFile :: Maybe Text
31 , _gelfMeta :: HashMap Text MetaValue
27 } 32 }
28 deriving (Show, Typeable, Generic) 33 deriving (Show, Typeable, Generic)
29 34
35data MetaValue
36 = TextValue Text
37 | NumberValue Scientific
38 deriving (Show)
39
40instance ToJSON MetaValue where
41 toJSON (TextValue txt) = toJSON txt
42 toJSON (NumberValue n) = toJSON n
43
44class ToMeta a where
45 toMeta :: a -> MetaValue
46
47instance ToMeta Text where
48 toMeta = TextValue
49
50instance ToMeta Scientific where
51 toMeta = NumberValue
52
53instance ToMeta Integer where
54 toMeta = NumberValue . fromInteger
55
56instance ToMeta Int where
57 toMeta = toMeta . toInteger
58
30instance ToJSON GELF where 59instance ToJSON GELF where
31 toJSON = genericToJSON $ aesonPrefix snakeCase 60 toJSON GELF{..} = object $ [ "version" .= _gelfVersion
61 , "host" .= _gelfHost
62 , "short_message" .= _gelfShortMessage
63 , "full_message" .= _gelfFullMessage
64 , "timestamp" .= _gelfTimestamp
65 , "level" .= _gelfLevel
66 , "line" .= _gelfLine
67 , "file" .= _gelfFile
68 ] <> toList (toJSON <$> _gelfMeta)
32 69
33-- 70--
34 71
@@ -69,4 +106,4 @@ simpleGelf
69 -> Text -- ^ Short message 106 -> Text -- ^ Short message
70 -> GELF 107 -> GELF
71simpleGelf host short = 108simpleGelf host short =
72 GELF Version1x1 host short Nothing Nothing Nothing Nothing Nothing 109 GELF Version1x1 host short Nothing Nothing Nothing Nothing Nothing mempty