aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/Graylog/Gelf.hs
blob: a58cc9f2e1e31321ad955efb0e656ca888a48ae8 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
{-# 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 (..), object, toJSON,
                                      (.=))
import           Data.HashMap.Strict (HashMap)
import           Data.Scientific     (Scientific)
import           Data.Text           (Text)
import           Data.Time
import           Data.Typeable
import           GHC.Exts            (toList)
import           GHC.Generics

data GELF
   = GELF
      { _gelfVersion      :: Version
      , _gelfHost         :: Text
      , _gelfShortMessage :: Text
      , _gelfFullMessage  :: Maybe Text
      , _gelfTimestamp    :: Maybe UTCTime
      , _gelfLevel        :: Maybe SyslogLevel
      , _gelfLine         :: Maybe Word
      , _gelfFile         :: Maybe 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
                             , "short_message"  .= _gelfShortMessage
                             , "full_message"   .= _gelfFullMessage
                             , "timestamp"      .= _gelfTimestamp
                             , "level"          .= _gelfLevel
                             , "line"           .= _gelfLine
                             , "file"           .= _gelfFile
                             ] <> toList (toJSON <$> _gelfMeta)

--

data Version
   = Version1x1
   deriving (Eq, Show, Typeable, Generic)

instance ToJSON Version where
   toJSON Version1x1 = String "1.1"

--

data SyslogLevel
   = Emergency
   | Alert
   | Critical
   | Error
   | Warning
   | Notice
   | Informational
   | Debug
   deriving (Eq, Ord, Show, Typeable, Generic)

instance ToJSON SyslogLevel where
   toJSON Emergency     = Number 0
   toJSON Alert         = Number 1
   toJSON Critical      = Number 2
   toJSON Error         = Number 3
   toJSON Warning       = Number 4
   toJSON Notice        = Number 5
   toJSON Informational = Number 6
   toJSON Debug         = Number 7

--

simpleGelf
   :: Text     -- ^ Hostname
   -> Text     -- ^ Short message
   -> GELF
simpleGelf host short =
  GELF Version1x1 host short Nothing Nothing Nothing Nothing Nothing mempty