diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index ec7a5c0d7b..7664ddaf75 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1136,8 +1136,8 @@ processChatCommand = \case where processError ft = \case -- TODO AChatItem in Cancelled events - ChatErrorAgent (SMP SMP.AUTH) -> pure $ CRRcvFileAcceptedSndCancelled ft - ChatErrorAgent (CONN DUPLICATE) -> pure $ CRRcvFileAcceptedSndCancelled ft + ChatErrorAgent (SMP SMP.AUTH) _ -> pure $ CRRcvFileAcceptedSndCancelled ft + ChatErrorAgent (CONN DUPLICATE) _ -> pure $ CRRcvFileAcceptedSndCancelled ft e -> throwError e CancelFile fileId -> withUser $ \user@User {userId} -> withChatLock "cancelFile" . procCmd $ @@ -1734,7 +1734,7 @@ subscribeUserConnections agentBatchSubscribe user = do addResult connId = (:) . (,err) where err = case M.lookup connId rs of - Just (Left e) -> Just $ ChatErrorAgent e + Just (Left e) -> Just $ ChatErrorAgent e Nothing Just _ -> Nothing _ -> Just . ChatError . CEAgentNoSubResult $ AgentConnId connId @@ -1867,18 +1867,19 @@ processAgentMessage (Just user) _ agentConnId END = showToast (c <> "> ") "connected to another client" unsetActive $ ActiveC c entity -> toView $ CRSubscriptionEnd entity -processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = - (withStore (\db -> getConnectionEntity db user $ AgentConnId agentConnId) >>= updateConnStatus) >>= \case +processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = do + entity <- withStore (\db -> getConnectionEntity db user $ AgentConnId agentConnId) >>= updateConnStatus + case entity of RcvDirectMsgConnection conn contact_ -> - processDirectMessage agentMessage conn contact_ + processDirectMessage agentMessage entity conn contact_ RcvGroupMsgConnection conn gInfo m -> - processGroupMessage agentMessage conn gInfo m + processGroupMessage agentMessage entity conn gInfo m RcvFileConnection conn ft -> - processRcvFileConn agentMessage conn ft + processRcvFileConn agentMessage entity conn ft SndFileConnection conn ft -> - processSndFileConn agentMessage conn ft + processSndFileConn agentMessage entity conn ft UserContactConnection conn uc -> - processUserContactRequest agentMessage conn uc + processUserContactRequest agentMessage entity conn uc where updateConnStatus :: ConnectionEntity -> m ConnectionEntity updateConnStatus acEntity = case agentMsgConnStatus agentMessage of @@ -1899,8 +1900,8 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = CON -> Just ConnReady _ -> Nothing - processDirectMessage :: ACommand 'Agent -> Connection -> Maybe Contact -> m () - processDirectMessage agentMsg conn@Connection {connId, viaUserContactLink, groupLinkId, customUserProfileId} = \case + processDirectMessage :: ACommand 'Agent -> ConnectionEntity -> Connection -> Maybe Contact -> m () + processDirectMessage agentMsg connEntity conn@Connection {connId, viaUserContactLink, groupLinkId, customUserProfileId} = \case Nothing -> case agentMsg of CONF confId _ connInfo -> do -- [incognito] send saved profile @@ -1922,9 +1923,9 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = -- [async agent commands] continuation on receiving OK withCompletedCommand conn agentMsg $ \CommandData {cmdFunction, cmdId} -> when (cmdFunction == CFAckMessage) $ ackMsgDeliveryEvent conn cmdId - MERR _ err -> toView . CRChatError $ ChatErrorAgent err -- ? updateDirectChatItemStatus + MERR _ err -> toView . CRChatError $ ChatErrorAgent err (Just connEntity) -- ? updateDirectChatItemStatus ERR err -> do - toView . CRChatError $ ChatErrorAgent err + toView . CRChatError $ ChatErrorAgent err (Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () @@ -2037,14 +2038,15 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = forM_ chatItemId_ $ \chatItemId -> do chatItem <- withStore $ \db -> updateDirectChatItemStatus db user contactId chatItemId (agentErrToItemStatus err) toView $ CRChatItemStatusUpdated (AChatItem SCTDirect SMDSnd (DirectChat ct) chatItem) + toView . CRChatError $ ChatErrorAgent err (Just connEntity) ERR err -> do - toView . CRChatError $ ChatErrorAgent err + toView . CRChatError $ ChatErrorAgent err (Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () - processGroupMessage :: ACommand 'Agent -> Connection -> GroupInfo -> GroupMember -> m () - processGroupMessage agentMsg conn@Connection {connId} gInfo@GroupInfo {groupId, localDisplayName = gName, groupProfile, membership, chatSettings} m = case agentMsg of + processGroupMessage :: ACommand 'Agent -> ConnectionEntity -> Connection -> GroupInfo -> GroupMember -> m () + processGroupMessage agentMsg connEntity conn@Connection {connId} gInfo@GroupInfo {groupId, localDisplayName = gName, groupProfile, membership, chatSettings} m = case agentMsg of INV (ACR _ cReq) -> withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} -> case cReq of @@ -2183,15 +2185,15 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = -- [async agent commands] continuation on receiving OK withCompletedCommand conn agentMsg $ \CommandData {cmdFunction, cmdId} -> when (cmdFunction == CFAckMessage) $ ackMsgDeliveryEvent conn cmdId - MERR _ err -> toView . CRChatError $ ChatErrorAgent err + MERR _ err -> toView . CRChatError $ ChatErrorAgent err (Just connEntity) ERR err -> do - toView . CRChatError $ ChatErrorAgent err + toView . CRChatError $ ChatErrorAgent err (Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () - processSndFileConn :: ACommand 'Agent -> Connection -> SndFileTransfer -> m () - processSndFileConn agentMsg conn ft@SndFileTransfer {fileId, fileName, fileStatus} = + processSndFileConn :: ACommand 'Agent -> ConnectionEntity -> Connection -> SndFileTransfer -> m () + processSndFileConn agentMsg connEntity conn ft@SndFileTransfer {fileId, fileName, fileStatus} = case agentMsg of -- SMP CONF for SndFileConnection happens for direct file protocol -- when recipient of the file "joins" connection created by the sender @@ -2229,13 +2231,13 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = -- [async agent commands] continuation on receiving OK withCompletedCommand conn agentMsg $ \_cmdData -> pure () ERR err -> do - toView . CRChatError $ ChatErrorAgent err + toView . CRChatError $ ChatErrorAgent err (Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () - processRcvFileConn :: ACommand 'Agent -> Connection -> RcvFileTransfer -> m () - processRcvFileConn agentMsg conn ft@RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}, grpMemberId} = + processRcvFileConn :: ACommand 'Agent -> ConnectionEntity -> Connection -> RcvFileTransfer -> m () + processRcvFileConn agentMsg connEntity conn ft@RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}, grpMemberId} = case agentMsg of INV (ACR _ cReq) -> withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} -> @@ -2274,9 +2276,9 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = OK -> -- [async agent commands] continuation on receiving OK withCompletedCommand conn agentMsg $ \_cmdData -> pure () - MERR _ err -> toView . CRChatError $ ChatErrorAgent err + MERR _ err -> toView . CRChatError $ ChatErrorAgent err (Just connEntity) ERR err -> do - toView . CRChatError $ ChatErrorAgent err + toView . CRChatError $ ChatErrorAgent err (Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () @@ -2323,8 +2325,8 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = RcvChunkDuplicate -> pure () RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo - processUserContactRequest :: ACommand 'Agent -> Connection -> UserContact -> m () - processUserContactRequest agentMsg conn UserContact {userContactLinkId} = case agentMsg of + processUserContactRequest :: ACommand 'Agent -> ConnectionEntity -> Connection -> UserContact -> m () + processUserContactRequest agentMsg connEntity conn UserContact {userContactLinkId} = case agentMsg of REQ invId _ connInfo -> do ChatMessage {chatMsgEvent} <- parseChatMessage connInfo case chatMsgEvent of @@ -2332,9 +2334,9 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = XInfo p -> profileContactRequest invId p Nothing -- TODO show/log error, other events in contact request _ -> pure () - MERR _ err -> toView . CRChatError $ ChatErrorAgent err + MERR _ err -> toView . CRChatError $ ChatErrorAgent err (Just connEntity) ERR err -> do - toView . CRChatError $ ChatErrorAgent err + toView . CRChatError $ ChatErrorAgent err (Just connEntity) when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure () -- TODO add debugging output _ -> pure () @@ -3604,7 +3606,7 @@ withAgent :: ChatMonad m => (AgentClient -> ExceptT AgentErrorType m a) -> m a withAgent action = asks smpAgent >>= runExceptT . action - >>= liftEither . first ChatErrorAgent + >>= liftEither . first (\e -> ChatErrorAgent e Nothing) withStore' :: ChatMonad m => (DB.Connection -> IO a) -> m a withStore' action = withStore $ liftIO . action diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index bae3ca83e0..8ce17df96a 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -540,7 +540,7 @@ tmeToPref currentTTL tme = uncurry TimedMessagesPreference $ case tme of data ChatError = ChatError {errorType :: ChatErrorType} - | ChatErrorAgent {agentError :: AgentErrorType} + | ChatErrorAgent {agentError :: AgentErrorType, connectionEntity_ :: Maybe ConnectionEntity} | ChatErrorStore {storeError :: StoreError} | ChatErrorDatabase {databaseError :: DatabaseError} deriving (Show, Exception, Generic) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index b4cab70b78..fc7b6508fd 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1201,15 +1201,33 @@ viewChatError = \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 -> case err of + ChatErrorAgent err entity -> case err of SMP SMP.AUTH -> - [ "error: connection authorization failed - this could happen if connection was deleted,\ - \ secured with different credentials, or due to a bug - please re-create the connection" + [ withConnEntity + <> "error: connection authorization failed - this could happen if connection was deleted,\ + \ secured with different credentials, or due to a bug - please re-create the connection" ] AGENT A_DUPLICATE -> [] AGENT A_PROHIBITED -> [] CONN NOT_FOUND -> [] - e -> ["smp agent error: " <> sShow e] + e -> [withConnEntity <> "smp agent error: " <> sShow e] + where + withConnEntity = case entity of + Just (RcvDirectMsgConnection conn contact_) -> case contact_ of + Just Contact {contactId, localDisplayName = c} -> + "[" <> ttyFrom c <> ", contactId: " <> sShow contactId <> ", connId: " <> cId conn <> "] " + Nothing -> + "[" <> ttyFrom "rcv direct msg" <> ", connId: " <> cId conn <> "] " + Just (RcvGroupMsgConnection conn g@GroupInfo {groupId} m@GroupMember {groupMemberId}) -> + "[" <> ttyFrom (fromGroup_ g m) <> ", groupId: " <> sShow groupId <> ", memberId: " <> sShow groupMemberId <> ", connId: " <> cId conn <> "] " + Just (RcvFileConnection conn RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}}) -> + "[" <> ttyFrom ("rcv file " <> T.pack fileName) <> ", fileId: " <> sShow fileId <> ", connId: " <> cId conn <> "] " + Just (SndFileConnection conn SndFileTransfer {fileId, fileName}) -> + "[" <> ttyTo ("snd file " <> T.pack fileName) <> ", fileId: " <> sShow fileId <> ", connId: " <> cId conn <> "] " + Just (UserContactConnection conn UserContact {userContactLinkId}) -> + "[" <> ttyFrom "contact address" <> ", userContactLinkId: " <> sShow userContactLinkId <> ", connId: " <> cId conn <> "] " + Nothing -> "" + cId conn = sShow (connId (conn :: Connection)) where fileNotFound fileId = ["file " <> sShow fileId <> " not found"] sqliteError' = \case diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 3a6cedbc7d..c4aac65bf6 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -1023,6 +1023,7 @@ testGroupDeleteInvitedContact = alice ##> "@bob hey" alice <## "no contact bob" bob #> "@alice hey" + bob <## "[alice, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection" (alice "@bob hey" alice <## "no contact bob" bob #> "@alice hey" + bob <## "[alice, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection" (alice "/d #team"