diff --git a/apps/android/app/src/main/java/chat/simplex/app/SimplexApp.kt b/apps/android/app/src/main/java/chat/simplex/app/SimplexApp.kt index aaaccbe681..213eacc8b5 100644 --- a/apps/android/app/src/main/java/chat/simplex/app/SimplexApp.kt +++ b/apps/android/app/src/main/java/chat/simplex/app/SimplexApp.kt @@ -98,12 +98,13 @@ class SimplexApp: Application(), LifecycleEventObserver { val inStream = receiver.inputStream val inStreamReader = InputStreamReader(inStream) val input = BufferedReader(inStreamReader) - + Log.d(TAG, "starting receiver loop") while (true) { val line = input.readLine() ?: break Log.w("$TAG (stdout/stderr)", line) logbuffer.add(line) } + Log.w(TAG, "exited receiver loop") } } diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 2fdd7e1fd5..9377a133bc 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -54,7 +54,7 @@ import Simplex.Chat.Options import Simplex.Chat.Protocol import Simplex.Chat.Store import Simplex.Chat.Types -import Simplex.Chat.Util (safeDecodeUtf8, uncurry3) +import Simplex.Chat.Util (lastMaybe, safeDecodeUtf8, uncurry3) import Simplex.Messaging.Agent as Agent import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), defaultAgentConfig) import Simplex.Messaging.Agent.Protocol @@ -440,16 +440,27 @@ processChatCommand = \case withStore' $ \db -> deletePendingContactConnection db userId chatId pure $ CRContactConnectionDeleted conn CTGroup -> do - g@(Group gInfo@GroupInfo {membership} members) <- withStore $ \db -> getGroup db user chatId + liftIO $ putStrLn "APIDeleteChat CTGroup" + Group gInfo@GroupInfo {membership} members <- withStore $ \db -> getGroup db user chatId + liftIO $ putStrLn "APIDeleteChat CTGroup: getGroup" let canDelete = memberRole (membership :: GroupMember) == GROwner || not (memberCurrent membership) unless canDelete $ throwChatError CEGroupUserRole + liftIO $ putStrLn "APIDeleteChat CTGroup: canDelete" + void $ clearGroupContent user gInfo + liftIO $ putStrLn "APIDeleteChat CTGroup: clearGroupContent" withChatLock . procCmd $ do when (memberActive membership) . void $ sendGroupMessage gInfo members XGrpDel + liftIO $ putStrLn "APIDeleteChat CTGroup: sendGroupMessage" mapM_ deleteMemberConnection members + liftIO $ putStrLn "APIDeleteChat CTGroup: deleteMemberConnection" -- two functions below are called in separate transactions to prevent crashes on android -- (possibly, race condition on integrity check?) - withStore' $ \db -> deleteGroupConnectionsAndFiles db userId g - withStore' $ \db -> deleteGroup db user g + withStore' $ \db -> deleteGroupConnectionsAndFiles db user gInfo members + liftIO $ putStrLn "APIDeleteChat CTGroup: deleteGroupConnectionsAndFiles" + withStore' $ \db -> deleteGroupItemsAndMembers db user gInfo + liftIO $ putStrLn "APIDeleteChat CTGroup: deleteGroupItemsAndMembers" + withStore' $ \db -> deleteGroup db user gInfo + liftIO $ putStrLn "APIDeleteChat CTGroup: deleteGroup" pure $ CRGroupDeletedUser gInfo CTContactRequest -> pure $ chatCmdError "not supported" APIClearChat (ChatRef cType chatId) -> withUser $ \user@User {userId} -> case cType of @@ -470,19 +481,12 @@ processChatCommand = \case pure $ CRChatCleared (AChatInfo SCTDirect (DirectChat ct')) CTGroup -> do gInfo <- withStore $ \db -> getGroupInfo db user chatId - ciIdsAndFileInfo <- withStore' $ \db -> getGroupChatItemIdsAndFileInfo db user chatId - forM_ ciIdsAndFileInfo $ \(itemId, _, itemDeleted, fileInfo_) -> - unless itemDeleted $ do - forM_ fileInfo_ $ \fileInfo -> do - cancelFile user fileInfo - withFilesFolder $ \filesFolder -> deleteFile filesFolder fileInfo - void $ withStore $ \db -> deleteGroupChatItemInternal db user gInfo itemId - gInfo' <- case ciIdsAndFileInfo of - [] -> pure gInfo - _ -> do - let (_, lastItemTs, _, _) = last ciIdsAndFileInfo + lastItemTs_ <- clearGroupContent user gInfo + gInfo' <- case lastItemTs_ of + Just lastItemTs -> do withStore' $ \db -> updateGroupTs db user gInfo lastItemTs pure (gInfo :: GroupInfo) {updatedAt = lastItemTs} + _ -> pure gInfo pure $ CRChatCleared (AChatInfo SCTGroup (GroupChat gInfo')) CTContactConnection -> pure $ chatCmdError "not supported" CTContactRequest -> pure $ chatCmdError "not supported" @@ -958,6 +962,16 @@ processChatCommand = \case SMDRcv -> do ft@RcvFileTransfer {cancelled} <- withStore (\db -> getRcvFileTransfer db user fileId) unless cancelled $ cancelRcvFileTransfer user ft + clearGroupContent :: User -> GroupInfo -> m (Maybe UTCTime) + clearGroupContent user gInfo@GroupInfo {groupId} = do + ciIdsAndFileInfo <- withStore' $ \db -> getGroupChatItemIdsAndFileInfo db user groupId + forM_ ciIdsAndFileInfo $ \(itemId, _, itemDeleted, fileInfo_) -> + unless itemDeleted $ do + forM_ fileInfo_ $ \fileInfo -> do + cancelFile user fileInfo + withFilesFolder $ \filesFolder -> deleteFile filesFolder fileInfo + void $ withStore $ \db -> deleteGroupChatItemInternal db user gInfo itemId + pure $ (\(_, lastItemTs, _, _) -> lastItemTs) <$> lastMaybe ciIdsAndFileInfo withCurrentCall :: ContactId -> (UserId -> Contact -> Call -> m (Maybe Call)) -> m ChatResponse withCurrentCall ctId action = withUser $ \user@User {userId} -> do ct <- withStore $ \db -> getContact db userId ctId diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 9e126fecf8..7610d1dd8c 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -71,6 +71,7 @@ module Simplex.Chat.Store getGroupMember, getGroupMembers, deleteGroupConnectionsAndFiles, + deleteGroupItemsAndMembers, deleteGroup, getUserGroups, getUserGroupDetails, @@ -1341,27 +1342,31 @@ getGroup db user groupId = do members <- liftIO $ getGroupMembers db user gInfo pure $ Group gInfo members -deleteGroupConnectionsAndFiles :: DB.Connection -> UserId -> Group -> IO () -deleteGroupConnectionsAndFiles db userId (Group GroupInfo {groupId} members) = do - print "deleteGroupConnectionsAndFiles" +deleteGroupConnectionsAndFiles :: DB.Connection -> User -> GroupInfo -> [GroupMember] -> IO () +deleteGroupConnectionsAndFiles db User {userId} GroupInfo {groupId} members = do + putStrLn "deleteGroupConnectionsAndFiles" forM_ members $ \m -> DB.execute db "DELETE FROM connections WHERE user_id = ? AND group_member_id = ?" (userId, groupMemberId' m) - print "deleteGroupConnectionsAndFiles: connections" + putStrLn "deleteGroupConnectionsAndFiles: connections" DB.execute db "DELETE FROM files WHERE user_id = ? AND group_id = ?" (userId, groupId) - print "deleteGroupConnectionsAndFiles: files" + putStrLn "deleteGroupConnectionsAndFiles: files" -deleteGroup :: DB.Connection -> User -> Group -> IO () -deleteGroup db User {userId} (Group GroupInfo {groupId, localDisplayName} _) = do - print "deleteGroup" +deleteGroupItemsAndMembers :: DB.Connection -> User -> GroupInfo -> IO () +deleteGroupItemsAndMembers db User {userId} GroupInfo {groupId} = do + putStrLn "deleteGroupItemsAndMembers" DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND group_id = ?" (userId, groupId) - print "deleteGroup: chat_items" + putStrLn "deleteGroupItemsAndMembers: chat_items" DB.execute db "DELETE FROM group_members WHERE user_id = ? AND group_id = ?" (userId, groupId) - print "deleteGroup: group_members" + putStrLn "deleteGroupItemsAndMembers: group_members" + +deleteGroup :: DB.Connection -> User -> GroupInfo -> IO () +deleteGroup db User {userId} GroupInfo {groupId, localDisplayName} = do + putStrLn "deleteGroup" deleteGroupProfile_ db userId groupId - print "deleteGroup: deleteGroupProfile_" + putStrLn "deleteGroup: deleteGroupProfile_" DB.execute db "DELETE FROM groups WHERE user_id = ? AND group_id = ?" (userId, groupId) - print "deleteGroup: groups" + putStrLn "deleteGroup: groups" DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName) - print "deleteGroup: display_names" + putStrLn "deleteGroup: display_names" deleteGroupProfile_ :: DB.Connection -> UserId -> GroupId -> IO () deleteGroupProfile_ db userId groupId = diff --git a/src/Simplex/Chat/Util.hs b/src/Simplex/Chat/Util.hs index 835dedce55..b6c97fed8a 100644 --- a/src/Simplex/Chat/Util.hs +++ b/src/Simplex/Chat/Util.hs @@ -11,3 +11,7 @@ safeDecodeUtf8 = decodeUtf8With onError uncurry3 :: (a -> b -> c -> d) -> ((a, b, c) -> d) uncurry3 f ~(a, b, c) = f a b c + +lastMaybe :: [a] -> Maybe a +lastMaybe [] = Nothing +lastMaybe xs = Just $ last xs diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index e79bdefc0b..bf04d74909 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -1157,7 +1157,7 @@ testGroupAsync = withTmpFiles $ do dan <## "#team: you joined the group" ] threadDelay 1000000 - threadDelay 500000 + threadDelay 1000000 print (4 :: Integer) withTestChat "alice" $ \alice -> do withTestChat "cath" $ \cath -> do @@ -1179,7 +1179,7 @@ testGroupAsync = withTmpFiles $ do dan <## "#team: member alice (Alice) is connected" dan <## "#team: member cath (Catherine) is connected" ] - threadDelay 500000 + threadDelay 1000000 print (5 :: Integer) withTestChat "alice" $ \alice -> do withTestChat "bob" $ \bob -> do