core: clear group content on deletion, break transaction to prevent error on Android, more logs (#892)

* core: log group deletion

* clear group content, break transaction, add logs

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")
         }
       }
 

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

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 =

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

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