@@ -2,14 +2,10 @@
22{-# OPTIONS_GHC -fno-warn-orphans #-}
33
44module Control.Logger.Katip
5− ( ElasticServer(..)
6− , logSeverityToKSeverity
7− , registerElastic
8− , maybeElastic
5+ ( logSeverityToKSeverity
96 , KatipContextTState(..)
107 , getKatipLogger
118 , ourFormatter
12− , ourMapping
139 , katipIndexNameString
1410 , reopenableFileLog
1511 ) where
@@ -20,43 +16,15 @@ import Control.Lens hiding ((.=))
2016import Control.Logger.Internal
2117import Control.Logger.Katip.Scribes.Reopenable
2218import Data.Aeson hiding (Error)
23−import Data.ByteString (ByteString)
2419import qualified Data.HashMap.Strict as HM
25−import Data.Proxy as P
2620import Data.Text (Text)
2721import qualified Data.Text as T
28−import qualified Data.Text.Encoding as T
2922import qualified Data.Text.Lazy.Builder as T.Builder
30−import Database.V5.Bloodhound
3123import Katip as K hiding (logMsg)
3224import Katip.Core (ItemFunc(..), LocJs(..), ProcessIDJs(..))
3325import Katip.Monadic (KatipContextTState(..))
34−import Katip.Scribes.ElasticSearch
35−import Katip.Scribes.ElasticSearch.Internal as K
36−import Network.HTTP.Client
3726
3827
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−
6028logSeverityToKSeverity :: LogSeverity -> Severity
6129logSeverityToKSeverity = \case
6230 Debug -> DebugS
@@ -64,35 +32,6 @@ logSeverityToKSeverity = \case
6432 Warn -> WarningS
6533 Error -> ErrorS
6634
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
9635
9736-- | Adds the @rev-hash@ value to each record.
9837-- Early we copied `msg` to `msg-keyword` here but drop it
@@ -112,41 +51,6 @@ ourFormatter gitRev verb = ItemFunc $ \item -> go $ ourItemJson verb item
11251 setRev :: HM.HashMap Text Value -> HM.HashMap Text Value
11352 setRev = HM.insert "rev-hash" (toJSON gitRev)
11453
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−
15054katipIndexNameString :: Text
15155katipIndexNameString = "antorica-b2b-logs"
15256
@@ -168,12 +72,6 @@ ourItemJson verb item = formatItem $
16872 , "loc" .= fmap LocJs _itemLoc
16973 ]
17074
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−
17775instance LogItem Object where
17876 payloadKeys V0 _ = SomeKeys []
17977 payloadKeys _ _ = AllKeys