diff --git a/cabal.project b/cabal.project index c911d28f0f..c139521322 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 413aad5139acee28033404aed2e5516fc71c337c + tag: a2eea4f18f61a954daf1aa0559c0acf0ef0b1bd2 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 1c2e90c3a8..aca58898e0 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."413aad5139acee28033404aed2e5516fc71c337c" = "0vzmglhnbr2x9frs597sg6v8if1hfydbmnza5532sc486qms0vmg"; + "https://github.com/simplex-chat/simplexmq.git"."a2eea4f18f61a954daf1aa0559c0acf0ef0b1bd2" = "0s7pkqgfcs9z4rmv533pnxr60xpqgg4aqkkizbn7icn4a6jiwl6y"; "https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd"; "https://github.com/simplex-chat/sqlcipher-simple.git"."5e154a2aeccc33ead6c243ec07195ab673137221" = "1d1gc5wax4vqg0801ajsmx1sbwvd9y7p7b8mmskvqsmpbwgbh0m0"; "https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 664768a7fe..7c80c7e1e4 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -468,8 +468,7 @@ processChatCommand = \case forM_ filesInfo $ \fileInfo -> do cancelFile user fileInfo `catchError` \_ -> pure () withFilesFolder $ \filesFolder -> deleteFile filesFolder fileInfo - withAgent $ \a -> forM_ conns $ \conn -> - deleteConnection a (aConnId conn) `catchError` \(_ :: AgentErrorType) -> pure () + forM_ conns $ \conn -> deleteAgentConnectionAsync user conn `catchError` \_ -> pure () -- functions below are called in separate transactions to prevent crashes on android -- (possibly, race condition on integrity check?) withStore' $ \db -> deleteContactConnectionsAndFiles db userId ct @@ -478,8 +477,8 @@ processChatCommand = \case pure $ CRContactDeleted ct gs -> throwChatError $ CEContactGroups ct gs CTContactConnection -> withChatLock . procCmd $ do - conn <- withStore $ \db -> getPendingContactConnection db userId chatId - withAgent $ \a -> deleteConnection a $ aConnId' conn + conn@PendingContactConnection {pccConnId, pccAgentConnId} <- withStore $ \db -> getPendingContactConnection db userId chatId + deleteAgentConnectionAsync' user pccConnId pccAgentConnId withStore' $ \db -> deletePendingContactConnection db userId chatId pure $ CRContactConnectionDeleted conn CTGroup -> do @@ -489,7 +488,7 @@ processChatCommand = \case void $ clearGroupContent user gInfo withChatLock . procCmd $ do when (memberActive membership) . void $ sendGroupMessage gInfo members XGrpDel - mapM_ deleteMemberConnection members + forM_ members $ deleteMemberConnection user -- functions below are called in separate transactions to prevent crashes on android -- (possibly, race condition on integrity check?) withStore' $ \db -> deleteGroupConnectionsAndFiles db user gInfo members @@ -737,8 +736,7 @@ processChatCommand = \case DeleteMyAddress -> withUser $ \user -> withChatLock $ do conns <- withStore (`getUserContactLinkConnections` user) procCmd $ do - withAgent $ \a -> forM_ conns $ \conn -> - deleteConnection a (aConnId conn) `catchError` \(_ :: AgentErrorType) -> pure () + forM_ conns $ \conn -> deleteAgentConnectionAsync user conn `catchError` \_ -> pure () withStore' (`deleteUserContactLink` user) pure CRUserContactLinkDeleted ShowMyAddress -> withUser $ \User {userId} -> @@ -849,13 +847,13 @@ processChatCommand = \case withChatLock . procCmd $ do case mStatus of GSMemInvited -> do - deleteMemberConnection m + deleteMemberConnection user m withStore' $ \db -> deleteGroupMember db user m _ -> do msg <- sendGroupMessage gInfo members $ XGrpMemDel mId ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent $ SGEMemberDeleted memberId (fromLocalProfile memberProfile)) Nothing Nothing toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci - deleteMemberConnection m + deleteMemberConnection user m withStore' $ \db -> updateGroupMemberStatus db userId m GSMemRemoved pure $ CRUserDeletedMember gInfo m {memberStatus = GSMemRemoved} APILeaveGroup groupId -> withUser $ \user@User {userId} -> do @@ -865,7 +863,7 @@ processChatCommand = \case ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndGroupEvent SGEUserLeft) Nothing Nothing toView . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci -- TODO delete direct connections that were unused - mapM_ deleteMemberConnection members + forM_ members $ deleteMemberConnection user withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemLeft pure $ CRLeftMemberUser gInfo {membership = membership {memberStatus = GSMemLeft}} APIListMembers groupId -> CRGroupMembers <$> withUser (\user -> withStore (\db -> getGroup db user groupId)) @@ -1744,7 +1742,7 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM withStore' $ \db -> updateSndFileChunkSent db ft msgId unless (fileStatus == FSCancelled) $ sendFileChunk user ft MERR _ err -> do - cancelSndFileTransfer ft + cancelSndFileTransfer user ft case err of SMP SMP.AUTH -> unless (fileStatus == FSCancelled) $ do ci <- withStore $ \db -> getChatItemByFileId db user fileId @@ -1811,7 +1809,7 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM getChatItemByFileId db user fileId toView $ CRRcvFileComplete ci closeFileHandle fileId rcvFiles - withAgent (`deleteConnection` agentConnId) + deleteAgentConnectionAsync user conn RcvChunkDuplicate -> pure () RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo OK -> @@ -2350,7 +2348,7 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM members <- withStore' $ \db -> getGroupMembers db user gInfo if memberId (membership :: GroupMember) == memId then do - mapM_ deleteMemberConnection members + forM_ members $ deleteMemberConnection user withStore' $ \db -> updateGroupMemberStatus db userId membership GSMemRemoved ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEUserDeleted) Nothing groupMsgToView gInfo m ci msgMeta @@ -2362,7 +2360,7 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM if mRole < GRAdmin || mRole < memberRole (member :: GroupMember) then messageError "x.grp.mem.del with insufficient member permissions" else do - deleteMemberConnection member + deleteMemberConnection user member withStore' $ \db -> updateGroupMemberStatus db userId member GSMemRemoved ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent $ RGEMemberDeleted groupMemberId (fromLocalProfile memberProfile)) Nothing groupMsgToView gInfo m ci msgMeta @@ -2373,7 +2371,7 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM xGrpLeave :: GroupInfo -> GroupMember -> RcvMessage -> MsgMeta -> m () xGrpLeave gInfo m msg msgMeta = do - deleteMemberConnection m + deleteMemberConnection user m withStore' $ \db -> updateGroupMemberStatus db userId m GSMemLeft ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEMemberLeft) Nothing groupMsgToView gInfo m ci msgMeta @@ -2386,7 +2384,7 @@ processAgentMessage (Just user@User {userId, profile}) corrId agentConnId agentM members <- getGroupMembers db user gInfo updateGroupMemberStatus db userId membership GSMemGroupDeleted pure members - mapM_ deleteMemberConnection ms + forM_ ms $ deleteMemberConnection user ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvGroupEvent RGEGroupDeleted) Nothing groupMsgToView gInfo m ci msgMeta toView $ CRGroupDeleted gInfo {membership = membership {memberStatus = GSMemGroupDeleted}} m @@ -2404,7 +2402,7 @@ parseChatMessage :: ByteString -> Either ChatError ChatMessage parseChatMessage = first (ChatError . CEInvalidChatMessage) . strDecode sendFileChunk :: ChatMonad m => User -> SndFileTransfer -> m () -sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentConnId acId} = +sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, connId, agentConnId} = unless (fileStatus == FSComplete || fileStatus == FSCancelled) $ withStore' (`createSndFileChunk` ft) >>= \case Just chunkNo -> sendFileChunkNo ft chunkNo @@ -2415,7 +2413,7 @@ sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentCo updateDirectCIFileStatus db user fileId CIFSSndComplete toView $ CRSndFileComplete ci ft closeFileHandle fileId sndFiles - withAgent (`deleteConnection` acId) + deleteAgentConnectionAsync' user connId agentConnId sendFileChunkNo :: ChatMonad m => SndFileTransfer -> Integer -> m () sendFileChunkNo ft@SndFileTransfer {agentConnId = AgentConnId acId} chunkNo = do @@ -2496,26 +2494,25 @@ cancelRcvFileTransfer user ft@RcvFileTransfer {fileId, fileStatus} = do updateRcvFileStatus db ft FSCancelled deleteRcvFileChunks db ft case fileStatus of - RFSAccepted RcvFileInfo {agentConnId = AgentConnId acId} -> - withAgent (`deleteConnection` acId) - RFSConnected RcvFileInfo {agentConnId = AgentConnId acId} -> - withAgent (`deleteConnection` acId) + RFSAccepted RcvFileInfo {connId, agentConnId} -> + deleteAgentConnectionAsync' user connId agentConnId + RFSConnected RcvFileInfo {connId, agentConnId} -> + deleteAgentConnectionAsync' user connId agentConnId _ -> pure () cancelSndFile :: ChatMonad m => User -> FileTransferMeta -> [SndFileTransfer] -> m () cancelSndFile user FileTransferMeta {fileId} fts = do withStore' $ \db -> updateFileCancelled db user fileId CIFSSndCancelled - forM_ fts $ \ft' -> cancelSndFileTransfer ft' + forM_ fts $ \ft' -> cancelSndFileTransfer user ft' -cancelSndFileTransfer :: ChatMonad m => SndFileTransfer -> m () -cancelSndFileTransfer ft@SndFileTransfer {agentConnId = AgentConnId acId, fileStatus} = +cancelSndFileTransfer :: ChatMonad m => User -> SndFileTransfer -> m () +cancelSndFileTransfer user ft@SndFileTransfer {connId, agentConnId = agentConnId@(AgentConnId acId), fileStatus} = unless (fileStatus == FSCancelled || fileStatus == FSComplete) $ do withStore' $ \db -> do updateSndFileStatus db ft FSCancelled deleteSndFileChunks db ft - withAgent $ \a -> do - void (sendMessage a acId SMP.noMsgFlags $ smpEncode FileChunkCancel) `catchError` \_ -> pure () - deleteConnection a acId + withAgent $ \a -> void (sendMessage a acId SMP.noMsgFlags $ smpEncode FileChunkCancel) `catchError` \_ -> pure () + deleteAgentConnectionAsync' user connId agentConnId closeFileHandle :: ChatMonad m => Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> m () closeFileHandle fileId files = do @@ -2526,12 +2523,12 @@ closeFileHandle fileId files = do throwChatError :: ChatMonad m => ChatErrorType -> m a throwChatError = throwError . ChatError -deleteMemberConnection :: ChatMonad m => GroupMember -> m () -deleteMemberConnection m@GroupMember {activeConn} = do - -- User {userId} <- asks currentUser - withAgent (forM_ (memberConnId m) . deleteConnection) `catchError` const (pure ()) +deleteMemberConnection :: ChatMonad m => User -> GroupMember -> m () +deleteMemberConnection user GroupMember {activeConn} = do + forM_ activeConn $ \conn -> do + deleteAgentConnectionAsync user conn `catchError` \_ -> pure () + withStore' $ \db -> updateConnectionStatus db conn ConnDeleted -- withStore $ \db -> deleteGroupMemberConnection db userId m - forM_ activeConn $ \conn -> withStore' $ \db -> updateConnectionStatus db conn ConnDeleted sendDirectContactMessage :: ChatMonad m => Contact -> ChatMsgEvent -> m SndMessage sendDirectContactMessage ct@Contact {activeConn = conn@Connection {connId, connStatus}} chatMsgEvent = do @@ -2647,6 +2644,15 @@ allowAgentConnectionAsync user conn@Connection {connId} confId msg = do withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId $ directMessage msg withStore' $ \db -> updateConnectionStatus db conn ConnAccepted +deleteAgentConnectionAsync :: ChatMonad m => User -> Connection -> m () +deleteAgentConnectionAsync user Connection {agentConnId, connId} = + deleteAgentConnectionAsync' user connId agentConnId + +deleteAgentConnectionAsync' :: ChatMonad m => User -> Int64 -> AgentConnId -> m () +deleteAgentConnectionAsync' user connId (AgentConnId acId) = do + cmdId <- withStore' $ \db -> createCommand db user (Just connId) CFDeleteConn + withAgent $ \a -> deleteConnectionAsync a (aCorrId cmdId) acId + getCreateActiveUser :: SQLiteStore -> IO User getCreateActiveUser st = do user <- diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 4e09883929..7f21fe97b7 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -957,6 +957,7 @@ data CommandFunction | CFJoinConn | CFAllowConn | CFAckMessage + | CFDeleteConn deriving (Eq, Show, Generic) instance FromField CommandFunction where fromField = fromTextField_ textDecode @@ -969,12 +970,14 @@ instance TextEncoding CommandFunction where "join_conn" -> Just CFJoinConn "allow_conn" -> Just CFAllowConn "ack_message" -> Just CFAckMessage + "delete_conn" -> Just CFDeleteConn _ -> Nothing textEncode = \case CFCreateConn -> "create_conn" CFJoinConn -> "join_conn" CFAllowConn -> "allow_conn" CFAckMessage -> "ack_message" + CFDeleteConn -> "delete_conn" commandExpectedResponse :: CommandFunction -> ACommandTag 'Agent commandExpectedResponse = \case @@ -982,6 +985,7 @@ commandExpectedResponse = \case CFJoinConn -> OK_ CFAllowConn -> OK_ CFAckMessage -> OK_ + CFDeleteConn -> OK_ data CommandData = CommandData { cmdId :: CommandId, diff --git a/stack.yaml b/stack.yaml index 7c3a539481..34b0fbc7ab 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,7 +49,7 @@ extra-deps: # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561 # - ../simplexmq - github: simplex-chat/simplexmq - commit: 413aad5139acee28033404aed2e5516fc71c337c + commit: a2eea4f18f61a954daf1aa0559c0acf0ef0b1bd2 # - ../direct-sqlcipher - github: simplex-chat/direct-sqlcipher commit: 34309410eb2069b029b8fc1872deb1e0db123294 diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 61b1ccb1c6..e3532130bb 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -2440,39 +2440,70 @@ testAsyncAcceptingOffline = withTmpFiles $ do testFullAsync :: IO () testFullAsync = withTmpFiles $ do + putStrLn "testFullAsync" inv <- withNewTestChat "alice" aliceProfile $ \alice -> do + putStrLn "1" alice ##> "/c" + putStrLn "2" getInvitation alice + putStrLn "3" withNewTestChat "bob" bobProfile $ \bob -> do + putStrLn "4" bob `send` ("/c " <> inv) + putStrLn "5" bob <### ["/c " <> inv, "confirmation sent!"] + putStrLn "6" withTestChat "alice" $ \_ -> pure () -- connecting... notification in UI + putStrLn "7" withTestChat "bob" $ \_ -> pure () -- connecting... notification in UI + putStrLn "8" withTestChat "alice" $ \alice -> do + putStrLn "9" alice <## "1 contacts connected (use /cs for the list)" + putStrLn "10" alice <## "bob (Bob): contact is connected" + putStrLn "11" withTestChat "bob" $ \bob -> do + putStrLn "12" bob <## "1 contacts connected (use /cs for the list)" + putStrLn "13" bob <## "alice (Alice): contact is connected" testFullAsyncV1 :: IO () testFullAsyncV1 = withTmpFiles $ do + putStrLn "testFullAsyncV1" inv <- withNewAlice $ \alice -> do + putStrLn "1" alice ##> "/c" + putStrLn "2" getInvitation alice + putStrLn "3" withNewBob $ \bob -> do + putStrLn "4" bob ##> ("/c " <> inv) + putStrLn "5" bob <## "confirmation sent!" + putStrLn "6" withAlice $ \_ -> pure () + putStrLn "7" withBob $ \_ -> pure () - withAlice $ \alice -> - alice <## "1 contacts connected (use /cs for the list)" - withBob $ \_ -> pure () + putStrLn "8" withAlice $ \alice -> do + putStrLn "9" alice <## "1 contacts connected (use /cs for the list)" + putStrLn "10" + withBob $ \_ -> pure () + putStrLn "11" + withAlice $ \alice -> do + putStrLn "12" + alice <## "1 contacts connected (use /cs for the list)" + putStrLn "13" alice <## "bob (Bob): contact is connected" + putStrLn "14" withBob $ \bob -> do + putStrLn "15" bob <## "1 contacts connected (use /cs for the list)" + putStrLn "16" bob <## "alice (Alice): contact is connected" where withNewAlice = withNewTestChatV1 "alice" aliceProfile @@ -2482,22 +2513,38 @@ testFullAsyncV1 = withTmpFiles $ do testFullAsyncV1toV2 :: IO () testFullAsyncV1toV2 = withTmpFiles $ do + putStrLn "testFullAsyncV1toV2" inv <- withNewAlice $ \alice -> do + putStrLn "1" alice ##> "/c" + putStrLn "2" getInvitation alice + putStrLn "3" withNewBob $ \bob -> do + putStrLn "4" bob ##> ("/c " <> inv) + putStrLn "5" bob <## "confirmation sent!" withAlice $ \_ -> pure () + putStrLn "6" withBob $ \_ -> pure () - withAlice $ \alice -> - alice <## "1 contacts connected (use /cs for the list)" - withBob $ \_ -> pure () + putStrLn "7" withAlice $ \alice -> do + putStrLn "8" alice <## "1 contacts connected (use /cs for the list)" + putStrLn "9" + withBob $ \_ -> pure () + putStrLn "10" + withAlice $ \alice -> do + putStrLn "11" + alice <## "1 contacts connected (use /cs for the list)" + putStrLn "12" alice <## "bob (Bob): contact is connected" + putStrLn "13" withBob $ \bob -> do + putStrLn "14" bob <## "1 contacts connected (use /cs for the list)" + putStrLn "15" bob <## "alice (Alice): contact is connected" where withNewAlice = withNewTestChat "alice" aliceProfile @@ -2507,22 +2554,39 @@ testFullAsyncV1toV2 = withTmpFiles $ do testFullAsyncV2toV1 :: IO () testFullAsyncV2toV1 = withTmpFiles $ do + putStrLn "testFullAsyncV2toV1" inv <- withNewAlice $ \alice -> do + putStrLn "1" alice ##> "/c" + putStrLn "2" getInvitation alice + putStrLn "3" withNewBob $ \bob -> do + putStrLn "4" bob ##> ("/c " <> inv) + putStrLn "5" bob <## "confirmation sent!" + putStrLn "6" withAlice $ \_ -> pure () + putStrLn "7" withBob $ \_ -> pure () - withAlice $ \alice -> - alice <## "1 contacts connected (use /cs for the list)" - withBob $ \_ -> pure () + putStrLn "8" withAlice $ \alice -> do + putStrLn "9" alice <## "1 contacts connected (use /cs for the list)" + putStrLn "10" + withBob $ \_ -> pure () + putStrLn "11" + withAlice $ \alice -> do + putStrLn "12" + alice <## "1 contacts connected (use /cs for the list)" + putStrLn "13" alice <## "bob (Bob): contact is connected" + putStrLn "14" withBob $ \bob -> do + putStrLn "15" bob <## "1 contacts connected (use /cs for the list)" + putStrLn "16" bob <## "alice (Alice): contact is connected" where withNewAlice = withNewTestChatV1 "alice" aliceProfile @@ -2885,7 +2949,7 @@ testSetChatItemTTL = bob <# "alice> 1" bob #> "@alice 2" alice <# "bob> 2" - threadDelay 1000000 + threadDelay 2000000 alice #> "@bob 3" bob <# "alice> 3" bob #> "@alice 4"