From 19681eb84ad5224f8923b1853a98727b0a8cc77a Mon Sep 17 00:00:00 2001 From: Thomas Crevoisier Date: Mon, 26 Nov 2018 08:57:31 +0100 Subject: Upgrade stack lts --- stack.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stack.yaml b/stack.yaml index 55ab633..2ccd75c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -2,7 +2,7 @@ # For more information, see: http://docs.haskellstack.org/en/stable/yaml_configuration/ # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-5.4 +resolver: lts-11.5 # Local packages, usually specified by relative directory name packages: -- cgit v1.2.3 From 8c9d965d06998aeb9474742c0923feb36a6fc636 Mon Sep 17 00:00:00 2001 From: Thomas Crevoisier Date: Mon, 26 Nov 2018 08:58:27 +0100 Subject: Allow to send metadata in a Gelf message --- graylog.cabal | 5 +++-- src/Graylog/Gelf.hs | 24 ++++++++++++++++++------ 2 files changed, 21 insertions(+), 8 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 type: git location: https://github.com/AndrewRademacher/haskell-graylog.git -library +library hs-source-dirs: src default-language: Haskell2010 @@ -29,7 +29,7 @@ library ghc-options: -Wall -rtsopts build-depends: base ==4.* - + , aeson , aeson-casing , bytestring @@ -38,6 +38,7 @@ library , scientific , text , time + , unordered-containers , vector test-suite test-state diff --git a/src/Graylog/Gelf.hs b/src/Graylog/Gelf.hs index ee17e3d..b6e7ec0 100644 --- a/src/Graylog/Gelf.hs +++ b/src/Graylog/Gelf.hs @@ -1,17 +1,20 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} -- | Default formatting for Graylog messages, -- see http://docs.graylog.org/en/latest/pages/gelf.html module Graylog.Gelf where -import Data.Aeson (ToJSON (..), Value (..), genericToJSON, - toJSON) -import Data.Aeson.Casing -import Data.Text (Text) +import Data.Aeson (ToJSON (..), Value (..), object, + toJSON, (.=)) +import Data.HashMap.Strict (HashMap) +import Data.Semigroup ((<>)) +import Data.Text (Text) import Data.Time import Data.Typeable +import GHC.Exts (toList) import GHC.Generics data GELF @@ -24,11 +27,20 @@ data GELF , _gelfLevel :: Maybe SyslogLevel , _gelfLine :: Maybe Word , _gelfFile :: Maybe Text + , _gelfMeta :: HashMap Text Text } deriving (Show, Typeable, Generic) instance ToJSON GELF where - toJSON = genericToJSON $ aesonPrefix snakeCase + toJSON GELF{..} = object $ [ "version" .= _gelfVersion + , "host" .= _gelfHost + , "short_message" .= _gelfShortMessage + , "full_message" .= _gelfFullMessage + , "timestamp" .= _gelfTimestamp + , "level" .= _gelfLevel + , "line" .= _gelfLine + , "file" .= _gelfFile + ] <> toList (String <$> _gelfMeta) -- @@ -69,4 +81,4 @@ simpleGelf -> Text -- ^ Short message -> GELF simpleGelf host short = - GELF Version1x1 host short Nothing Nothing Nothing Nothing Nothing + GELF Version1x1 host short Nothing Nothing Nothing Nothing Nothing mempty -- cgit v1.2.3 From 4b6637800bf7813570cf7a628794a0351835711b Mon Sep 17 00:00:00 2001 From: Thomas Crevoisier Date: Fri, 30 Nov 2018 17:01:18 +0100 Subject: Allow sending numbers in additional fields --- src/Graylog/Gelf.hs | 33 +++++++++++++++++++++++++++++---- 1 file changed, 29 insertions(+), 4 deletions(-) diff --git a/src/Graylog/Gelf.hs b/src/Graylog/Gelf.hs index b6e7ec0..8ffe24f 100644 --- a/src/Graylog/Gelf.hs +++ b/src/Graylog/Gelf.hs @@ -7,9 +7,10 @@ -- see http://docs.graylog.org/en/latest/pages/gelf.html module Graylog.Gelf where -import Data.Aeson (ToJSON (..), Value (..), object, - toJSON, (.=)) +import Data.Aeson (ToJSON (..), Value (..), object, toJSON, + (.=)) import Data.HashMap.Strict (HashMap) +import Data.Scientific (Scientific) import Data.Semigroup ((<>)) import Data.Text (Text) import Data.Time @@ -27,10 +28,34 @@ data GELF , _gelfLevel :: Maybe SyslogLevel , _gelfLine :: Maybe Word , _gelfFile :: Maybe Text - , _gelfMeta :: HashMap Text Text + , _gelfMeta :: HashMap Text MetaValue } deriving (Show, Typeable, Generic) +data MetaValue + = TextValue Text + | NumberValue Scientific + deriving (Show) + +instance ToJSON MetaValue where + toJSON (TextValue txt) = toJSON txt + toJSON (NumberValue n) = toJSON n + +class ToMeta a where + toMeta :: a -> MetaValue + +instance ToMeta Text where + toMeta = TextValue + +instance ToMeta Scientific where + toMeta = NumberValue + +instance ToMeta Integer where + toMeta = NumberValue . fromInteger + +instance ToMeta Int where + toMeta = toMeta . toInteger + instance ToJSON GELF where toJSON GELF{..} = object $ [ "version" .= _gelfVersion , "host" .= _gelfHost @@ -40,7 +65,7 @@ instance ToJSON GELF where , "level" .= _gelfLevel , "line" .= _gelfLine , "file" .= _gelfFile - ] <> toList (String <$> _gelfMeta) + ] <> toList (toJSON <$> _gelfMeta) -- -- cgit v1.2.3