diff options
-rw-r--r-- | graylog.cabal | 5 | ||||
-rw-r--r-- | src/Graylog/Gelf.hs | 49 | ||||
-rw-r--r-- | stack.yaml | 2 |
3 files changed, 47 insertions, 9 deletions
diff --git a/graylog.cabal b/graylog.cabal index 5618d7c..dc84862 100644 --- a/graylog.cabal +++ b/graylog.cabal | |||
@@ -17,7 +17,7 @@ source-repository head | |||
17 | type: git | 17 | type: git |
18 | location: https://github.com/AndrewRademacher/haskell-graylog.git | 18 | location: https://github.com/AndrewRademacher/haskell-graylog.git |
19 | 19 | ||
20 | library | 20 | library |
21 | hs-source-dirs: src | 21 | hs-source-dirs: src |
22 | default-language: Haskell2010 | 22 | default-language: Haskell2010 |
23 | 23 | ||
@@ -29,7 +29,7 @@ library | |||
29 | ghc-options: -Wall -rtsopts | 29 | ghc-options: -Wall -rtsopts |
30 | 30 | ||
31 | build-depends: base ==4.* | 31 | build-depends: base ==4.* |
32 | 32 | ||
33 | , aeson | 33 | , aeson |
34 | , aeson-casing | 34 | , aeson-casing |
35 | , bytestring | 35 | , bytestring |
@@ -38,6 +38,7 @@ library | |||
38 | , scientific | 38 | , scientific |
39 | , text | 39 | , text |
40 | , time | 40 | , time |
41 | , unordered-containers | ||
41 | , vector | 42 | , vector |
42 | 43 | ||
43 | test-suite test-state | 44 | test-suite test-state |
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 |
7 | module Graylog.Gelf where | 8 | module Graylog.Gelf where |
8 | 9 | ||
9 | import Data.Aeson (ToJSON (..), Value (..), genericToJSON, | 10 | import Data.Aeson (ToJSON (..), Value (..), object, toJSON, |
10 | toJSON) | 11 | (.=)) |
11 | import Data.Aeson.Casing | 12 | import Data.HashMap.Strict (HashMap) |
12 | import Data.Text (Text) | 13 | import Data.Scientific (Scientific) |
14 | import Data.Semigroup ((<>)) | ||
15 | import Data.Text (Text) | ||
13 | import Data.Time | 16 | import Data.Time |
14 | import Data.Typeable | 17 | import Data.Typeable |
18 | import GHC.Exts (toList) | ||
15 | import GHC.Generics | 19 | import GHC.Generics |
16 | 20 | ||
17 | data GELF | 21 | data 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 | ||
35 | data MetaValue | ||
36 | = TextValue Text | ||
37 | | NumberValue Scientific | ||
38 | deriving (Show) | ||
39 | |||
40 | instance ToJSON MetaValue where | ||
41 | toJSON (TextValue txt) = toJSON txt | ||
42 | toJSON (NumberValue n) = toJSON n | ||
43 | |||
44 | class ToMeta a where | ||
45 | toMeta :: a -> MetaValue | ||
46 | |||
47 | instance ToMeta Text where | ||
48 | toMeta = TextValue | ||
49 | |||
50 | instance ToMeta Scientific where | ||
51 | toMeta = NumberValue | ||
52 | |||
53 | instance ToMeta Integer where | ||
54 | toMeta = NumberValue . fromInteger | ||
55 | |||
56 | instance ToMeta Int where | ||
57 | toMeta = toMeta . toInteger | ||
58 | |||
30 | instance ToJSON GELF where | 59 | instance 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 |
71 | simpleGelf host short = | 108 | simpleGelf host short = |
72 | GELF Version1x1 host short Nothing Nothing Nothing Nothing Nothing | 109 | GELF Version1x1 host short Nothing Nothing Nothing Nothing Nothing mempty |
@@ -2,7 +2,7 @@ | |||
2 | # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/ | 2 | # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/ |
3 | 3 | ||
4 | # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) | 4 | # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) |
5 | resolver: lts-5.4 | 5 | resolver: lts-11.5 |
6 | 6 | ||
7 | # Local packages, usually specified by relative directory name | 7 | # Local packages, usually specified by relative directory name |
8 | packages: | 8 | packages: |