From e291a71ef3eee735b11bc77b658d0c454638a157 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Fri, 10 Oct 2025 13:54:19 +0100 Subject: [PATCH] core: do not add entities to batched agent errors (#6351) --- bots/api/TYPES.md | 1 + .../types/typescript/src/types.ts | 1 + src/Simplex/Chat/Controller.hs | 4 +- src/Simplex/Chat/Library/Commands.hs | 4 +- src/Simplex/Chat/Library/Internal.hs | 6 +-- src/Simplex/Chat/Library/Subscriber.hs | 48 ++++++++----------- src/Simplex/Chat/Remote.hs | 2 +- src/Simplex/Chat/View.hs | 8 ++-- 8 files changed, 35 insertions(+), 39 deletions(-) diff --git a/bots/api/TYPES.md b/bots/api/TYPES.md index f7012f2923..d4a46e59ab 100644 --- a/bots/api/TYPES.md +++ b/bots/api/TYPES.md @@ -911,6 +911,7 @@ Error: ErrorAgent: - type: "errorAgent" - agentError: [AgentErrorType](#agenterrortype) +- agentConnId: string - connectionEntity_: [ConnectionEntity](#connectionentity)? ErrorStore: diff --git a/packages/simplex-chat-client/types/typescript/src/types.ts b/packages/simplex-chat-client/types/typescript/src/types.ts index d7c7286b45..64eb1571b9 100644 --- a/packages/simplex-chat-client/types/typescript/src/types.ts +++ b/packages/simplex-chat-client/types/typescript/src/types.ts @@ -941,6 +941,7 @@ export namespace ChatError { export interface ErrorAgent extends Interface { type: "errorAgent" agentError: AgentErrorType + agentConnId: string connectionEntity_?: ConnectionEntity } diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index a48ec3fe55..10c218b84e 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -1238,7 +1238,7 @@ data SlowSQLQuery = SlowSQLQuery data ChatError = ChatError {errorType :: ChatErrorType} - | ChatErrorAgent {agentError :: AgentErrorType, connectionEntity_ :: Maybe ConnectionEntity} + | ChatErrorAgent {agentError :: AgentErrorType, agentConnId :: AgentConnId, connectionEntity_ :: Maybe ConnectionEntity} | ChatErrorStore {storeError :: StoreError} | ChatErrorDatabase {databaseError :: DatabaseError} | ChatErrorRemoteCtrl {remoteCtrlError :: RemoteCtrlError} @@ -1572,7 +1572,7 @@ withAgent :: (AgentClient -> ExceptT AgentErrorType IO a) -> CM a withAgent action = asks smpAgent >>= liftIO . runExceptT . action - >>= liftEither . first (`ChatErrorAgent` Nothing) + >>= liftEither . first (\e -> ChatErrorAgent e (AgentConnId "") Nothing) withAgent' :: (AgentClient -> IO a) -> CM' a withAgent' action = asks smpAgent >>= liftIO . action diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index a140cd4efe..33660dc801 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -3527,7 +3527,7 @@ processChatCommand vr nm = \case deleteCIFiles user filesInfo withAgent (\a -> deleteUser a (aUserId user) delSMPQueues) `catchAllErrors` \case - e@(ChatErrorAgent NO_USER _) -> eToView e + e@(ChatErrorAgent NO_USER _ _) -> eToView e e -> throwError e withFastStore' (`deleteUserRecord` user) when (activeUser user) $ chatWriteVar currentUser Nothing @@ -4139,7 +4139,7 @@ agentSubscriber = do q <- asks $ subQ . smpAgent forever (atomically (readTBQueue q) >>= process) `E.catchAny` \e -> do - eToView' $ ChatErrorAgent (CRITICAL True $ "Message reception stopped: " <> show e) Nothing + eToView' $ ChatErrorAgent (CRITICAL True $ "Message reception stopped: " <> show e) (AgentConnId "") Nothing E.throwIO e where process :: (ACorrId, AEntityId, AEvt) -> CM' () diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index 4177dc6984..74cd0e0d47 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -659,8 +659,8 @@ receiveFileEvt' user ft userApprovedRelays rcvInline_ filePath_ = do rctFileCancelled :: ChatError -> Bool rctFileCancelled = \case - ChatErrorAgent (SMP _ SMP.AUTH) _ -> True - ChatErrorAgent (CONN DUPLICATE _) _ -> True + ChatErrorAgent (SMP _ SMP.AUTH) _ _ -> True + ChatErrorAgent (CONN DUPLICATE _) _ _ -> True _ -> False acceptFileReceive :: User -> RcvFileTransfer -> Bool -> Maybe Bool -> Maybe FilePath -> CM AChatItem @@ -1814,7 +1814,7 @@ deliverMessagesB msgReqs = do Left _ce -> (prev, Left (AP.INTERNAL "ChatError, skip")) -- as long as it is Left, the agent batchers should just step over it prepareBatch (Right req) (Right ar) = Right (req, ar) prepareBatch (Left ce) _ = Left ce -- restore original ChatError - prepareBatch _ (Left ae) = Left $ ChatErrorAgent ae Nothing + prepareBatch _ (Left ae) = Left $ ChatErrorAgent ae (AgentConnId "") Nothing createDelivery :: DB.Connection -> (ChatMsgReq, (AgentMsgId, PQEncryption)) -> IO (Either ChatError ([Int64], PQEncryption)) createDelivery db ((Connection {connId}, _, (_, msgIds)), (agentMsgId, pqEnc')) = do Right . (,pqEnc') <$> mapM (createSndMsgDelivery db (SndMsgDelivery {connId, agentMsgId})) msgIds diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index ab316ddcae..4b71c23fb9 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -104,13 +104,13 @@ processAgentMessage _ _ (DEL_RCVQS delQs) = processAgentMessage _ _ (DEL_CONNS connIds) = toView $ CEvtAgentConnsDeleted $ L.map AgentConnId connIds processAgentMessage _ "" (ERR e) = - eToView $ ChatErrorAgent e Nothing + eToView $ ChatErrorAgent e (AgentConnId "") Nothing processAgentMessage corrId connId msg = do - lockEntity <- critical (withStore (`getChatLockEntity` AgentConnId connId)) + lockEntity <- critical connId (withStore (`getChatLockEntity` AgentConnId connId)) withEntityLock "processAgentMessage" lockEntity $ do vr <- chatVersionRange -- getUserByAConnId never throws logical errors, only SEDBBusyError can be thrown here - critical (withStore' (`getUserByAConnId` AgentConnId connId)) >>= \case + critical connId (withStore' (`getUserByAConnId` AgentConnId connId)) >>= \case Just user -> processAgentMessageConn vr user corrId connId msg `catchAllErrors` eToView _ -> throwChatError $ CENoConnectionUser (AgentConnId connId) @@ -121,10 +121,10 @@ processAgentMessage corrId connId msg = do -- - without ACK the message delivery will be stuck, -- - with ACK message will be lost, as it failed to be saved. -- Full app restart is likely to resolve database condition and the message will be received and processed again. -critical :: CM a -> CM a -critical a = +critical :: ConnId -> CM a -> CM a +critical agentConnId a = a `catchAllErrors` \case - ChatErrorStore SEDBBusyError {message} -> throwError $ ChatErrorAgent (CRITICAL True message) Nothing + ChatErrorStore SEDBBusyError {message} -> throwError $ ChatErrorAgent (CRITICAL True message) (AgentConnId agentConnId) Nothing e -> throwError e processAgentMessageNoConn :: AEvent 'AENone -> CM () @@ -145,15 +145,7 @@ processAgentMessageNoConn = \case where connIds = map AgentConnId conns errsEvent :: [(ConnId, AgentErrorType)] -> CM () - errsEvent cErrs = do - vr <- chatVersionRange - errs <- lift $ rights <$> withStoreBatch' (\db -> map (getChatErr vr db) cErrs) - toView $ CEvtChatErrors errs - where - getChatErr :: VersionRangeChat -> DB.Connection -> (ConnId, AgentErrorType) -> IO ChatError - getChatErr vr db (connId, err) = - let acId = AgentConnId connId - in ChatErrorAgent err <$> (getUserByAConnId db acId $>>= \user -> eitherToMaybe <$> runExceptT (getConnectionEntity db vr user acId)) + errsEvent = toView . CEvtChatErrors . map (\(cId, e) -> ChatErrorAgent e (AgentConnId cId) Nothing) processAgentMsgSndFile :: ACorrId -> SndFileId -> AEvent 'AESndFile -> CM () processAgentMsgSndFile _corrId aFileId msg = do @@ -361,7 +353,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- as in this case no need to ACK message - we can't process messages for this connection anyway. -- SEDBException will be re-trown as CRITICAL as it is likely to indicate a temporary database condition -- that will be resolved with app restart. - entity <- critical $ withStore (\db -> getConnectionEntity db vr user $ AgentConnId agentConnId) >>= updateConnStatus + entity <- critical agentConnId $ withStore (\db -> getConnectionEntity db vr user $ AgentConnId agentConnId) >>= updateConnStatus case agentMessage of END -> case entity of RcvDirectMsgConnection _ (Just ct) -> toView $ CEvtContactAnotherClient user ct @@ -442,13 +434,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = MWARN _ err -> processConnMWARN connEntity conn err MERR _ err -> do - eToView (ChatErrorAgent err $ Just connEntity) + eToView $ ChatErrorAgent err (AgentConnId agentConnId) (Just connEntity) processConnMERR connEntity conn err MERRS _ err -> do -- error cannot be AUTH error here - eToView (ChatErrorAgent err $ Just connEntity) + eToView $ ChatErrorAgent err (AgentConnId agentConnId) (Just connEntity) ERR err -> do - eToView (ChatErrorAgent err $ Just connEntity) + eToView $ ChatErrorAgent err (AgentConnId agentConnId) (Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () @@ -663,14 +655,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = processConnMWARN connEntity conn err MERR msgId err -> do updateDirectItemStatus ct conn msgId (CISSndError $ agentSndError err) - eToView (ChatErrorAgent err $ Just connEntity) + eToView $ ChatErrorAgent err (AgentConnId agentConnId) (Just connEntity) processConnMERR connEntity conn err MERRS msgIds err -> do -- error cannot be AUTH error here updateDirectItemsStatusMsgs ct conn (L.toList msgIds) (CISSndError $ agentSndError err) - eToView (ChatErrorAgent err $ Just connEntity) + eToView $ ChatErrorAgent err (AgentConnId agentConnId) (Just connEntity) ERR err -> do - eToView (ChatErrorAgent err $ Just connEntity) + eToView $ ChatErrorAgent err (AgentConnId agentConnId) (Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () @@ -1054,16 +1046,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = MERR msgId err -> do withStore' $ \db -> updateGroupItemsErrorStatus db msgId (groupMemberId' m) (GSSError $ agentSndError err) -- group errors are silenced to reduce load on UI event log - -- eToView (ChatErrorAgent err $ Just connEntity) + -- eToView $ ChatErrorAgent err (AgentConnId agentConnId) (Just connEntity) processConnMERR connEntity conn err MERRS msgIds err -> do let newStatus = GSSError $ agentSndError err -- error cannot be AUTH error here withStore' $ \db -> forM_ msgIds $ \msgId -> updateGroupItemsErrorStatus db msgId (groupMemberId' m) newStatus `catchAll_` pure () - eToView (ChatErrorAgent err $ Just connEntity) + eToView $ ChatErrorAgent err (AgentConnId agentConnId) (Just connEntity) ERR err -> do - eToView (ChatErrorAgent err $ Just connEntity) + eToView $ ChatErrorAgent err (AgentConnId agentConnId) (Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () @@ -1156,10 +1148,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- TODO show/log error, other events in contact request _ -> pure () MERR _ err -> do - eToView (ChatErrorAgent err $ Just connEntity) + eToView $ ChatErrorAgent err (AgentConnId agentConnId) (Just connEntity) processConnMERR connEntity conn err ERR err -> do - eToView (ChatErrorAgent err $ Just connEntity) + eToView $ ChatErrorAgent err (AgentConnId agentConnId) (Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () @@ -1405,7 +1397,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = unless shouldDelConns $ withLog (eInfo <> " ok") $ ackMsg msgMeta $ if withRcpt then Just "" else Nothing -- If showCritical is True, then these errors don't result in ACK and show user visible alert -- This prevents losing the message that failed to be processed. - Left (ChatErrorStore SEDBBusyError {message}) | showCritical -> throwError $ ChatErrorAgent (CRITICAL True message) Nothing + Left (ChatErrorStore SEDBBusyError {message}) | showCritical -> throwError $ ChatErrorAgent (CRITICAL True message) (AgentConnId "") Nothing Left e -> do withLog (eInfo <> " error: " <> tshow e) $ ackMsg msgMeta Nothing throwError e diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs index 47dce826ce..ebbc9296ad 100644 --- a/src/Simplex/Chat/Remote.hs +++ b/src/Simplex/Chat/Remote.hs @@ -531,7 +531,7 @@ handleRemoteCommand execCC encryption remoteOutputQ HTTP2Request {request, reqBo Left e -> eToView' $ ChatErrorRemoteCtrl $ RCEProtocolError e takeRCStep :: RCStepTMVar a -> CM a -takeRCStep = liftError' (\e -> ChatErrorAgent {agentError = RCP e, connectionEntity_ = Nothing}) . atomically . takeTMVar +takeRCStep = liftError' (\e -> ChatErrorAgent {agentError = RCP e, agentConnId = AgentConnId "", connectionEntity_ = Nothing}) . atomically . takeTMVar type GetChunk = Int -> IO ByteString diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 44675c69a2..3a41c5f767 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -2396,7 +2396,7 @@ viewRemoteCtrl CtrlAppInfo {deviceName, appVersionRange = AppVersionRange _ (App viewRemoteCtrlStopped :: RemoteCtrlStopReason -> [StyledString] viewRemoteCtrlStopped = \case - RCSRConnectionFailed (ChatErrorAgent (RCP RCEIdentity) _) -> + RCSRConnectionFailed (ChatErrorAgent (RCP RCEIdentity) _ _) -> ["remote controller stopped: this link was used with another controller, please create a new link on the host"] _ -> ["remote controller stopped"] @@ -2531,7 +2531,7 @@ viewChatError isCmd logLevel testView = \case DBErrorExport e -> ["error encrypting database: " <> sqliteError' e] DBErrorOpen e -> ["error opening database after encryption: " <> sqliteError' e] e -> ["chat database error: " <> sShow e] - ChatErrorAgent err entity_ -> case err of + ChatErrorAgent err (AgentConnId acId) entity_ -> case err of CMD PROHIBITED cxt -> [withConnEntity <> plain ("error: command is prohibited, " <> cxt)] SMP _ SMP.AUTH -> [ withConnEntity @@ -2562,7 +2562,9 @@ viewChatError isCmd logLevel testView = \case "[" <> connEntityLabel entity <> ", groupId: " <> sShow groupId <> ", memberId: " <> sShow groupMemberId <> ", connId: " <> cId conn <> "] " Just entity@(UserContactConnection conn UserContact {userContactLinkId}) -> "[" <> connEntityLabel entity <> ", userContactLinkId: " <> sShow userContactLinkId <> ", connId: " <> cId conn <> "] " - Nothing -> "" + Nothing + | acId == "" -> "" + | otherwise -> plain $ "agent conn ID: " <> acId cId :: Connection -> StyledString cId Connection {connId} = sShow connId ChatErrorRemoteCtrl e -> [plain $ "remote controller error: " <> show e]