@@ -2,10 +2,7 @@
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
@@ -20,43 +17,18 @@ import Control.Lens hiding ((.=))
2017import Control.Logger.Internal
2118import Control.Logger.Katip.Scribes.Reopenable
2219import Data.Aeson hiding (Error)
23−import Data.ByteString (ByteString)
2420import qualified Data.HashMap.Strict as HM
2521import Data.Proxy as P
2622import Data.Text (Text)
2723import qualified Data.Text as T
28−import qualified Data.Text.Encoding as T
2924import qualified Data.Text.Lazy.Builder as T.Builder
30−import Database.V5.Bloodhound
3125import Katip as K hiding (logMsg)
3226import Katip.Core (ItemFunc(..), LocJs(..), ProcessIDJs(..))
3327import Katip.Monadic (KatipContextTState(..))
3428import Katip.Scribes.ElasticSearch
3529import Katip.Scribes.ElasticSearch.Internal as K
36−import Network.HTTP.Client
3730
3831
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−
6032logSeverityToKSeverity :: LogSeverity -> Severity
6133logSeverityToKSeverity = \case
6234 Debug -> DebugS
@@ -64,35 +36,6 @@ logSeverityToKSeverity = \case
6436 Warn -> WarningS
6537 Error -> ErrorS
6638
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
9639
9740-- | Adds the @rev-hash@ value to each record.
9841-- Early we copied `msg` to `msg-keyword` here but drop it
@@ -168,12 +111,6 @@ ourItemJson verb item = formatItem $
168111 , "loc" .= fmap LocJs _itemLoc
169112 ]
170113
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−
177114instance LogItem Object where
178115 payloadKeys V0 _ = SomeKeys []
179116 payloadKeys _ _ = AllKeys