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 5c476718ec.

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

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 ())]

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]