588cf7c · typeable/control-logger

git.iko.soy/typeable/control-logger

on master help sign in

Merge pull request #1 from typeable/ville/drop-bloodhound

588cf7cVille Tirronen5 years ago

.gitignorenew file+1

compare with master

unifiedsplit

@@ -0,0 +1 @@

1+.stack-work

control-logger.cabal−2

@@ -17,7 +17,6 @@ library

17 exposed-modules: Control.Logger.Internal

18 build-depends: base

19 , aeson

20− , bloodhound

21 , bytestring

20 , bytestring

22 , control-has

21 , control-has

23 , control-has-katip

22 , control-has-katip

@@ -34,7 +33,6 @@ library

34 , unordered-containers

33 , unordered-containers

35 if !impl(ghcjs)

34 if !impl(ghcjs)

36 build-depends: katip

35 build-depends: katip

37− , katip-elasticsearch

38 , optparse-applicative

36 , optparse-applicative

39 default-language: Haskell2010

37 default-language: Haskell2010

40 default-extensions: RankNTypes

38 default-extensions: RankNTypes

src/Control/Logger/Katip.hs+1−103

@@ -2,14 +2,10 @@

2{-# OPTIONS_GHC -fno-warn-orphans #-}

4module Control.Logger.Katip

5− ( ElasticServer(..)

6− , logSeverityToKSeverity

5+ ( logSeverityToKSeverity

7− , registerElastic

8− , maybeElastic

9 , KatipContextTState(..)

6 , KatipContextTState(..)

10 , getKatipLogger

7 , getKatipLogger

11 , ourFormatter

8 , ourFormatter

12− , ourMapping

13 , katipIndexNameString

9 , katipIndexNameString

14 , reopenableFileLog

10 , reopenableFileLog

15 ) where

11 ) where

@@ -20,43 +16,15 @@ import Control.Lens hiding ((.=))

20import Control.Logger.Internal

16import Control.Logger.Internal

21import Control.Logger.Katip.Scribes.Reopenable

17import Control.Logger.Katip.Scribes.Reopenable

22import Data.Aeson hiding (Error)

18import Data.Aeson hiding (Error)

23−import Data.ByteString (ByteString)

24import qualified Data.HashMap.Strict as HM

19import qualified Data.HashMap.Strict as HM

25−import Data.Proxy as P

26import Data.Text (Text)

20import Data.Text (Text)

27import qualified Data.Text as T

21import qualified Data.Text as T

28−import qualified Data.Text.Encoding as T

29import qualified Data.Text.Lazy.Builder as T.Builder

22import qualified Data.Text.Lazy.Builder as T.Builder

30−import Database.V5.Bloodhound

31import Katip as K hiding (logMsg)

23import Katip as K hiding (logMsg)

32import Katip.Core (ItemFunc(..), LocJs(..), ProcessIDJs(..))

24import Katip.Core (ItemFunc(..), LocJs(..), ProcessIDJs(..))

33import Katip.Monadic (KatipContextTState(..))

25import Katip.Monadic (KatipContextTState(..))

34−import Katip.Scribes.ElasticSearch

35−import Katip.Scribes.ElasticSearch.Internal as K

36−import Network.HTTP.Client

39−data ElasticServer = ElasticServer

40− { _esServer :: !(Maybe Server)

41− , _esUsername :: !(Maybe ByteString)

42− , _esPassword :: !(Maybe ByteString)

43− } deriving (Eq, Show)

44−

45−instance FromJSON ElasticServer where

46− parseJSON = withObject "ElasticServer" $ \obj -> ElasticServer

47− <$> (obj .: "server")

48− <*> (fmap T.encodeUtf8 <$> (obj .: "username"))

49− <*> (fmap T.encodeUtf8 <$> (obj .: "password"))

50−

51−instance ToJSON ElasticServer where

52− toJSON es = object

53− [ "server" .= fmap fromServer (_esServer es)

54− , "username" .= fmap T.decodeUtf8 (_esUsername es)

55− , "password" .= fmap T.decodeUtf8 (_esPassword es)

56− ]

57− where

58− fromServer (Server s) = s

59−

60logSeverityToKSeverity :: LogSeverity -> Severity

28logSeverityToKSeverity :: LogSeverity -> Severity

61logSeverityToKSeverity = \case

29logSeverityToKSeverity = \case

62 Debug -> DebugS

30 Debug -> DebugS

@@ -64,35 +32,6 @@ logSeverityToKSeverity = \case

64 Warn -> WarningS

32 Warn -> WarningS

65 Error -> ErrorS

33 Error -> ErrorS

67−registerElastic

68− :: Text

69− -- ^ git revision

70− -> Verbosity

71− -> ElasticServer

72− -> PermitFunc

73− -> LogEnv

74− -> IO LogEnv

75−registerElastic gitRev verbosity ElasticServer{..} permitF env =

76− case _esServer of

77− Nothing -> return env

78− Just server -> do

79− elastic <- do

80− mgr <- newManager defaultManagerSettings

81− let

82− bloodhoundEnv = (mkBHEnv server mgr)

83− { bhRequestHook = requestHook }

84− mkEsScribe cfg bloodhoundEnv permitF verbosity

85− registerScribe "elastic" elastic defaultScribeSettings env

86− where

87− cfg = (defaultEsScribeCfgV5 ixName mappingName)

88− { essItemFormatter = ourFormatter gitRev

89− , essIndexMappingValue = ourMapping mappingName }

90− where

91− ixName = IndexName katipIndexNameString

92− mappingName = MappingName "logs"

93− requestHook = return . case (_esUsername, _esPassword) of

94− (Just u, Just p) -> applyBasicAuth u p

95− _ -> id

97-- | Adds the @rev-hash@ value to each record.

36-- | Adds the @rev-hash@ value to each record.

98-- Early we copied `msg` to `msg-keyword` here but drop it

37-- Early we copied `msg` to `msg-keyword` here but drop it

@@ -112,41 +51,6 @@ ourFormatter gitRev verb = ItemFunc $ \item -> go $ ourItemJson verb item

112 setRev :: HM.HashMap Text Value -> HM.HashMap Text Value

51 setRev :: HM.HashMap Text Value -> HM.HashMap Text Value

113 setRev = HM.insert "rev-hash" (toJSON gitRev)

52 setRev = HM.insert "rev-hash" (toJSON gitRev)

114

115−ourMapping :: K.MappingName ESV5 -> Value

116−ourMapping mn = object

117− [fromMappingName prx mn .= object ["properties" .= object prs]]

118− where

119− prs =

120− [ unanalyzedString "thread"

121− , unanalyzedString "sev"

122− , unanalyzedString "pid"

123− -- ns is frequently fulltext searched

124− , analyzedString "ns"

125− -- we want message to be fulltext searchable

126− , analyzedString "msg"

127− -- we want to group by the message as well

128− , unanalyzedString "msg-keyword"

129− -- we want to group by revision hash

130− , unanalyzedString "rev-hash"

131− , "loc" .= locType

132− , unanalyzedString "host"

133− , unanalyzedString "env"

134− , "at" .= dateType

135− , unanalyzedString "app"

136− ]

137− prx = P.Proxy :: P.Proxy ESV5

138− unanalyzedString k = k .= unanalyzedStringSpec prx

139− analyzedString k = k .= analyzedStringSpec prx

140− locType = object ["properties" .= object locPairs]

141− locPairs =

142− [ unanalyzedString "loc_pkg"

143− , unanalyzedString "loc_mod"

144− , unanalyzedString "loc_ln"

145− , unanalyzedString "loc_fn"

146− , unanalyzedString "loc_col"

147− ]

148− dateType = object ["format" .= esDateFormat, "type" .= String "date"]

149−

150katipIndexNameString :: Text

54katipIndexNameString :: Text

151katipIndexNameString = "antorica-b2b-logs"

55katipIndexNameString = "antorica-b2b-logs"

152

@@ -168,12 +72,6 @@ ourItemJson verb item = formatItem $

168 , "loc" .= fmap LocJs _itemLoc

72 , "loc" .= fmap LocJs _itemLoc

169 ]

