From 42309096e1b1cea070db864a36da64137e655481 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Thu, 27 Jul 2023 11:20:57 +0300 Subject: [PATCH] reduced noise in log --- hbs2-core/lib/HBS2/System/Logger/Simple.hs | 1 + hbs2-peer/app/PeerMain.hs | 10 ++++++++++ hbs2-peer/app/PeerTypes.hs | 12 ++++++++++++ hbs2-peer/app/ProxyMessaging.hs | 16 +++++++++------- 4 files changed, 32 insertions(+), 7 deletions(-) diff --git a/hbs2-core/lib/HBS2/System/Logger/Simple.hs b/hbs2-core/lib/HBS2/System/Logger/Simple.hs index 3955dc3e..7e4adcc6 100644 --- a/hbs2-core/lib/HBS2/System/Logger/Simple.hs +++ b/hbs2-core/lib/HBS2/System/Logger/Simple.hs @@ -20,6 +20,7 @@ module HBS2.System.Logger.Simple , logPrefix , SetLoggerEntry , module HBS2.System.Logger.Simple.Class + , ToLogStr(..) ) where import HBS2.System.Logger.Simple.Class diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index ff9ebe17..e434e8ef 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -123,6 +123,7 @@ data PeerWhiteListKey data PeerStorageKey data PeerAcceptAnnounceKey data PeerTraceKey +data PeerTrace1Key data PeerProxyFetchKey data AcceptAnnounce = AcceptAnnounceAll @@ -138,6 +139,9 @@ instance Pretty AcceptAnnounce where instance HasCfgKey PeerTraceKey FeatureSwitch where key = "trace" +instance HasCfgKey PeerTrace1Key FeatureSwitch where + key = "trace1" + instance HasCfgKey PeerListenKey (Maybe String) where key = "listen" @@ -211,6 +215,7 @@ main = do setLogging @NOTICE noticePrefix setLoggingOff @TRACE + setLoggingOff @TRACE1 withSimpleLogger runCLI @@ -459,6 +464,7 @@ runPeer opts = U.handle (\e -> myException e let keyConf = cfgValue @PeerKeyFileKey conf let storConf = cfgValue @PeerStorageKey conf <&> StoragePrefix let traceConf = cfgValue @PeerTraceKey conf :: FeatureSwitch + let trace1Conf = cfgValue @PeerTrace1Key conf :: FeatureSwitch let listenSa = view listenOn opts <|> listenConf <|> Just defListenUDP let rpcSa = view listenRpc opts <|> rpcConf <|> Just defRpcUDP @@ -469,10 +475,14 @@ runPeer opts = U.handle (\e -> myException e debug $ "storage prefix:" <+> pretty pref debug $ pretty "trace: " <+> pretty (show traceConf) + debug $ pretty "trace1: " <+> pretty (show trace1Conf) when (traceConf == FeatureOn) do setLogging @TRACE tracePrefix + when (trace1Conf == FeatureOn) do + setLogging @TRACE1 tracePrefix + let bls = cfgValue @PeerBlackListKey conf :: Set String let whs = cfgValue @PeerWhiteListKey conf :: Set String let toKeys xs = Set.fromList diff --git a/hbs2-peer/app/PeerTypes.hs b/hbs2-peer/app/PeerTypes.hs index fe9b08a5..e0251e31 100644 --- a/hbs2-peer/app/PeerTypes.hs +++ b/hbs2-peer/app/PeerTypes.hs @@ -30,6 +30,7 @@ import HBS2.System.Logger.Simple import Brains import PeerConfig +import Prelude hiding (log) import Data.Foldable (for_) import Control.Concurrent.Async import Control.Concurrent.STM @@ -482,3 +483,14 @@ instance (ForGossip e p (PeerM e IO)) => HasGossip e p (PeerM e IO) where instance (ForGossip e p (ResponseM e m), HasGossip e p m) => HasGossip e p (ResponseM e m) where gossip = lift . gossip + +data TRACE1 + +instance HasLogLevel TRACE1 where + type instance LogLevel TRACE1 = 101 + +trace1 :: (MonadIO m, ToLogStr a) => a -> m () +trace1 = log @TRACE1 + + + diff --git a/hbs2-peer/app/ProxyMessaging.hs b/hbs2-peer/app/ProxyMessaging.hs index 0c2be25c..a6a9bf9d 100644 --- a/hbs2-peer/app/ProxyMessaging.hs +++ b/hbs2-peer/app/ProxyMessaging.hs @@ -19,6 +19,8 @@ import HBS2.Net.Messaging.TCP import HBS2.System.Logger.Simple +import PeerTypes + import Crypto.Saltine.Class as SCl import Crypto.Saltine.Core.Box qualified as Encrypt @@ -142,10 +144,10 @@ sendToProxyMessaging bus t@(To whom) proto msg = do mencKey <- liftIO $ _proxy_getEncryptionKey bus whom cf <- case mencKey of Nothing -> do - trace $ "ENCRYPTION SEND: sending plain message to" <+> pretty whom + trace1 $ "ENCRYPTION SEND: sending plain message to" <+> pretty whom pure id Just k -> do - trace $ "ENCRYPTION SEND: sending encrypted message to" <+> pretty whom <+> "with key" <+> viaShow k + trace1 $ "ENCRYPTION SEND: sending encrypted message to" <+> pretty whom <+> "with key" <+> viaShow k boxAfterNMLazy k <$> liftIO Encrypt.newNonce sendToPlainProxyMessaging bus t proto (cf msg) @@ -177,7 +179,7 @@ receiveFromProxyMessaging bus _ = liftIO do dfm = \whom msg -> liftIO $ _proxy_getEncryptionKey bus whom >>= \case Nothing -> do - trace $ "ENCRYPTION RECEIVE: we do not have a key to decode" <+> pretty whom + trace1 $ "ENCRYPTION RECEIVE: we do not have a key to decode" <+> pretty whom liftIO $ _proxy_sendBeginEncryptionExchange bus whom pure (Just msg) @@ -189,23 +191,23 @@ receiveFromProxyMessaging bus _ = liftIO do liftIO $ _proxy_sendResetEncryptionKeys bus whom - trace $ "ENCRYPTION RECEIVE: got plain message. clearing key of" <+> pretty whom + trace1 $ "ENCRYPTION RECEIVE: got plain message. clearing key of" <+> pretty whom pure msg )) $ do trace $ "ENCRYPTION RECEIVE: we have a key to decode from" <+> pretty whom <+> ":" <+> viaShow k case ((extractNonce . cs) msg) of Nothing -> do - trace $ "ENCRYPTION RECEIVE: can not extract nonce from" <+> pretty whom <+> "message" <+> viaShow msg + trace1 $ "ENCRYPTION RECEIVE: can not extract nonce from" <+> pretty whom <+> "message" <+> viaShow msg fail "" Just (nonce, msg') -> ((MaybeT . pure) (boxOpenAfterNMLazy k nonce msg') - <* (trace $ "ENCRYPTION RECEIVE: message successfully decoded from" <+> pretty whom) + <* (trace1 $ "ENCRYPTION RECEIVE: message successfully decoded from" <+> pretty whom) ) <|> (do - (trace $ "ENCRYPTION RECEIVE: can not decode message from" <+> pretty whom) + (trace1 $ "ENCRYPTION RECEIVE: can not decode message from" <+> pretty whom) fail "" -- -- Попытаться десериализовать сообщение как PeerPing или PeerPingCrypted