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 --- src/Graylog/Gelf.hs | 24 ++++++++++++++++++------ 1 file changed, 18 insertions(+), 6 deletions(-) (limited to 'src') 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(-) (limited to 'src') 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