From 26e278655f088bda73436b86ea4b595aae7a857d Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Mon, 17 Jun 2024 13:41:20 +0400 Subject: [PATCH] wip --- src/Simplex/Messaging/Agent/Client.hs | 24 ++++++++++++++++++------ src/Simplex/Messaging/Agent/Stats.hs | 7 +++---- 2 files changed, 21 insertions(+), 10 deletions(-) diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index e0c976d9b..be9947cf8 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -1071,7 +1071,10 @@ sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg = do unknownServer = maybe True (all ((destSrv /=) . protoServer)) <$> TM.lookup userId (userServers c) sendViaProxy destSess@(_, _, qId) = do r <- tryAgentError . withProxySession c destSess senderId ("PFWD " <> cmdStr) $ \(SMPConnectedClient smp _, proxySess) -> do - liftClient SMP (clientServer smp) (proxySMPMessage smp proxySess spKey_ senderId msgFlags msg) >>= \case + r' <- liftClient SMP (clientServer smp) $ do + atomically $ incSMPServerStat c userId destSrv sentViaProxyAttempts 1 + proxySMPMessage smp proxySess spKey_ senderId msgFlags msg + case r' of Right () -> pure . Just $ protocolClientServer' smp Left proxyErr -> do case proxyErr of @@ -1099,15 +1102,24 @@ sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg = do sameClient smp' = sessionId (thParams smp) == sessionId (thParams smp') sameProxiedRelay proxySess' = prSessionId proxySess == prSessionId proxySess' case r of - Right r' -> pure r' + Right r' -> do + atomically $ incSMPServerStat c userId destSrv sentViaProxy 1 + pure r' Left e | serverHostError e -> ifM (atomically directAllowed) (sendDirectly destSess $> Nothing) (throwE e) | otherwise -> throwE e sendDirectly tSess = - withLogClient_ c tSess senderId ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> - liftClient SMP (clientServer smp) $ do - sendSMPMessage smp spKey_ senderId msgFlags msg - atomically $ incSMPServerStat c userId destSrv sentDirect 1 + withLogClient_ c tSess senderId ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> do + r <- + tryAgentError $ + liftClient SMP (clientServer smp) $ do + atomically $ incSMPServerStat c userId destSrv sentDirectAttempts 1 + sendSMPMessage smp spKey_ senderId msgFlags msg + case r of + Right () -> do + atomically $ incSMPServerStat c userId destSrv sentDirect 1 + pure () + Left e -> throwE e ipAddressProtected :: NetworkConfig -> ProtocolServer p -> Bool ipAddressProtected NetworkConfig {socksProxy, hostMode} (ProtocolServer _ hosts _ _) = do diff --git a/src/Simplex/Messaging/Agent/Stats.hs b/src/Simplex/Messaging/Agent/Stats.hs index 1e3e98fdb..f7d013163 100644 --- a/src/Simplex/Messaging/Agent/Stats.hs +++ b/src/Simplex/Messaging/Agent/Stats.hs @@ -6,7 +6,6 @@ module Simplex.Messaging.Agent.Stats where import qualified Data.Aeson.TH as J import Data.Map (Map) -import Data.Time.Clock (UTCTime (..)) import Simplex.Messaging.Agent.Protocol (UserId) import Simplex.Messaging.Parsers (defaultJSON) import Simplex.Messaging.Protocol (SMPServer, XFTPServer) @@ -16,7 +15,7 @@ data AgentSMPServerStats = AgentSMPServerStats { sentDirect :: TVar Int, -- successfully sent messages sentViaProxy :: TVar Int, -- successfully sent messages via proxy sentDirectAttempts :: TVar Int, -- direct sending attempts (min 1 for each sent message) - sentViaProxyAttempts :: TVar Int, -- proxy sending retries + sentViaProxyAttempts :: TVar Int, -- proxy sending attempts sentAuthErrs :: TVar Int, -- send AUTH errors sentQuotaErrs :: TVar Int, -- send QUOTA permanent errors (message expired) sentExpiredErrs :: TVar Int, -- send expired errors @@ -31,8 +30,8 @@ data AgentSMPServerStats = AgentSMPServerStats connCompleted :: TVar Int, connDeleted :: TVar Int, connSubscribed :: TVar Int, -- total successful subscription - connSubAttempts :: TVar Int, -- subscription retries - connSubErrs :: TVar Int -- permanent subscription errors (temporary accounted for in retries) + connSubAttempts :: TVar Int, -- subscription attempts + connSubErrs :: TVar Int -- permanent subscription errors (temporary accounted for in attempts) } data AgentSMPServerStatsData = AgentSMPServerStatsData