src/Graylog/Gelf.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE DeriveGeneric      #-}
   3 {-# LANGUAGE OverloadedStrings  #-}
   4 {-# LANGUAGE RecordWildCards    #-}
   5
   6 -- | Default formatting for Graylog messages,
   7 -- see http://docs.graylog.org/en/latest/pages/gelf.html
   8 module Graylog.Gelf where
   9
  10 import           Data.Aeson          (ToJSON (..), Value (..), object,
  11                                       toJSON, (.=))
  12 import           Data.HashMap.Strict (HashMap)
  13 import           Data.Semigroup      ((<>))
  14 import           Data.Text           (Text)
  15 import           Data.Time
  16 import           Data.Typeable
  17 import           GHC.Exts            (toList)
  18 import           GHC.Generics
  19
  20 data GELF
  21    = GELF
  22       { _gelfVersion      :: Version
  23       , _gelfHost         :: Text
  24       , _gelfShortMessage :: Text
  25       , _gelfFullMessage  :: Maybe Text
  26       , _gelfTimestamp    :: Maybe UTCTime
  27       , _gelfLevel        :: Maybe SyslogLevel
  28       , _gelfLine         :: Maybe Word
  29       , _gelfFile         :: Maybe Text
  30       , _gelfMeta         :: HashMap Text Text
  31       }
  32    deriving (Show, Typeable, Generic)
  33
  34 instance ToJSON GELF where
  35   toJSON GELF{..} = object $ [ "version"        .= _gelfVersion
  36                              , "host"           .= _gelfHost
  37                              , "short_message"  .= _gelfShortMessage
  38                              , "full_message"   .= _gelfFullMessage
  39                              , "timestamp"      .= _gelfTimestamp
  40                              , "level"          .= _gelfLevel
  41                              , "line"           .= _gelfLine
  42                              , "file"           .= _gelfFile
  43                              ] <> toList (String <$> _gelfMeta)
  44
  45 --
  46
  47 data Version
  48    = Version1x1
  49    deriving (Eq, Show, Typeable, Generic)
  50
  51 instance ToJSON Version where
  52    toJSON Version1x1 = String "1.1"
  53
  54 --
  55
  56 data SyslogLevel
  57    = Emergency
  58    | Alert
  59    | Critical
  60    | Error
  61    | Warning
  62    | Notice
  63    | Informational
  64    | Debug
  65    deriving (Eq, Ord, Show, Typeable, Generic)
  66
  67 instance ToJSON SyslogLevel where
  68    toJSON Emergency     = Number 0
  69    toJSON Alert         = Number 1
  70    toJSON Critical      = Number 2
  71    toJSON Error         = Number 3
  72    toJSON Warning       = Number 4
  73    toJSON Notice        = Number 5
  74    toJSON Informational = Number 6
  75    toJSON Debug         = Number 7
  76
  77 --
  78
  79 simpleGelf
  80    :: Text     -- ^ Hostname
  81    -> Text     -- ^ Short message
  82    -> GELF
  83 simpleGelf host short =
  84   GELF Version1x1 host short Nothing Nothing Nothing Nothing Nothing mempty