73 ]

170

171−-- | Return empty server if Nothing

172−maybeElastic :: Maybe ElasticServer -> ElasticServer

173−maybeElastic = \case

174− Nothing -> ElasticServer Nothing Nothing Nothing

175− Just a -> a

176−

177instance LogItem Object where

75instance LogItem Object where

178 payloadKeys V0 _ = SomeKeys []

76 payloadKeys V0 _ = SomeKeys []

179 payloadKeys _ _ = AllKeys

77 payloadKeys _ _ = AllKeys

src/Control/Logger/Katip/Utils.hs−38

@@ -3,15 +3,10 @@

3module Control.Logger.Katip.Utils

4 ( katipIndexNameString

5 , module Katip.Monadic

6− , ElasticServer(..)

7− , elasticServer

8− , maybeElastic

9− , registerElastic

10 , LogFormat(..)

6 , LogFormat(..)

11 , registerFileScribe

7 , registerFileScribe

12 , setLoggingCtx

8 , setLoggingCtx

13 , ourFormatter

9 , ourFormatter

14− , ourMapping

15 , getKatipLogger

10 , getKatipLogger

16 , logSeverityToKSeverity

11 , logSeverityToKSeverity

17 ) where

12 ) where

@@ -25,51 +20,18 @@ import Control.Logger.Internal as L

