From b7afb725fd5cdfde67a82303535aea0367121023 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Fri, 10 May 2024 10:55:19 +0100 Subject: [PATCH] proxy: send MWARN event to user on server version or host more errors (#1140) * proxy: include delivery path in SENT event * send MWARN event to user on server version or host more errors * Revert "proxy: include delivery path in SENT event" This reverts commit 5c476718ec84f4b9f7e2eca6a7ac7c3b260c0275. --- src/Simplex/Messaging/Agent.hs | 6 +++++- src/Simplex/Messaging/Agent/Client.hs | 26 ++++++++++++++----------- src/Simplex/Messaging/Agent/Protocol.hs | 7 +++++++ 3 files changed, 27 insertions(+), 12 deletions(-) diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 3a0e13157..be0d35cb4 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -1358,7 +1358,11 @@ runSmpQueueMsgDelivery c@AgentClient {subQ} ConnData {connId} sq (Worker {doWork | temporaryOrHostError e -> do let msgTimeout = if msgType == AM_HELLO_ then helloTimeout else messageTimeout expireTs <- addUTCTime (-msgTimeout) <$> liftIO getCurrentTime - if internalTs < expireTs then notifyDelMsgs msgId e expireTs else retrySndMsg RIFast + if internalTs < expireTs + then notifyDelMsgs msgId e expireTs + else do + when (serverHostError e) $ notify $ MWARN (unId msgId) e + retrySndMsg RIFast | otherwise -> notifyDel msgId err where retrySndMsg riMode = do diff --git a/src/Simplex/Messaging/Agent/Client.hs b/src/Simplex/Messaging/Agent/Client.hs index 133fae96a..f2c43fc67 100644 --- a/src/Simplex/Messaging/Agent/Client.hs +++ b/src/Simplex/Messaging/Agent/Client.hs @@ -46,6 +46,7 @@ module Simplex.Messaging.Agent.Client sendInvitation, temporaryAgentError, temporaryOrHostError, + serverHostError, secureQueue, enableQueueNotifications, enableQueuesNtfs, @@ -616,7 +617,7 @@ getSMPProxyClient c@AgentClient {active, smpClients, smpProxiedRelays, workerSeq Left e -> do liftIO $ incClientStat c userId clnt "PROXY" $ strEncode e atomically $ do - unless (persistentProxyError e) $ do + unless (serverHostError e) $ do removeSessVar rv destSrv prs TM.delete destSess smpProxiedRelays putTMVar (sessionVar rv) (Left e) @@ -1060,7 +1061,7 @@ sendOrProxySMPMessage c userId destSrv cmdStr spKey_ senderId msgFlags msg = do case r of Right r' -> pure r' Left e - | persistentProxyError e -> ifM (atomically directAllowed) (sendDirectly destSess $> Nothing) (throwE e) + | serverHostError e -> ifM (atomically directAllowed) (sendDirectly destSess $> Nothing) (throwE e) | otherwise -> throwE e sendDirectly tSess = withLogClient_ c tSess senderId ("SEND " <> cmdStr) $ \(SMPConnectedClient smp _) -> @@ -1303,17 +1304,20 @@ temporaryAgentError = \case _ -> False temporaryOrHostError :: AgentErrorType -> Bool -temporaryOrHostError = \case - BROKER _ HOST -> True - SMP (SMP.PROXY (SMP.BROKER HOST)) -> True - PROXY _ _ (ProxyProtocolError (SMP.PROXY (SMP.BROKER HOST))) -> True - e -> temporaryAgentError e +temporaryOrHostError e = temporaryAgentError e || serverHostError e +{-# INLINE temporaryOrHostError #-} -persistentProxyError :: AgentErrorType -> Bool -persistentProxyError = \case - BROKER _ (SMP.TRANSPORT TEVersion) -> True - SMP (SMP.PROXY (SMP.BROKER (SMP.TRANSPORT TEVersion))) -> True +serverHostError :: AgentErrorType -> Bool +serverHostError = \case + BROKER _ e -> brokerHostError e + SMP (SMP.PROXY (SMP.BROKER e)) -> brokerHostError e + PROXY _ _ (ProxyProtocolError (SMP.PROXY (SMP.BROKER e))) -> brokerHostError e _ -> False + where + brokerHostError = \case + HOST -> True + SMP.TRANSPORT TEVersion -> True + _ -> False -- | Subscribe to queues. The list of results can have a different order. subscribeQueues :: AgentClient -> [RcvQueue] -> AM' [(RcvQueue, Either AgentErrorType ())] diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 7160863f1..a18f64064 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -396,6 +396,7 @@ data ACommand (p :: AParty) (e :: AEntity) where SEND :: PQEncryption -> MsgFlags -> MsgBody -> ACommand Client AEConn MID :: AgentMsgId -> PQEncryption -> ACommand Agent AEConn SENT :: AgentMsgId -> Maybe SMPServer -> ACommand Agent AEConn + MWARN :: AgentMsgId -> AgentErrorType -> ACommand Agent AEConn MERR :: AgentMsgId -> AgentErrorType -> ACommand Agent AEConn MERRS :: NonEmpty AgentMsgId -> AgentErrorType -> ACommand Agent AEConn MSG :: MsgMeta -> MsgFlags -> MsgBody -> ACommand Agent AEConn @@ -459,6 +460,7 @@ data ACommandTag (p :: AParty) (e :: AEntity) where SEND_ :: ACommandTag Client AEConn MID_ :: ACommandTag Agent AEConn SENT_ :: ACommandTag Agent AEConn + MWARN_ :: ACommandTag Agent AEConn MERR_ :: ACommandTag Agent AEConn MERRS_ :: ACommandTag Agent AEConn MSG_ :: ACommandTag Agent AEConn @@ -515,6 +517,7 @@ aCommandTag = \case SEND {} -> SEND_ MID {} -> MID_ SENT {} -> SENT_ + MWARN {} -> MWARN_ MERR {} -> MERR_ MERRS {} -> MERRS_ MSG {} -> MSG_ @@ -1668,6 +1671,7 @@ instance StrEncoding ACmdTag where "SEND" -> t SEND_ "MID" -> ct MID_ "SENT" -> ct SENT_ + "MWARN" -> ct MWARN_ "MERR" -> ct MERR_ "MERRS" -> ct MERRS_ "MSG" -> ct MSG_ @@ -1726,6 +1730,7 @@ instance (APartyI p, AEntityI e) => StrEncoding (ACommandTag p e) where SEND_ -> "SEND" MID_ -> "MID" SENT_ -> "SENT" + MWARN_ -> "MWARN" MERR_ -> "MERR" MERRS_ -> "MERRS" MSG_ -> "MSG" @@ -1797,6 +1802,7 @@ commandP binaryP = RSYNC_ -> s (RSYNC <$> strP_ <*> strP <*> strP) MID_ -> s (MID <$> A.decimal <*> _strP) SENT_ -> s (SENT <$> A.decimal <*> _strP) + MWARN_ -> s (MWARN <$> A.decimal <* A.space <*> strP) MERR_ -> s (MERR <$> A.decimal <* A.space <*> strP) MERRS_ -> s (MERRS <$> strP_ <*> strP) MSG_ -> s (MSG <$> strP <* A.space <*> smpP <* A.space <*> binaryP) @@ -1860,6 +1866,7 @@ serializeCommand = \case SEND pqEnc msgFlags msgBody -> B.unwords [s SEND_, s pqEnc, smpEncode msgFlags, serializeBinary msgBody] MID mId pqEnc -> s (MID_, mId, pqEnc) SENT mId proxySrv_ -> s (SENT_, mId, proxySrv_) + MWARN mId e -> s (MWARN_, mId, e) MERR mId e -> s (MERR_, mId, e) MERRS mIds e -> s (MERRS_, mIds, e) MSG msgMeta msgFlags msgBody -> B.unwords [s MSG_, s msgMeta, smpEncode msgFlags, serializeBinary msgBody]