25import Control.Logger.Katip as L

20import Control.Logger.Katip as L

26import Data.Aeson hiding (Error)

21import Data.Aeson hiding (Error)

27import Data.Aeson.Text

22import Data.Aeson.Text

28−import Data.ByteString (ByteString)

29import qualified Data.ByteString.Builder as B.Builder

23import qualified Data.ByteString.Builder as B.Builder

30import qualified Data.HashMap.Strict as HM

24import qualified Data.HashMap.Strict as HM

31import Data.Text (Text)

25import Data.Text (Text)

32−import qualified Data.Text as T

33−import Data.Text.Encoding

34import qualified Data.Text.Lazy.Builder as T.Builder

26import qualified Data.Text.Lazy.Builder as T.Builder

35import qualified Data.Text.Lazy.Encoding as T.Lazy

27import qualified Data.Text.Lazy.Encoding as T.Lazy

36−import Database.V5.Bloodhound as BH

37import Katip as K hiding (logMsg)

28import Katip as K hiding (logMsg)

38import Katip.Core (ItemFunc(..))

29import Katip.Core (ItemFunc(..))

39import Katip.Monadic (KatipContextTState(..))

30import Katip.Monadic (KatipContextTState(..))

40import qualified Katip.Scribes.Handle as K

31import qualified Katip.Scribes.Handle as K

41−import Options.Applicative

42import System.IO

32import System.IO

45−elasticServer :: Parser ElasticServer

46−elasticServer =

47− ElasticServer

48− <$> optional elasticServerAddress

49− <*> optional elasticServerUsername

50− <*> optional elasticServerPassword

51−

52−elasticServerAddress :: Parser Server

53−elasticServerAddress = Server <$> option

54− (T.pack <$> str)

55− (long "elastic-server" <> metavar "ELASTIC_SERVER" <> help

56− "Address of elastic search server"

57− )

58−

59−elasticServerUsername :: Parser ByteString

60−elasticServerUsername = option

61− (encodeUtf8 . T.pack <$> str)

62− (long "elastic-server-username" <> metavar "ELASTIC_SERVER_USERNAME" <> help

63− "Elastic server username"

64− )

65−

66−elasticServerPassword :: Parser ByteString

67−elasticServerPassword = option

68− (encodeUtf8 . T.pack <$> str)

69− (long "elastic-server-password" <> metavar "ELASTIC_SERVER_PASSWORD" <> help

70− "Elastic server password"

71− )

72−

73-- | How to format logs

35-- | How to format logs

74data LogFormat

36data LogFormat

75 = LogBracket -- ^ use `bracketFormat`

37 = LogBracket -- ^ use `bracketFormat`