diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 1df50de1a6..4511131dbf 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -222,6 +222,7 @@ library Simplex.Chat.Store.SQLite.Migrations.M20250115_chat_ttl Simplex.Chat.Store.SQLite.Migrations.M20250122_chat_items_include_in_history Simplex.Chat.Store.SQLite.Migrations.M20250126_mentions + Simplex.Chat.Store.SQLite.Migrations.M20250129_delete_unused_contacts other-modules: Paths_simplex_chat hs-source-dirs: diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 68c1bd2e92..a7a73eea0a 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -765,7 +765,6 @@ data ChatResponse | CRGroupLinkCreated {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact, memberRole :: GroupMemberRole} | CRGroupLink {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact, memberRole :: GroupMemberRole} | CRGroupLinkDeleted {user :: User, groupInfo :: GroupInfo} - | CRAcceptingGroupJoinRequest {user :: User, groupInfo :: GroupInfo, contact :: Contact} | CRAcceptingGroupJoinRequestMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember} | CRNoMemberContactCreating {user :: User, groupInfo :: GroupInfo, member :: GroupMember} -- only used in CLI | CRNewMemberContact {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index ea947180ff..4accff2471 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -1095,26 +1095,7 @@ processChatCommand' vr = \case withStore' $ \db -> deleteGroupConnectionsAndFiles db user gInfo members withStore' $ \db -> deleteGroupItemsAndMembers db user gInfo members withStore' $ \db -> deleteGroup db user gInfo - let contactIds = mapMaybe memberContactId members - (errs1, (errs2, connIds)) <- lift $ second unzip . partitionEithers <$> withStoreBatch (\db -> map (deleteUnusedContact db) contactIds) - let errs = errs1 <> mapMaybe (fmap ChatErrorStore) errs2 - unless (null errs) $ toView $ CRChatErrors (Just user) errs - deleteAgentConnectionsAsync user $ concat connIds pure $ CRGroupDeletedUser user gInfo - where - deleteUnusedContact :: DB.Connection -> ContactId -> IO (Either ChatError (Maybe StoreError, [ConnId])) - deleteUnusedContact db contactId = runExceptT . withExceptT ChatErrorStore $ do - ct <- getContact db vr user contactId - ifM - ((directOrUsed ct ||) . isJust <$> liftIO (checkContactHasGroups db user ct)) - (pure (Nothing, [])) - (getConnections ct) - where - getConnections :: Contact -> ExceptT StoreError IO (Maybe StoreError, [ConnId]) - getConnections ct = do - conns <- liftIO $ getContactConnections db vr userId ct - e_ <- (setContactDeleted db user ct $> Nothing) `catchStoreError` (pure . Just) - pure (e_, map aConnId conns) CTLocal -> pure $ chatCmdError (Just user) "not supported" CTContactRequest -> pure $ chatCmdError (Just user) "not supported" APIClearChat (ChatRef cType chatId) -> withUser $ \user@User {userId} -> case cType of @@ -2986,10 +2967,9 @@ processChatCommand' vr = \case sendContactContentMessages :: User -> ContactId -> Bool -> Maybe Int -> NonEmpty ComposedMessageReq -> CM ChatResponse sendContactContentMessages user contactId live itemTTL cmrs = do assertMultiSendable live cmrs - ct@Contact {contactUsed} <- withFastStore $ \db -> getContact db vr user contactId + ct <- withFastStore $ \db -> getContact db vr user contactId assertDirectAllowed user MDSnd ct XMsgNew_ assertVoiceAllowed ct - unless contactUsed $ withFastStore' $ \db -> updateContactUsed db user ct processComposedMessages ct where assertVoiceAllowed :: Contact -> CM () diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index e61a7795e4..8cdad6cd60 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -797,15 +797,15 @@ acceptContactRequest user@User {userId} UserContactRequest {agentInvitationId = dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend (ct,conn,) <$> withAgent (\a -> acceptContact a (aConnId conn) True invId dm pqSup' subMode) -acceptContactRequestAsync :: User -> UserContactRequest -> Maybe IncognitoProfile -> Bool -> PQSupport -> CM Contact -acceptContactRequestAsync user cReq@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile contactUsed pqSup = do +acceptContactRequestAsync :: User -> UserContactRequest -> Maybe IncognitoProfile -> PQSupport -> CM Contact +acceptContactRequestAsync user cReq@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = p, userContactLinkId, xContactId} incognitoProfile pqSup = do subMode <- chatReadVar subscriptionMode let profileToSend = profileToSendOnAccept user incognitoProfile False vr <- chatVersionRange let chatV = vr `peerConnChatVersion` cReqChatVRange (cmdId, acId) <- agentAcceptContactAsync user True invId (XInfo profileToSend) subMode pqSup chatV withStore' $ \db -> do - (ct, Connection {connId}) <- createAcceptedContact db user acId chatV cReqChatVRange cName profileId p userContactLinkId xContactId incognitoProfile subMode pqSup contactUsed + (ct, Connection {connId}) <- createAcceptedContact db user acId chatV cReqChatVRange cName profileId p userContactLinkId xContactId incognitoProfile subMode pqSup True deleteContactRequestRec db user cReq setCommandConnId db user cmdId connId pure ct diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 2682d550b7..cb9cb1ed11 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -584,7 +584,6 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = lift $ setContactNetworkStatus ct' NSConnected toView $ CRContactConnected user ct' (fmap fromLocalProfile incognitoProfile) when (directOrUsed ct') $ do - unless (contactUsed ct') $ withFastStore' $ \db -> updateContactUsed db user ct' createInternalChatItem user (CDDirectRcv ct') (CIRcvDirectE2EEInfo $ E2EInfo pqEnc) Nothing createFeatureEnabledItems ct' when (contactConnInitiated conn') $ do @@ -697,7 +696,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- [async agent commands] XGrpMemIntro continuation on receiving INV CFCreateConnGrpMemInv | maxVersion (peerChatVRange conn) >= groupDirectInvVersion -> sendWithoutDirectCReq - | otherwise -> sendWithDirectCReq + | otherwise -> messageError "processGroupMessage INV: member chat version range incompatible" where sendWithoutDirectCReq = do let GroupMember {groupMemberId, memberId} = m @@ -705,13 +704,6 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = liftIO $ setConnConnReqInv db user connId cReq getHostConnId db user groupId sendXGrpMemInv hostConnId Nothing XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} - sendWithDirectCReq = do - let GroupMember {groupMemberId, memberId} = m - contData <- withStore' $ \db -> do - setConnConnReqInv db user connId cReq - getXGrpMemIntroContGroup db user m - forM_ contData $ \(hostConnId, directConnReq) -> - sendXGrpMemInv hostConnId (Just directConnReq) XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq} -- [async agent commands] group link auto-accept continuation on receiving INV CFCreateConnGrpInv -> do ct <- withStore $ \db -> getContactViaMember db vr user m @@ -1310,9 +1302,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case autoAccept of Just AutoAccept {acceptIncognito, businessAddress} | businessAddress -> - if v < groupFastLinkJoinVersion || (isSimplexTeam && v < businessChatsVersion) + if isSimplexTeam && v < businessChatsVersion then do - ct <- acceptContactRequestAsync user cReq Nothing True reqPQSup + ct <- acceptContactRequestAsync user cReq Nothing reqPQSup toView $ CRAcceptingContactRequest user ct else do gInfo <- acceptBusinessJoinRequestAsync user cReq @@ -1321,7 +1313,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Nothing -> do -- [incognito] generate profile to send, create connection with incognito profile incognitoProfile <- if acceptIncognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing - ct <- acceptContactRequestAsync user cReq incognitoProfile True reqPQSup + ct <- acceptContactRequestAsync user cReq incognitoProfile reqPQSup toView $ CRAcceptingContactRequest user ct Just groupId -> do gInfo <- withStore $ \db -> getGroupInfo db vr user groupId @@ -1331,10 +1323,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = mem <- acceptGroupJoinRequestAsync user gInfo cReq gLinkMemRole profileMode createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing toView $ CRAcceptingGroupJoinRequestMember user gInfo mem - else do - -- TODO v5.7 remove old API (or v6.0?) - ct <- acceptContactRequestAsync user cReq profileMode False PQSupportOff - toView $ CRAcceptingGroupJoinRequest user gInfo ct + else messageError "processUserContactRequest: chat version range incompatible for accepting group join request" _ -> toView $ CRReceivedContactRequest user cReq memberCanSend :: GroupMember -> CM () -> CM () @@ -1540,8 +1529,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = messageError = toView . CRMessageError user "error" newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> CM () - newContentMessage ct@Contact {contactUsed} mc msg@RcvMessage {sharedMsgId_} msgMeta = do - unless contactUsed $ withStore' $ \db -> updateContactUsed db user ct + newContentMessage ct mc msg@RcvMessage {sharedMsgId_} msgMeta = do let ExtMsgContent content _ fInv_ _ _ = mcExtMsgContent mc -- Uncomment to test stuck delivery on errors - see test testDirectMessageDelete -- case content of @@ -1747,7 +1735,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = ExtMsgContent content mentions fInv_ itemTTL live_ = mcExtMsgContent mc ts@(_, ft_) = msgContentTexts content createBlockedByAdmin - | groupFeatureAllowed SGFFullDelete gInfo = do -- ignores member role when blocked by admin + | groupFeatureAllowed SGFFullDelete gInfo = do + -- ignores member role when blocked by admin ci <- saveRcvChatItem' user (CDGroupRcv gInfo m) msg sharedMsgId_ brokerTs (ciContentNoParse CIRcvBlocked) Nothing timed' False M.empty ci' <- withStore' $ \db -> updateGroupCIBlockedByAdmin db user gInfo ci brokerTs groupMsgToView gInfo ci' @@ -2466,8 +2455,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = conn' <- updatePeerChatVRange activeConn chatVRange case chatMsgEvent of XInfo p -> do - let contactUsed = connDirect activeConn - ct <- withStore $ \db -> createDirectContact db user conn' p contactUsed + ct <- withStore $ \db -> createDirectContact db user conn' p toView $ CRContactConnecting user ct pure (conn', False) XGrpLinkInv glInv -> do @@ -2505,17 +2493,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Right _ -> messageError "x.grp.mem.intro ignored: member already exists" Left _ -> do when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole c) - subMode <- chatReadVar subscriptionMode - -- [async agent commands] commands should be asynchronous, continuation is to send XGrpMemInv - have to remember one has completed and process on second - groupConnIds <- createConn subMode - directConnIds <- case memChatVRange of - Nothing -> Just <$> createConn subMode + case memChatVRange of + Nothing -> messageError "x.grp.mem.intro: member chat version range incompatible" Just (ChatVersionRange mcvr) - | maxVersion mcvr >= groupDirectInvVersion -> pure Nothing - | otherwise -> Just <$> createConn subMode - let customUserProfileId = localProfileId <$> incognitoMembershipProfile gInfo - chatV = maybe (minVersion vr) (\peerVR -> vr `peerConnChatVersion` fromChatVRange peerVR) memChatVRange - void $ withStore $ \db -> createIntroReMember db user gInfo m chatV memInfo memRestrictions groupConnIds directConnIds customUserProfileId subMode + | maxVersion mcvr >= groupDirectInvVersion -> do + subMode <- chatReadVar subscriptionMode + -- [async agent commands] commands should be asynchronous, continuation is to send XGrpMemInv - have to remember one has completed and process on second + groupConnIds <- createConn subMode + let chatV = maybe (minVersion vr) (\peerVR -> vr `peerConnChatVersion` fromChatVRange peerVR) memChatVRange + void $ withStore $ \db -> createIntroReMember db user gInfo m chatV memInfo memRestrictions groupConnIds subMode + | otherwise -> messageError "x.grp.mem.intro: member chat version range incompatible" _ -> messageError "x.grp.mem.intro can be only sent by host member" where createConn subMode = createAgentConnectionAsync user CFCreateConnGrpMemInv (chatHasNtfs chatSettings) SCMInvitation subMode diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 44ee662c75..98d7374769 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -46,7 +46,6 @@ module Simplex.Chat.Store.Direct updateContactConnectionAlias, updatePCCIncognito, deletePCCIncognitoProfile, - updateContactUsed, updateContactUnreadChat, setUserChatsRead, updateContactStatus, @@ -240,10 +239,10 @@ createIncognitoProfile db User {userId} p = do createdAt <- getCurrentTime createIncognitoProfile_ db userId createdAt p -createDirectContact :: DB.Connection -> User -> Connection -> Profile -> Bool -> ExceptT StoreError IO Contact -createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p@Profile {preferences} contactUsed = do +createDirectContact :: DB.Connection -> User -> Connection -> Profile -> ExceptT StoreError IO Contact +createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p@Profile {preferences} = do currentTs <- liftIO getCurrentTime - (localDisplayName, contactId, profileId) <- createContact_ db userId p localAlias Nothing currentTs contactUsed + (localDisplayName, contactId, profileId) <- createContact_ db userId p localAlias Nothing currentTs liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, connId) let profile = toLocalProfile profileId p localAlias userPreferences = emptyChatPrefs @@ -255,7 +254,7 @@ createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p profile, activeConn = Just conn, viaGroup = Nothing, - contactUsed, + contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, @@ -471,11 +470,6 @@ deletePCCIncognitoProfile db User {userId} profileId = |] (userId, profileId) -updateContactUsed :: DB.Connection -> User -> Contact -> IO () -updateContactUsed db User {userId} Contact {contactId} = do - updatedAt <- getCurrentTime - DB.execute db "UPDATE contacts SET contact_used = 1, updated_at = ? WHERE user_id = ? AND contact_id = ?" (updatedAt, userId, contactId) - updateContactUnreadChat :: DB.Connection -> User -> Contact -> Bool -> IO () updateContactUnreadChat db User {userId} Contact {contactId} unreadChat = do updatedAt <- getCurrentTime diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 1b73a5b761..b97c28a510 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -110,7 +110,6 @@ module Simplex.Chat.Store.Groups updateGroupMemberSettings, updateGroupMemberBlocked, getXGrpMemIntroContDirect, - getXGrpMemIntroContGroup, getHostConnId, createMemberContact, getMemberContact, @@ -1397,33 +1396,23 @@ getForwardInvitedMembers db vr user forwardMember highlyAvailable = do WHERE re_group_member_id = ? AND intro_status NOT IN (?,?,?) |] -createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> VersionChat -> MemberInfo -> Maybe MemberRestrictions -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> ExceptT StoreError IO GroupMember +createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> VersionChat -> MemberInfo -> Maybe MemberRestrictions -> (CommandId, ConnId) -> SubscriptionMode -> ExceptT StoreError IO GroupMember createIntroReMember db user@User {userId} - gInfo@GroupInfo {groupId} + gInfo _host@GroupMember {memberContactId, activeConn} chatV memInfo@(MemberInfo _ _ memChatVRange memberProfile) memRestrictions_ (groupCmdId, groupAgentConnId) - directConnIds - customUserProfileId subMode = do let mcvr = maybe chatInitialVRange fromChatVRange memChatVRange cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn memRestriction = restriction <$> memRestrictions_ currentTs <- liftIO getCurrentTime - newMember <- case directConnIds of - Just (directCmdId, directAgentConnId) -> do - Connection {connId = directConnId} <- liftIO $ createConnection_ db userId ConnContact Nothing directAgentConnId ConnNew chatV mcvr memberContactId Nothing customUserProfileId cLevel currentTs subMode PQSupportOff - liftIO $ setCommandConnId db user directCmdId directConnId - (localDisplayName, contactId, memProfileId) <- createContact_ db userId memberProfile "" (Just groupId) currentTs False - liftIO $ DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id = ?" (contactId, currentTs, directConnId) - pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Just contactId, memProfileId} - Nothing -> do - (localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs - pure $ NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId} + (localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs + let newMember = NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId} liftIO $ do member <- createNewMember_ db user gInfo newMember currentTs conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId chatV mcvr memberContactId cLevel currentTs subMode @@ -1850,12 +1839,6 @@ mergeContactRecords db vr user@User {userId} to@Contact {localDisplayName = keep assertNotUser db user fromCt liftIO $ do currentTs <- getCurrentTime - -- next query fixes incorrect unused contacts deletion - when (contactDirect toCt && not (contactUsed toCt)) $ - DB.execute - db - "UPDATE contacts SET contact_used = 1, updated_at = ? WHERE user_id = ? AND contact_id = ?" - (currentTs, userId, toContactId) DB.execute db "UPDATE connections SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ?" @@ -2061,36 +2044,6 @@ getXGrpMemIntroContDirect db User {userId} Contact {contactId} = do Just groupConnReq -> Just (hostConnId, XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq}) _ -> Nothing -getXGrpMemIntroContGroup :: DB.Connection -> User -> GroupMember -> IO (Maybe (Int64, ConnReqInvitation)) -getXGrpMemIntroContGroup db User {userId} GroupMember {groupMemberId} = do - fmap join . maybeFirstRow toCont $ - DB.query - db - [sql| - SELECT ch.connection_id, c.conn_req_inv - FROM group_members m - JOIN contacts ct ON ct.contact_id = m.contact_id - LEFT JOIN connections c ON c.connection_id = ( - SELECT MAX(cc.connection_id) - FROM connections cc - WHERE cc.contact_id = ct.contact_id - ) - JOIN groups g ON g.group_id = m.group_id AND g.group_id = ct.via_group - JOIN group_members mh ON mh.group_id = g.group_id - LEFT JOIN connections ch ON ch.connection_id = ( - SELECT max(cc.connection_id) - FROM connections cc - where cc.user_id = ? AND cc.group_member_id = mh.group_member_id - ) - WHERE m.user_id = ? AND m.group_member_id = ? AND mh.member_category = ? AND ct.deleted = 0 - |] - (userId, userId, groupMemberId, GCHostMember) - where - toCont :: (Int64, Maybe ConnReqInvitation) -> Maybe (Int64, ConnReqInvitation) - toCont (hostConnId, connReq_) = case connReq_ of - Just connReq -> Just (hostConnId, connReq) - _ -> Nothing - getHostConnId :: DB.Connection -> User -> GroupId -> ExceptT StoreError IO GroupMemberId getHostConnId db user@User {userId} groupId = do hostMemberId <- getHostMemberId_ db user groupId diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index b9a227b85c..f8acae4a91 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -2562,8 +2562,7 @@ getGroupChatItemIdByText db User {userId, localDisplayName = userName} groupId c SELECT i.chat_item_id FROM chat_items i JOIN group_members m ON m.group_member_id = i.group_member_id - JOIN contacts c ON c.contact_id = m.contact_id - WHERE i.user_id = ? AND i.group_id = ? AND c.local_display_name = ? AND i.item_text like ? + WHERE i.user_id = ? AND i.group_id = ? AND m.local_display_name = ? AND i.item_text like ? ORDER BY i.chat_item_id DESC LIMIT 1 |] diff --git a/src/Simplex/Chat/Store/SQLite/Migrations.hs b/src/Simplex/Chat/Store/SQLite/Migrations.hs index 29dab148dc..00d90ebf82 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations.hs @@ -126,6 +126,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20250105_indexes import Simplex.Chat.Store.SQLite.Migrations.M20250115_chat_ttl import Simplex.Chat.Store.SQLite.Migrations.M20250122_chat_items_include_in_history import Simplex.Chat.Store.SQLite.Migrations.M20250126_mentions +import Simplex.Chat.Store.SQLite.Migrations.M20250129_delete_unused_contacts import Simplex.Messaging.Agent.Store.Shared (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -251,7 +252,8 @@ schemaMigrations = ("20250105_indexes", m20250105_indexes, Just down_m20250105_indexes), ("20250115_chat_ttl", m20250115_chat_ttl, Just down_m20250115_chat_ttl), ("20250122_chat_items_include_in_history", m20250122_chat_items_include_in_history, Just down_m20250122_chat_items_include_in_history), - ("20250126_mentions", m20250126_mentions, Just down_m20250126_mentions) + ("20250126_mentions", m20250126_mentions, Just down_m20250126_mentions), + ("20250129_delete_unused_contacts", m20250129_delete_unused_contacts, Just down_m20250129_delete_unused_contacts) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20250129_delete_unused_contacts.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20250129_delete_unused_contacts.hs new file mode 100644 index 0000000000..4ce7a0a793 --- /dev/null +++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20250129_delete_unused_contacts.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Store.SQLite.Migrations.M20250129_delete_unused_contacts where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20250129_delete_unused_contacts :: Query +m20250129_delete_unused_contacts = + [sql| +CREATE TEMPORARY TABLE temp_delete_contacts ( + contact_id INTEGER PRIMARY KEY, + contact_profile_id INTEGER NOT NULL, + local_display_name TEXT NOT NULL +); + +INSERT INTO temp_delete_contacts(contact_id, contact_profile_id, local_display_name) +SELECT contact_id, contact_profile_id, local_display_name +FROM contacts +WHERE contact_used = 0 AND is_user = 0 + AND contact_id NOT IN (SELECT contact_id FROM users) + AND contact_id NOT IN (SELECT contact_id FROM contact_requests); + +CREATE TEMPORARY TABLE temp_delete_profiles (contact_profile_id INTEGER PRIMARY KEY); + +INSERT OR IGNORE INTO temp_delete_profiles(contact_profile_id) +SELECT custom_user_profile_id FROM connections +WHERE contact_id IN (SELECT contact_id FROM temp_delete_contacts) + AND custom_user_profile_id IS NOT NULL; + +UPDATE group_members SET contact_id = NULL +WHERE contact_id IN (SELECT contact_id FROM temp_delete_contacts); + +DELETE FROM connections +WHERE contact_id IN (SELECT contact_id FROM temp_delete_contacts); + +DELETE FROM contacts +WHERE contact_id IN (SELECT contact_id FROM temp_delete_contacts); + +DELETE FROM contact_profiles +WHERE + (contact_profile_id IN (SELECT contact_profile_id FROM temp_delete_profiles) + OR contact_profile_id IN (SELECT contact_profile_id FROM temp_delete_contacts)) + AND contact_profile_id NOT IN (SELECT contact_profile_id FROM group_members) + AND contact_profile_id NOT IN (SELECT member_profile_id FROM group_members) + AND contact_profile_id NOT IN (SELECT contact_profile_id FROM contact_requests) + AND contact_profile_id NOT IN (SELECT custom_user_profile_id FROM connections); + +DELETE FROM display_names +WHERE local_display_name IN (SELECT local_display_name FROM temp_delete_contacts) + AND local_display_name NOT IN (SELECT local_display_name FROM group_members) + AND local_display_name NOT IN (SELECT local_display_name FROM users) + AND local_display_name NOT IN (SELECT local_display_name FROM groups) + AND local_display_name NOT IN (SELECT local_display_name FROM user_contact_links) + AND local_display_name NOT IN (SELECT local_display_name FROM contact_requests); + +DROP TABLE temp_delete_contacts; +DROP TABLE temp_delete_profiles; +|] + +down_m20250129_delete_unused_contacts :: Query +down_m20250129_delete_unused_contacts = + [sql| +|] diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt index acec82aaf4..411878f34c 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt @@ -646,30 +646,6 @@ Query: Plan: -Query: - INSERT INTO contacts (contact_profile_id, via_group, local_display_name, user_id, created_at, updated_at, chat_ts) - SELECT contact_profile_id, group_id, ?, ?, ?, ?, ? - FROM group_members - WHERE group_member_id = ? - -Plan: -SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) -SEARCH chat_tags_chats USING COVERING INDEX idx_chat_tags_chats_chat_tag_id_contact_id (contact_id=?) -SEARCH received_probes USING COVERING INDEX idx_received_probes_contact_id (contact_id=?) -SEARCH sent_probe_hashes USING COVERING INDEX idx_sent_probe_hashes_contact_id (contact_id=?) -SEARCH sent_probes USING COVERING INDEX idx_sent_probes_contact_id (contact_id=?) -SEARCH chat_item_reactions USING COVERING INDEX idx_chat_item_reactions_contact_id (contact_id=?) -SEARCH calls USING COVERING INDEX idx_calls_contact_id (contact_id=?) -SEARCH chat_items USING COVERING INDEX idx_chat_items_fwd_from_contact_id (fwd_from_contact_id=?) -SEARCH chat_items USING COVERING INDEX idx_chat_items_contact_id (contact_id=?) -SEARCH contact_requests USING COVERING INDEX idx_contact_requests_contact_id (contact_id=?) -SEARCH connections USING COVERING INDEX idx_connections_contact_id (contact_id=?) -SEARCH connections USING COVERING INDEX idx_connections_via_contact (via_contact=?) -SEARCH files USING COVERING INDEX idx_files_contact_id (contact_id=?) -SEARCH group_members USING COVERING INDEX idx_group_members_contact_id (contact_id=?) -SEARCH group_members USING COVERING INDEX idx_group_members_invited_by (invited_by=?) -SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?) - Query: INSERT INTO group_members ( group_id, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id, @@ -1145,15 +1121,13 @@ Query: SELECT i.chat_item_id FROM chat_items i JOIN group_members m ON m.group_member_id = i.group_member_id - JOIN contacts c ON c.contact_id = m.contact_id - WHERE i.user_id = ? AND i.group_id = ? AND c.local_display_name = ? AND i.item_text like ? + WHERE i.user_id = ? AND i.group_id = ? AND m.local_display_name = ? AND i.item_text like ? ORDER BY i.chat_item_id DESC LIMIT 1 Plan: SEARCH i USING INDEX idx_chat_items_groups_user_mention (user_id=? AND group_id=?) SEARCH m USING INTEGER PRIMARY KEY (rowid=?) -SEARCH c USING INTEGER PRIMARY KEY (rowid=?) USE TEMP B-TREE FOR ORDER BY Query: @@ -1227,14 +1201,6 @@ Query: Plan: SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?) -Query: - UPDATE group_members - SET contact_id = ?, updated_at = ? - WHERE group_member_id = ? - -Plan: -SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) - Query: UPDATE group_members SET contact_id = ?, updated_at = ? @@ -2787,66 +2753,6 @@ Plan: SEARCH c USING INDEX idx_connections_updated_at (user_id=?) SEARCH uc USING INTEGER PRIMARY KEY (rowid=?) -Query: - SELECT ch.connection_id, c.conn_req_inv - FROM group_members m - JOIN contacts ct ON ct.contact_id = m.contact_id - LEFT JOIN connections c ON c.connection_id = ( - SELECT MAX(cc.connection_id) - FROM connections cc - WHERE cc.contact_id = ct.contact_id - ) - JOIN groups g ON g.group_id = m.group_id AND g.group_id = ct.via_group - JOIN group_members mh ON mh.group_id = g.group_id - LEFT JOIN connections ch ON ch.connection_id = ( - SELECT max(cc.connection_id) - FROM connections cc - where cc.user_id = ? AND cc.group_member_id = mh.group_member_id - ) - WHERE m.user_id = ? AND m.group_member_id = ? AND mh.member_category = ? AND ct.deleted = 0 - -Plan: -SEARCH m USING INTEGER PRIMARY KEY (rowid=?) -SEARCH ct USING INTEGER PRIMARY KEY (rowid=?) -SEARCH c USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN -CORRELATED SCALAR SUBQUERY 1 -SEARCH cc USING COVERING INDEX idx_connections_contact_id (contact_id=?) -SEARCH g USING INTEGER PRIMARY KEY (rowid=?) -SEARCH mh USING INDEX sqlite_autoindex_group_members_1 (group_id=?) -SEARCH ch USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN -CORRELATED SCALAR SUBQUERY 2 -SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group_member_id=?) - -Query: - SELECT ch.connection_id, g.group_id, m.group_member_id, m.member_id, c.conn_req_inv - FROM contacts ct - JOIN group_members m ON m.contact_id = ct.contact_id - LEFT JOIN connections c ON c.connection_id = ( - SELECT MAX(cc.connection_id) - FROM connections cc - WHERE cc.group_member_id = m.group_member_id - ) - JOIN groups g ON g.group_id = m.group_id AND g.group_id = ct.via_group - JOIN group_members mh ON mh.group_id = g.group_id - LEFT JOIN connections ch ON ch.connection_id = ( - SELECT max(cc.connection_id) - FROM connections cc - where cc.user_id = ? AND cc.group_member_id = mh.group_member_id - ) - WHERE ct.user_id = ? AND ct.contact_id = ? AND ct.deleted = 0 AND mh.member_category = ? - -Plan: -SEARCH ct USING INTEGER PRIMARY KEY (rowid=?) -SEARCH g USING INTEGER PRIMARY KEY (rowid=?) -SEARCH m USING INDEX sqlite_autoindex_group_members_1 (group_id=?) -SEARCH c USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN -CORRELATED SCALAR SUBQUERY 1 -SEARCH cc -SEARCH mh USING INDEX sqlite_autoindex_group_members_1 (group_id=?) -SEARCH ch USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN -CORRELATED SCALAR SUBQUERY 2 -SEARCH cc USING COVERING INDEX idx_connections_group_member (user_id=? AND group_member_id=?) - Query: SELECT chat_item_id FROM chat_item_messages @@ -3112,30 +3018,6 @@ Plan: SEARCH ct USING INDEX idx_contacts_chat_ts (user_id=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) -Query: - SELECT ct.contact_id - FROM contacts ct - JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id - WHERE ct.user_id = ? AND ct.contact_id != ? - AND ct.contact_status = ? AND ct.deleted = 0 AND ct.is_user = 0 - AND p.display_name = ? AND p.full_name = ? - AND p.image = ? -Plan: -SEARCH ct USING INDEX idx_contacts_chat_ts (user_id=?) -SEARCH p USING INTEGER PRIMARY KEY (rowid=?) - -Query: - SELECT ct.contact_id - FROM contacts ct - JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id - WHERE ct.user_id = ? AND ct.contact_id != ? - AND ct.contact_status = ? AND ct.deleted = 0 AND ct.is_user = 0 - AND p.display_name = ? AND p.full_name = ? - AND p.image is NULL -Plan: -SEARCH ct USING INDEX idx_contacts_chat_ts (user_id=?) -SEARCH p USING INTEGER PRIMARY KEY (rowid=?) - Query: SELECT d.file_descr_id, d.file_descr_text, d.file_descr_part_no, d.file_descr_complete FROM xftp_file_descriptions d @@ -3269,18 +3151,6 @@ Plan: SEARCH m USING INDEX idx_group_members_user_id (user_id=?) SEARCH p USING INTEGER PRIMARY KEY (rowid=?) -Query: - SELECT m.member_role, gp.preferences - FROM groups g - JOIN group_profiles gp USING (group_profile_id) - JOIN group_members m USING (group_id) - WHERE g.user_id = ? AND m.contact_id = ? - -Plan: -SEARCH m USING INDEX idx_group_members_contact_id (contact_id=?) -SEARCH g USING INTEGER PRIMARY KEY (rowid=?) -SEARCH gp USING INTEGER PRIMARY KEY (rowid=?) - Query: SELECT pgm.message_id, m.shared_msg_id, m.msg_body, m.chat_msg_event, pgm.group_member_intro_id FROM pending_group_messages pgm @@ -3482,22 +3352,6 @@ Query: Plan: SEARCH group_member_intros USING INTEGER PRIMARY KEY (rowid=?) -Query: - UPDATE group_members - SET contact_id = ?, - local_display_name = (SELECT local_display_name FROM contacts WHERE contact_id = ?), - contact_profile_id = (SELECT contact_profile_id FROM contacts WHERE contact_id = ?), - updated_at = ? - WHERE contact_id = ? - AND user_id = ? - -Plan: -SEARCH group_members USING INDEX idx_group_members_user_id (user_id=?) -SCALAR SUBQUERY 1 -SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?) -SCALAR SUBQUERY 2 -SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?) - Query: UPDATE group_members SET contact_id = ?, local_display_name = ?, contact_profile_id = ?, updated_at = ? @@ -5092,25 +4946,6 @@ Query: DELETE FROM contact_requests WHERE user_id = ? AND contact_request_id = ? Plan: SEARCH contact_requests USING INTEGER PRIMARY KEY (rowid=?) -Query: DELETE FROM contacts WHERE contact_id = ? AND user_id = ? -Plan: -SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?) -SEARCH chat_tags_chats USING COVERING INDEX idx_chat_tags_chats_chat_tag_id_contact_id (contact_id=?) -SEARCH received_probes USING COVERING INDEX idx_received_probes_contact_id (contact_id=?) -SEARCH sent_probe_hashes USING COVERING INDEX idx_sent_probe_hashes_contact_id (contact_id=?) -SEARCH sent_probes USING COVERING INDEX idx_sent_probes_contact_id (contact_id=?) -SEARCH chat_item_reactions USING COVERING INDEX idx_chat_item_reactions_contact_id (contact_id=?) -SEARCH calls USING COVERING INDEX idx_calls_contact_id (contact_id=?) -SEARCH chat_items USING COVERING INDEX idx_chat_items_fwd_from_contact_id (fwd_from_contact_id=?) -SEARCH chat_items USING COVERING INDEX idx_chat_items_contact_id (contact_id=?) -SEARCH contact_requests USING COVERING INDEX idx_contact_requests_contact_id (contact_id=?) -SEARCH connections USING COVERING INDEX idx_connections_contact_id (contact_id=?) -SEARCH connections USING COVERING INDEX idx_connections_via_contact (via_contact=?) -SEARCH files USING COVERING INDEX idx_files_contact_id (contact_id=?) -SEARCH group_members USING COVERING INDEX idx_group_members_contact_id (contact_id=?) -SEARCH group_members USING COVERING INDEX idx_group_members_invited_by (invited_by=?) -SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?) - Query: DELETE FROM contacts WHERE user_id = ? AND contact_id = ? Plan: SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?) @@ -5596,10 +5431,6 @@ Query: SELECT group_id FROM group_members WHERE group_member_id = ? Plan: SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) -Query: SELECT group_id FROM group_members WHERE user_id = ? AND contact_id = ? LIMIT 1 -Plan: -SEARCH group_members USING INDEX idx_group_members_user_id (user_id=?) - Query: SELECT group_id FROM groups WHERE inv_queue_info = ? AND user_id = ? LIMIT 1 Plan: SEARCH groups USING INDEX idx_groups_chat_ts (user_id=?) @@ -5620,10 +5451,6 @@ Query: SELECT group_id FROM user_contact_links WHERE user_id = ? AND user_contac Plan: SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?) -Query: SELECT group_link_id FROM user_contact_links WHERE user_id = ? AND group_id = ? LIMIT 1 -Plan: -SEARCH user_contact_links USING INDEX idx_user_contact_links_group_id (group_id=?) - Query: SELECT group_member_id FROM group_members WHERE user_id = ? AND contact_profile_id = ? AND group_member_id != ? LIMIT 1 Plan: SEARCH group_members USING INDEX idx_group_members_user_id (user_id=?) @@ -5684,10 +5511,6 @@ Query: SELECT xgrplinkmem_received FROM group_members WHERE group_member_id = ? Plan: SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) -Query: UPDATE chat_items SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ? -Plan: -SEARCH chat_items USING COVERING INDEX idx_chat_items_contacts_created_at (user_id=? AND contact_id=?) - Query: UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND contact_id = ? AND chat_item_id = ? Plan: SEARCH chat_items USING INTEGER PRIMARY KEY (rowid=?) @@ -5740,10 +5563,6 @@ Query: UPDATE connections SET contact_id = ?, updated_at = ? WHERE connection_id Plan: SEARCH connections USING INTEGER PRIMARY KEY (rowid=?) -Query: UPDATE connections SET contact_id = ?, updated_at = ? WHERE contact_id = ? AND user_id = ? -Plan: -SEARCH connections USING INDEX idx_connections_contact_id (contact_id=?) - Query: UPDATE connections SET quota_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ? Plan: SEARCH connections USING INTEGER PRIMARY KEY (rowid=?) @@ -5756,10 +5575,6 @@ Query: UPDATE connections SET to_subscribe = 0 WHERE to_subscribe = 1 Plan: SEARCH connections USING INDEX idx_connections_to_subscribe (to_subscribe=?) -Query: UPDATE connections SET via_contact = ?, updated_at = ? WHERE via_contact = ? AND user_id = ? -Plan: -SEARCH connections USING INDEX idx_connections_via_contact (via_contact=?) - Query: UPDATE contact_requests SET contact_id = ? WHERE user_id = ? AND local_display_name = ? Plan: SEARCH contact_requests USING INDEX sqlite_autoindex_contact_requests_1 (user_id=? AND local_display_name=?) @@ -5780,18 +5595,10 @@ Query: UPDATE contacts SET contact_grp_inv_sent = ?, updated_at = ? WHERE contac Plan: SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?) -Query: UPDATE contacts SET contact_used = 1, updated_at = ? WHERE user_id = ? AND contact_id = ? -Plan: -SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?) - Query: UPDATE contacts SET contact_used = ? WHERE user_id = ? AND contact_id = ? Plan: SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?) -Query: UPDATE contacts SET deleted = 1, updated_at = ? WHERE user_id = ? AND contact_id = ? -Plan: -SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?) - Query: UPDATE contacts SET enable_ntfs = ?, send_rcpts = ?, favorite = ? WHERE user_id = ? AND contact_id = ? Plan: SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?) @@ -5864,10 +5671,6 @@ Query: UPDATE group_members SET contact_id = NULL, updated_at = ? WHERE user_id Plan: SEARCH group_members USING INDEX idx_group_members_user_id (user_id=?) -Query: UPDATE group_members SET invited_by = ?, updated_at = ? WHERE invited_by = ? AND user_id = ? -Plan: -SEARCH group_members USING INDEX idx_group_members_invited_by (invited_by=?) - Query: UPDATE group_members SET local_display_name = ?, updated_at = ? WHERE user_id = ? AND contact_id = ? Plan: SEARCH group_members USING INDEX idx_group_members_user_id (user_id=?) @@ -5884,10 +5687,6 @@ Query: UPDATE group_members SET member_role = ? WHERE user_id = ? AND group_memb Plan: SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) -Query: UPDATE group_members SET sent_inv_queue_info = ?, updated_at = ? WHERE user_id = ? AND group_member_id = ? -Plan: -SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) - Query: UPDATE group_members SET xgrplinkmem_received = ?, updated_at = ? WHERE group_member_id = ? Plan: SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) @@ -5980,10 +5779,6 @@ Query: UPDATE usage_conditions SET notified_at = ? WHERE usage_conditions_id = ? Plan: SEARCH usage_conditions USING INTEGER PRIMARY KEY (rowid=?) -Query: UPDATE user_contact_links SET group_link_member_role = ? WHERE user_id = ? AND user_contact_link_id = ? -Plan: -SEARCH user_contact_links USING INTEGER PRIMARY KEY (rowid=?) - Query: UPDATE users SET active_user = 0 Plan: SCAN users diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 5a50ae25d3..6688f4cae6 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -381,10 +381,10 @@ setCommandConnId db User {userId} cmdId connId = do createContact :: DB.Connection -> User -> Profile -> ExceptT StoreError IO () createContact db User {userId} profile = do currentTs <- liftIO getCurrentTime - void $ createContact_ db userId profile "" Nothing currentTs True + void $ createContact_ db userId profile "" Nothing currentTs -createContact_ :: DB.Connection -> UserId -> Profile -> LocalAlias -> Maybe Int64 -> UTCTime -> Bool -> ExceptT StoreError IO (Text, ContactId, ProfileId) -createContact_ db userId Profile {displayName, fullName, image, contactLink, preferences} localAlias viaGroup currentTs contactUsed = +createContact_ :: DB.Connection -> UserId -> Profile -> LocalAlias -> Maybe Int64 -> UTCTime -> ExceptT StoreError IO (Text, ContactId, ProfileId) +createContact_ db userId Profile {displayName, fullName, image, contactLink, preferences} localAlias viaGroup currentTs = ExceptT . withLocalDisplayName db userId displayName $ \ldn -> do DB.execute db @@ -394,7 +394,7 @@ createContact_ db userId Profile {displayName, fullName, image, contactLink, pre DB.execute db "INSERT INTO contacts (contact_profile_id, local_display_name, user_id, via_group, created_at, updated_at, chat_ts, contact_used) VALUES (?,?,?,?,?,?,?,?)" - (profileId, ldn, userId, viaGroup, currentTs, currentTs, currentTs, BI contactUsed) + (profileId, ldn, userId, viaGroup, currentTs, currentTs, currentTs, BI True) contactId <- insertedRowId db pure $ Right (ldn, contactId, profileId) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 445ec0b7c0..69f9799948 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -315,7 +315,6 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe CRGroupLinkCreated u g cReq mRole -> ttyUser u $ groupLink_ "Group link is created!" g cReq mRole CRGroupLink u g cReq mRole -> ttyUser u $ groupLink_ "Group link:" g cReq mRole CRGroupLinkDeleted u g -> ttyUser u $ viewGroupLinkDeleted g - CRAcceptingGroupJoinRequest _ g c -> [ttyFullContact c <> ": accepting request to join group " <> ttyGroup' g <> "..."] CRAcceptingGroupJoinRequestMember _ g m -> [ttyFullMember m <> ": accepting request to join group " <> ttyGroup' g <> "..."] CRNoMemberContactCreating u g m -> ttyUser u ["member " <> ttyGroup' g <> " " <> ttyMember m <> " does not have direct connection, creating"] CRNewMemberContact u _ g m -> ttyUser u ["contact for member " <> ttyGroup' g <> " " <> ttyMember m <> " is created"] diff --git a/tests/Bots/DirectoryTests.hs b/tests/Bots/DirectoryTests.hs index 12de4cf742..6994a8528a 100644 --- a/tests/Bots/DirectoryTests.hs +++ b/tests/Bots/DirectoryTests.hs @@ -51,10 +51,10 @@ directoryServiceTests = do it "should NOT allow approving if roles are incorrect" testNotApprovedBadRoles describe "should require re-approval if profile is changed by" $ do it "the registration owner" testRegOwnerChangedProfile - it "another owner" testAnotherOwnerChangedProfile + it "another owner" testAnotherOwnerChangedProfile -- TODO fix - doesn't work if another owner is not connected as contact describe "should require profile update if group link is removed by " $ do it "the registration owner" testRegOwnerRemovedLink - it "another owner" testAnotherOwnerRemovedLink + it "another owner" testAnotherOwnerRemovedLink -- TODO fix - doesn't work if another owner is not connected as contact describe "duplicate groups (same display name and full name)" $ do it "should ask for confirmation if a duplicate group is submitted" testDuplicateAskConfirmation it "should prohibit registration if a duplicate group is listed" testDuplicateProhibitRegistration @@ -230,7 +230,7 @@ testSuspendResume ps = bob <# "SimpleX-Directory> The group ID 1 (privacy) is listed in the directory again!" groupFound bob "privacy" superUser #> "@SimpleX-Directory privacy" - groupFoundN_ (Just 1) 2 superUser "privacy" + groupFoundN_ "" (Just 1) 2 superUser "privacy" superUser #> "@SimpleX-Directory /link 1:privacy" superUser <# "SimpleX-Directory> > /link 1:privacy" superUser <## " The link to join the group ID 1 (privacy):" @@ -284,10 +284,10 @@ testSetRole ps = testJoinGroup :: HasCallStack => TestParams -> IO () testJoinGroup ps = - withDirectoryServiceCfg ps testCfgGroupLinkViaContact $ \superUser dsLink -> - withNewTestChatCfg ps testCfgGroupLinkViaContact "bob" bobProfile $ \bob -> do - withNewTestChatCfg ps testCfgGroupLinkViaContact "cath" cathProfile $ \cath -> - withNewTestChatCfg ps testCfgGroupLinkViaContact "dan" danProfile $ \dan -> do + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> do + withNewTestChat ps "cath" cathProfile $ \cath -> + withNewTestChat ps "dan" danProfile $ \dan -> do bob `connectVia` dsLink registerGroup superUser bob "privacy" "Privacy" cath `connectVia` dsLink @@ -301,10 +301,10 @@ testJoinGroup ps = cath <## "2 members" cath ##> ("/c " <> groupLink) cath <## "connection request sent!" - cath <## "SimpleX-Directory_1: contact is connected" - cath <## "contact SimpleX-Directory_1 is merged into SimpleX-Directory" - cath <## "use @SimpleX-Directory to send messages" + cath <## "#privacy: joining the group..." cath <## "#privacy: you joined the group" + cath <## "contact and member are merged: SimpleX-Directory, #privacy SimpleX-Directory_1" + cath <## "use @SimpleX-Directory to send messages" cath <# ("#privacy SimpleX-Directory> " <> welcomeMsg) cath <## "#privacy: member bob (Bob) is connected" bob <## "#privacy: SimpleX-Directory added cath (Catherine) to the group (connecting...)" @@ -316,11 +316,9 @@ testJoinGroup ps = concurrentlyN_ [ do bob <## "dan (Daniel): accepting request to join group #privacy..." - bob <## "dan (Daniel): contact is connected" - bob <## "dan invited to group #privacy via your group link" bob <## "#privacy: dan joined the group", do - dan <## "bob (Bob): contact is connected" + dan <## "#privacy: joining the group..." dan <## "#privacy: you joined the group" dan <# ("#privacy bob> " <> welcomeMsg) dan @@ -456,9 +454,9 @@ testInviteToOwnersGroup ps = testDelistedOwnerLeaves :: HasCallStack => TestParams -> IO () testDelistedOwnerLeaves ps = - withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink -> - withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob -> - withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do bob `connectVia` dsLink registerGroup superUser bob "privacy" "Privacy" addCathAsOwner bob cath @@ -468,13 +466,16 @@ testDelistedOwnerLeaves ps = bob <## "" bob <## "The group is no longer listed in the directory." superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (group owner left)." + cath `connectVia` dsLink + cath <## "contact and member are merged: SimpleX-Directory_1, #privacy SimpleX-Directory" + cath <## "use @SimpleX-Directory to send messages" groupNotFound cath "privacy" testDelistedOwnerRemoved :: HasCallStack => TestParams -> IO () testDelistedOwnerRemoved ps = - withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink -> - withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob -> - withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do bob `connectVia` dsLink registerGroup superUser bob "privacy" "Privacy" addCathAsOwner bob cath @@ -483,38 +484,45 @@ testDelistedOwnerRemoved ps = bob <## "" bob <## "The group is no longer listed in the directory." superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (group owner is removed)." + cath `connectVia` dsLink + cath <## "contact and member are merged: SimpleX-Directory_1, #privacy SimpleX-Directory" + cath <## "use @SimpleX-Directory to send messages" groupNotFound cath "privacy" testNotDelistedMemberLeaves :: HasCallStack => TestParams -> IO () testNotDelistedMemberLeaves ps = - withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink -> - withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob -> - withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do bob `connectVia` dsLink registerGroup superUser bob "privacy" "Privacy" addCathAsOwner bob cath leaveGroup "privacy" cath bob <## "#privacy: cath left the group" (superUser "@SimpleX-Directory_1 privacy" + groupFoundN_ "_1" Nothing 2 cath "privacy" testNotDelistedMemberRemoved :: HasCallStack => TestParams -> IO () testNotDelistedMemberRemoved ps = - withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink -> - withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob -> - withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do bob `connectVia` dsLink registerGroup superUser bob "privacy" "Privacy" addCathAsOwner bob cath removeMember "privacy" bob cath (superUser "@SimpleX-Directory_1 privacy" + groupFoundN_ "_1" Nothing 2 cath "privacy" testDelistedServiceRemoved :: HasCallStack => TestParams -> IO () testDelistedServiceRemoved ps = - withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink -> - withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob -> - withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do bob `connectVia` dsLink registerGroup superUser bob "privacy" "Privacy" addCathAsOwner bob cath @@ -525,7 +533,8 @@ testDelistedServiceRemoved ps = bob <## "" bob <## "The group is no longer listed in the directory." superUser <# "SimpleX-Directory> The group ID 1 (privacy) is de-listed (directory service is removed)." - groupNotFound cath "privacy" + cath `connectVia` dsLink + groupNotFound_ "_1" cath "privacy" testDelistedGroupDeleted :: HasCallStack => TestParams -> IO () testDelistedGroupDeleted ps = @@ -553,12 +562,15 @@ testDelistedGroupDeleted ps = testDelistedRoleChanges :: HasCallStack => TestParams -> IO () testDelistedRoleChanges ps = - withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink -> - withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob -> - withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do bob `connectVia` dsLink registerGroup superUser bob "privacy" "Privacy" addCathAsOwner bob cath + cath `connectVia` dsLink + cath <## "contact and member are merged: SimpleX-Directory_1, #privacy SimpleX-Directory" + cath <## "use @SimpleX-Directory to send messages" groupFoundN 3 cath "privacy" -- de-listed if service role changed bob ##> "/mr privacy SimpleX-Directory member" @@ -599,12 +611,15 @@ testDelistedRoleChanges ps = testNotDelistedMemberRoleChanged :: HasCallStack => TestParams -> IO () testNotDelistedMemberRoleChanged ps = - withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink -> - withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob -> - withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do bob `connectVia` dsLink registerGroup superUser bob "privacy" "Privacy" addCathAsOwner bob cath + cath `connectVia` dsLink + cath <## "contact and member are merged: SimpleX-Directory_1, #privacy SimpleX-Directory" + cath <## "use @SimpleX-Directory to send messages" groupFoundN 3 cath "privacy" bob ##> "/mr privacy cath member" bob <## "#privacy: you changed the role of cath from owner to member" @@ -663,9 +678,9 @@ testNotApprovedBadRoles ps = testRegOwnerChangedProfile :: HasCallStack => TestParams -> IO () testRegOwnerChangedProfile ps = - withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink -> - withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob -> - withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do bob `connectVia` dsLink registerGroup superUser bob "privacy" "Privacy" addCathAsOwner bob cath @@ -675,6 +690,9 @@ testRegOwnerChangedProfile ps = bob <## "It is hidden from the directory until approved." cath <## "bob updated group #privacy:" cath <## "full name changed to: Privacy and Security" + cath `connectVia` dsLink + cath <## "contact and member are merged: SimpleX-Directory_1, #privacy SimpleX-Directory" + cath <## "use @SimpleX-Directory to send messages" groupNotFound cath "privacy" superUser <# "SimpleX-Directory> The group ID 1 (privacy) is updated." reapproveGroup 3 superUser bob @@ -682,12 +700,15 @@ testRegOwnerChangedProfile ps = testAnotherOwnerChangedProfile :: HasCallStack => TestParams -> IO () testAnotherOwnerChangedProfile ps = - withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink -> - withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob -> - withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do bob `connectVia` dsLink registerGroup superUser bob "privacy" "Privacy" addCathAsOwner bob cath + cath `connectVia` dsLink + cath <## "contact and member are merged: SimpleX-Directory_1, #privacy SimpleX-Directory" + cath <## "use @SimpleX-Directory to send messages" cath ##> "/gp privacy privacy Privacy and Security" cath <## "full name changed to: Privacy and Security" bob <## "cath updated group #privacy:" @@ -701,9 +722,9 @@ testAnotherOwnerChangedProfile ps = testRegOwnerRemovedLink :: HasCallStack => TestParams -> IO () testRegOwnerRemovedLink ps = - withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink -> - withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob -> - withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do bob `connectVia` dsLink registerGroup superUser bob "privacy" "Privacy" addCathAsOwner bob cath @@ -720,6 +741,9 @@ testRegOwnerRemovedLink ps = cath <## "description changed to:" cath <## "Welcome!" superUser <# "SimpleX-Directory> The group link is removed from ID 1 (privacy), de-listed." + cath `connectVia` dsLink + cath <## "contact and member are merged: SimpleX-Directory_1, #privacy SimpleX-Directory" + cath <## "use @SimpleX-Directory to send messages" groupNotFound cath "privacy" bob ##> ("/set welcome #privacy " <> welcomeWithLink) bob <## "description changed to:" @@ -734,12 +758,15 @@ testRegOwnerRemovedLink ps = testAnotherOwnerRemovedLink :: HasCallStack => TestParams -> IO () testAnotherOwnerRemovedLink ps = - withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink -> - withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob -> - withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do bob `connectVia` dsLink registerGroup superUser bob "privacy" "Privacy" addCathAsOwner bob cath + cath `connectVia` dsLink + cath <## "contact and member are merged: SimpleX-Directory_1, #privacy SimpleX-Directory" + cath <## "use @SimpleX-Directory to send messages" bob ##> "/show welcome #privacy" bob <## "Welcome message:" welcomeWithLink <- getTermLine bob @@ -883,9 +910,9 @@ testDuplicateProhibitApproval ps = testListUserGroups :: HasCallStack => TestParams -> IO () testListUserGroups ps = - withDirectoryServiceCfg ps testCfgCreateGroupDirect $ \superUser dsLink -> - withNewTestChatCfg ps testCfgCreateGroupDirect "bob" bobProfile $ \bob -> - withNewTestChatCfg ps testCfgCreateGroupDirect "cath" cathProfile $ \cath -> do + withDirectoryService ps $ \superUser dsLink -> + withNewTestChat ps "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> do bob `connectVia` dsLink cath `connectVia` dsLink registerGroup superUser bob "privacy" "Privacy" @@ -893,7 +920,7 @@ testListUserGroups ps = fullAddMember "privacy" "Privacy" bob cath GRMember joinGroup "privacy" cath bob cath <## "#privacy: member SimpleX-Directory_1 is connected" - cath <## "contact SimpleX-Directory_1 is merged into SimpleX-Directory" + cath <## "contact and member are merged: SimpleX-Directory, #privacy SimpleX-Directory_1" cath <## "use @SimpleX-Directory to send messages" registerGroupId superUser bob "security" "Security" 2 2 registerGroupId superUser cath "anonymity" "Anonymity" 3 1 @@ -937,7 +964,6 @@ testRestoreDirectory ps = do groupFound bob "security" groupFoundN 3 cath "privacy" cath #> "@SimpleX-Directory security" - cath <## "SimpleX-Directory: quantum resistant end-to-end encryption enabled" groupFoundN' 2 cath "security" listGroups :: HasCallStack => TestCC -> TestCC -> TestCC -> IO () @@ -1161,8 +1187,8 @@ connectVia :: TestCC -> String -> IO () u `connectVia` dsLink = do u ##> ("/c " <> dsLink) u <## "connection request sent!" - u <## "SimpleX-Directory: contact is connected" - u <# "SimpleX-Directory> Welcome to SimpleX-Directory service!" + u .<## ": contact is connected" + u .<# "> Welcome to SimpleX-Directory service!" u <## "Send a search string to find groups or /help to learn how to add groups to directory." u <## "" u <## "For example, send privacy to find groups about privacy." @@ -1206,19 +1232,22 @@ groupFoundN count u name = do groupFoundN' count u name groupFoundN' :: Int -> TestCC -> String -> IO () -groupFoundN' = groupFoundN_ Nothing +groupFoundN' = groupFoundN_ "" Nothing -groupFoundN_ :: Maybe Int -> Int -> TestCC -> String -> IO () -groupFoundN_ shownId_ count u name = do - u <# ("SimpleX-Directory> > " <> name) +groupFoundN_ :: String -> Maybe Int -> Int -> TestCC -> String -> IO () +groupFoundN_ suffix shownId_ count u name = do + u <# ("SimpleX-Directory" <> suffix <> "> > " <> name) u <## " Found 1 group(s)." - u <#. ("SimpleX-Directory> " <> maybe "" (\gId -> show gId <> ". ") shownId_ <> name) + u <#. ("SimpleX-Directory" <> suffix <> "> " <> maybe "" (\gId -> show gId <> ". ") shownId_ <> name) u <## "Welcome message:" u <##. "Link to join the group " u <## (show count <> " members") groupNotFound :: TestCC -> String -> IO () -groupNotFound u s = do - u #> ("@SimpleX-Directory " <> s) - u <# ("SimpleX-Directory> > " <> s) +groupNotFound = groupNotFound_ "" + +groupNotFound_ :: String -> TestCC -> String -> IO () +groupNotFound_ suffix u s = do + u #> ("@SimpleX-Directory" <> suffix <> " " <> s) + u <# ("SimpleX-Directory" <> suffix <> "> > " <> s) u <## " No groups found" diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 1a04badc3e..3376204f14 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -254,30 +254,6 @@ prevVersion (Version v) = Version (v - 1) nextVersion :: Version v -> Version v nextVersion (Version v) = Version (v + 1) -testCfgCreateGroupDirect :: ChatConfig -testCfgCreateGroupDirect = - mkCfgCreateGroupDirect testCfg - -mkCfgCreateGroupDirect :: ChatConfig -> ChatConfig -mkCfgCreateGroupDirect cfg = - cfg - { chatVRange = groupCreateDirectVRange, - agentConfig = testAgentCfgSlow - } - -groupCreateDirectVRange :: VersionRangeChat -groupCreateDirectVRange = mkVersionRange (VersionChat 1) (VersionChat 1) - -testCfgGroupLinkViaContact :: ChatConfig -testCfgGroupLinkViaContact = - mkCfgGroupLinkViaContact testCfg - -mkCfgGroupLinkViaContact :: ChatConfig -> ChatConfig -mkCfgGroupLinkViaContact cfg = cfg {chatVRange = groupLinkViaContactVRange} - -groupLinkViaContactVRange :: VersionRangeChat -groupLinkViaContactVRange = mkVersionRange (VersionChat 1) (VersionChat 2) - createTestChat :: TestParams -> ChatConfig -> ChatOpts -> String -> Profile -> IO TestCC createTestChat ps cfg opts@ChatOpts {coreOptions} dbPrefix profile = do Right db@ChatDatabase {chatStore, agentStore} <- createDatabase ps coreOptions dbPrefix diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index ea4a30b412..998835b867 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -60,7 +60,6 @@ chatDirectTests = do it "deleting contact deletes profile" testDeleteContactDeletesProfile it "delete contact keeping conversation" testDeleteContactKeepConversation it "delete conversation keeping contact" testDeleteConversationKeepContact - it "unused contact is deleted silently" testDeleteUnusedContactSilent it "direct message quoted replies" testDirectMessageQuotedReply it "direct message update" testDirectMessageUpdate it "direct message edit history" testDirectMessageEditHistory @@ -612,42 +611,6 @@ testDeleteConversationKeepContact = alice @@@ [("@bob", "hi")] alice <##> bob -testDeleteUnusedContactSilent :: HasCallStack => TestParams -> IO () -testDeleteUnusedContactSilent = - testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ - \alice bob cath -> do - createGroup3 "team" alice bob cath - bob ##> "/contacts" - bob <### ["alice (Alice)", "cath (Catherine)"] - bob `hasContactProfiles` ["bob", "alice", "cath"] - cath ##> "/contacts" - cath <### ["alice (Alice)", "bob (Bob)"] - cath `hasContactProfiles` ["cath", "alice", "bob"] - -- bob deletes cath, cath's bob contact is deleted silently - bob ##> "/d cath" - bob <## "cath: contact is deleted" - bob ##> "/contacts" - bob <## "alice (Alice)" - threadDelay 50000 - cath ##> "/contacts" - cath <## "alice (Alice)" - -- group messages work - alice #> "#team hello" - concurrentlyN_ - [ bob <# "#team alice> hello", - cath <# "#team alice> hello" - ] - bob #> "#team hi there" - concurrentlyN_ - [ alice <# "#team bob> hi there", - cath <# "#team bob> hi there" - ] - cath #> "#team hey" - concurrentlyN_ - [ alice <# "#team cath> hey", - bob <# "#team cath> hey" - ] - testDirectMessageQuotedReply :: HasCallStack => TestParams -> IO () testDirectMessageQuotedReply = testChat2 aliceProfile bobProfile $ @@ -2567,7 +2530,7 @@ testSetChatItemTTL = testSetDirectChatTTL :: HasCallStack => TestParams -> IO () testSetDirectChatTTL = - testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ + testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do connectUsers alice bob connectUsers alice cath diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index ee957d3daa..6817f19e87 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -25,14 +25,15 @@ import Simplex.Chat.Library.Internal (uniqueMsgMentions, updatedMentionNames) import Simplex.Chat.Markdown (parseMaybeMarkdownList) import Simplex.Chat.Messages (CIMention (..), CIMentionMember (..), ChatItemId) import Simplex.Chat.Options -import Simplex.Chat.Protocol (MsgMention (..), MsgContent (..), msgContentText, supportedChatVRange) -import Simplex.Chat.Types (MemberId (..), VersionRangeChat) +import Simplex.Chat.Protocol (MsgMention (..), MsgContent (..), msgContentText) +import Simplex.Chat.Types import Simplex.Chat.Types.Shared (GroupMemberRole (..)) import Simplex.Messaging.Agent.Env.SQLite import Simplex.Messaging.Agent.RetryInterval import qualified Simplex.Messaging.Agent.Store.DB as DB import Simplex.Messaging.Server.Env.STM hiding (subscriptions) import Simplex.Messaging.Transport +import Simplex.Messaging.Version import Test.Hspec hiding (it) #if defined(dbPostgres) import Database.PostgreSQL.Simple (Only (..)) @@ -47,10 +48,9 @@ chatGroupTests :: SpecWith TestParams chatGroupTests = do describe "chat groups" $ do describe "add contacts, create group and send/receive messages" testGroupMatrix + it "add contacts, create group and send/receive messages, check messages" testGroupCheckMessages it "mark multiple messages as read" testMarkReadGroup it "initial chat pagination" testChatPaginationInitial - it "v1: add contacts, create group and send/receive messages" testGroup - it "v1: add contacts, create group and send/receive messages, check messages" testGroupCheckMessages it "send large message" testGroupLargeMessage it "create group with incognito membership" testNewGroupIncognito it "create and join group with 4 members" testGroup2 @@ -72,7 +72,6 @@ chatGroupTests = do it "group live message" testGroupLiveMessage it "update group profile" testUpdateGroupProfile it "update member role" testUpdateMemberRole - it "unused contacts are deleted after all their groups are deleted" testGroupDeleteUnusedContacts it "group description is shown as the first message to new members" testGroupDescription it "moderate message of another group member" testGroupModerate it "moderate own message (should process as deletion)" testGroupModerateOwn @@ -88,32 +87,21 @@ chatGroupTests = do xit "create and join group when clients go offline" testGroupAsync describe "group links" $ do it "create group link, join via group link" testGroupLink + it "invitees were previously connected as contacts" testGroupLinkInviteesWereConnected + it "all members were previously connected as contacts" testGroupLinkAllMembersWereConnected it "delete group, re-join via same link" testGroupLinkDeleteGroupRejoin - it "sending message to contact created via group link marks it used" testGroupLinkContactUsed - it "create group link, join via group link - incognito membership" testGroupLinkIncognitoMembership - it "unused host contact is deleted after all groups with it are deleted" testGroupLinkUnusedHostContactDeleted - it "leaving groups with unused host contacts deletes incognito profiles" testGroupLinkIncognitoUnusedHostContactsDeleted + it "host incognito" testGroupLinkHostIncognito + it "invitee incognito" testGroupLinkInviteeIncognito + it "incognito - join/invite" testGroupLinkIncognitoJoinInvite it "group link member role" testGroupLinkMemberRole - it "leaving and deleting the group joined via link should NOT delete previously existing direct contacts" testGroupLinkLeaveDelete + it "host profile received" testGroupLinkHostProfileReceived + it "existing contact merged" testGroupLinkExistingContactMerged describe "group link connection plan" $ do - it "group link ok to connect; known group" testPlanGroupLinkOkKnown - it "group is known if host contact was deleted" testPlanHostContactDeletedGroupLinkKnown + it "ok to connect; known group" testPlanGroupLinkKnown it "own group link" testPlanGroupLinkOwn - it "connecting via group link" testPlanGroupLinkConnecting + it "group link without contact - connecting" testPlanGroupLinkConnecting + it "group link without contact - connecting (slow handshake)" testPlanGroupLinkConnectingSlow it "re-join existing group after leaving" testPlanGroupLinkLeaveRejoin - describe "group links without contact" $ do - it "join via group link without creating contact" testGroupLinkNoContact - it "invitees were previously connected as contacts" testGroupLinkNoContactInviteesWereConnected - it "all members were previously connected as contacts" testGroupLinkNoContactAllMembersWereConnected - it "group link member role" testGroupLinkNoContactMemberRole - it "host incognito" testGroupLinkNoContactHostIncognito - it "invitee incognito" testGroupLinkNoContactInviteeIncognito - it "host profile received" testGroupLinkNoContactHostProfileReceived - it "existing contact merged" testGroupLinkNoContactExistingContactMerged - describe "group links without contact connection plan" $ do - it "group link without contact - known group" testPlanGroupLinkNoContactKnown - it "group link without contact - connecting" testPlanGroupLinkNoContactConnecting - it "group link without contact - connecting (slow handshake)" testPlanGroupLinkNoContactConnectingSlow #if !defined(dbPostgres) -- TODO [postgres] restore from outdated db backup (same as in agent) describe "group message errors" $ do @@ -127,11 +115,7 @@ chatGroupTests = do it "should send delivery receipts in group" testSendGroupDeliveryReceipts it "should send delivery receipts in group depending on configuration" testConfigureGroupDeliveryReceipts describe "direct connections in group are not established based on chat protocol version" $ do - describe "3 members group" $ do - testNoDirect _0 _0 True - testNoDirect _0 _1 True - testNoDirect _1 _0 False - testNoDirect _1 _1 False + it "direct contacts are not created" testNoGroupDirectConns it "members have different local display names in different groups" testNoDirectDifferentLDNs describe "merge members and contacts" $ do it "new member should merge with existing contact" testMergeMemberExistingContact @@ -196,37 +180,18 @@ chatGroupTests = do it "should send updated mentions in history" testGroupHistoryWithMentions describe "uniqueMsgMentions" testUniqueMsgMentions describe "updatedMentionNames" testUpdatedMentionNames - where - _0 = supportedChatVRange -- don't create direct connections - _1 = groupCreateDirectVRange - -- having host configured with older version doesn't have effect in tests - -- because host uses current code and sends version in MemberInfo - testNoDirect vrMem2 vrMem3 noConns = - it - ( "host " - <> vRangeStr supportedChatVRange - <> (", 2nd mem " <> vRangeStr vrMem2) - <> (", 3rd mem " <> vRangeStr vrMem3) - <> (if noConns then " : 2 3" else " : 2 <##> 3") - ) - $ testNoGroupDirectConns supportedChatVRange vrMem2 vrMem3 noConns - -testGroup :: HasCallStack => TestParams -> IO () -testGroup = - testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ - \alice bob cath -> testGroupShared alice bob cath False True testGroupCheckMessages :: HasCallStack => TestParams -> IO () testGroupCheckMessages = - testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ - \alice bob cath -> testGroupShared alice bob cath True True + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> testGroupShared alice bob cath True testGroupMatrix :: SpecWith TestParams testGroupMatrix = - versionTestMatrix3 $ \alice bob cath -> testGroupShared alice bob cath False False + versionTestMatrix3 $ \alice bob cath -> testGroupShared alice bob cath False -testGroupShared :: HasCallStack => TestCC -> TestCC -> TestCC -> Bool -> Bool -> IO () -testGroupShared alice bob cath checkMessages directConnections = do +testGroupShared :: HasCallStack => TestCC -> TestCC -> TestCC -> Bool -> IO () +testGroupShared alice bob cath checkMessages = do connectUsers alice bob connectUsers alice cath alice ##> "/g team" @@ -278,8 +243,6 @@ testGroupShared alice bob cath checkMessages directConnections = do (alice <# "#team cath> hey team") (bob <# "#team cath> hey team") msgItem2 <- lastItemId alice - when directConnections $ - bob <##> cath when checkMessages $ getReadChats msgItem1 msgItem2 -- list groups alice ##> "/gs" @@ -336,8 +299,6 @@ testGroupShared alice bob cath checkMessages directConnections = do (cath "#team hello" cath <## "you are no longer a member of the group" - when directConnections $ - bob <##> cath -- delete contact alice ##> "/d bob" alice <## "bob: contact is deleted" @@ -350,7 +311,7 @@ testGroupShared alice bob cath checkMessages directConnections = do alice <# "#team bob> received" when checkMessages $ do alice @@@ [("@cath", "sent invitation to join group team as admin"), ("#team", "received")] - bob @@@ [("@alice", "contact deleted"), ("@cath", "hey"), ("#team", "received")] + bob @@@ [("@alice", "contact deleted"), ("#team", "received")] -- test clearing chat threadDelay 1000000 alice #$> ("/clear #team", id, "#team: all messages are removed locally ONLY") @@ -370,9 +331,9 @@ testGroupShared alice bob cath checkMessages directConnections = do alice #$> ("/_get chat #1 before=" <> msgItem2 <> " count=100", chat, sndGroupFeatures <> [(0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there")]) alice #$> ("/_get chat #1 around=" <> msgItem1 <> " count=2", chat, [(0, "connected"), (0, "connected"), (1, "hello"), (0, "hi there"), (0, "hey team")]) alice #$> ("/_get chat #1 count=100 search=team", chat, [(0, "hey team")]) - bob @@@ [("@cath", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")] + bob @@@ [("#team", "hey team"), ("@alice", "received invitation to join group team as admin")] bob #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "added cath (Catherine)"), (0, "connected"), (0, "hello"), (1, "hi there"), (0, "hey team")]) - cath @@@ [("@bob", "hey"), ("#team", "hey team"), ("@alice", "received invitation to join group team as admin")] + cath @@@ [("#team", "hey team"), ("@alice", "received invitation to join group team as admin")] cath #$> ("/_get chat #1 count=100", chat, groupFeatures <> [(0, "connected"), (0, "connected"), (0, "hello"), (0, "hi there"), (1, "hey team")]) alice #$> ("/_read chat #1", id, "ok") bob #$> ("/_read chat #1", id, "ok") @@ -444,7 +405,7 @@ testGroupLargeMessage = testNewGroupIncognito :: HasCallStack => TestParams -> IO () testNewGroupIncognito = - testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $ + testChat2 aliceProfile bobProfile $ \alice bob -> do connectUsers alice bob @@ -463,22 +424,35 @@ testNewGroupIncognito = bob ##> ("/c " <> gLink) bob <## "connection request sent!" alice <## "bob_1 (Bob): accepting request to join group #team..." - _ <- getTermLine alice concurrentlyN_ - [ do - alice <## ("bob_1 (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito) - alice <## "use /i bob_1 to print out this incognito profile again" - alice <## "bob_1 invited to group #team via your group link" - alice <## "#team: bob_1 joined the group", + [ alice <## "#team: bob_1 joined the group", do - bob <## (aliceIncognito <> ": contact is connected") + bob <## "#team: joining the group..." bob <## "#team: you joined the group" ] alice <##> bob - alice ?#> "@bob_1 hi, I'm incognito" - bob <# (aliceIncognito <> "> hi, I'm incognito") + alice ##> "@#team bob_1 hi, I'm incognito" + alice + <### [ "member #team bob_1 does not have direct connection, creating", + "contact for member #team bob_1 is created", + "sent invitation to connect directly to member #team bob_1", + WithTime "i @bob_1 hi, I'm incognito" + ] + bob + <### [ ConsoleString ("#team " <> aliceIncognito <> " is creating direct contact " <> aliceIncognito <> " with you"), + WithTime (aliceIncognito <> "> hi, I'm incognito") + ] + bob <## (aliceIncognito <> ": you can send messages to contact") + _ <- getTermLine alice + concurrentlyN_ + [ do + alice <## ("bob_1 (Bob): contact is connected, your incognito profile for this contact is " <> aliceIncognito) + alice <## "use /i bob_1 to print out this incognito profile again", + bob <## (aliceIncognito <> ": contact is connected") + ] + bob #> ("@" <> aliceIncognito <> " hey, I'm bob") alice ?<# "bob_1> hey, I'm bob" @@ -494,7 +468,7 @@ testNewGroupIncognito = testGroup2 :: HasCallStack => TestParams -> IO () testGroup2 = - testChatCfg4 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile danProfile $ + testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do connectUsers alice bob connectUsers alice cath @@ -545,14 +519,14 @@ testGroup2 = dan <## "#club: you joined the group" dan <### [ "#club: member alice_1 (Alice) is connected", - "contact alice_1 is merged into alice", + "contact and member are merged: alice, #club alice_1", "use @alice to send messages", "#club: member cath (Catherine) is connected" ], do alice <## "#club: bob added dan_1 (Daniel) to the group (connecting...)" alice <## "#club: new member dan_1 is connected" - alice <## "contact dan_1 is merged into dan" + alice <## "contact and member are merged: dan, #club dan_1" alice <## "use @dan to send messages", do cath <## "#club: bob added dan (Daniel) to the group (connecting...)" @@ -582,8 +556,6 @@ testGroup2 = bob <# "#club dan> how is it going?", cath <# "#club dan> how is it going?" ] - bob <##> cath - dan <##> cath dan <##> alice -- show last messages alice ##> "/t #club 17" @@ -666,7 +638,6 @@ testGroup2 = dan <## "you are no longer a member of the group" dan ##> "/d #club" dan <## "#club: you deleted the group" - dan <##> cath dan <##> alice -- member leaves bob ##> "/l club" @@ -689,7 +660,6 @@ testGroup2 = bob <## "you are no longer a member of the group" bob ##> "/d #club" bob <## "#club: you deleted the group" - bob <##> cath bob <##> alice testGroupDelete :: HasCallStack => TestParams -> IO () @@ -959,7 +929,7 @@ testDeleteGroupMemberProfileKept = testGroupRemoveAdd :: HasCallStack => TestParams -> IO () testGroupRemoveAdd = - testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ + testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath @@ -986,14 +956,10 @@ testGroupRemoveAdd = [ alice <## "#team: bob joined the group", do bob <## "#team_1: you joined the group" - bob <## "#team_1: member cath_1 (Catherine) is connected" - bob <## "contact cath_1 is merged into cath" - bob <## "use @cath to send messages", + bob <## "#team_1: member cath_1 (Catherine) is connected", do cath <## "#team: alice added bob_1 (Bob) to the group (connecting...)" cath <## "#team: new member bob_1 is connected" - cath <## "contact bob_1 is merged into bob" - cath <## "use @bob to send messages" ] alice #> "#team hi" concurrently_ @@ -1002,11 +968,11 @@ testGroupRemoveAdd = bob #> "#team_1 hey" concurrently_ (alice <# "#team bob> hey") - (cath <# "#team bob> hey") + (cath <# "#team bob_1> hey") cath #> "#team hello" concurrently_ (alice <# "#team cath> hello") - (bob <# "#team_1 cath> hello") + (bob <# "#team_1 cath_1> hello") testGroupList :: HasCallStack => TestParams -> IO () testGroupList = @@ -1040,7 +1006,7 @@ testGroupList = testGroupMessageQuotedReply :: HasCallStack => TestParams -> IO () testGroupMessageQuotedReply = - testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ + testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath threadDelay 1000000 @@ -1526,93 +1492,6 @@ testUpdateMemberRole = alice ##> "/d #team" alice <## "#team: you have insufficient permissions for this action, the required role is owner" -testGroupDeleteUnusedContacts :: HasCallStack => TestParams -> IO () -testGroupDeleteUnusedContacts = - testChatCfg3 cfg aliceProfile bobProfile cathProfile $ - \alice bob cath -> do - -- create group 1 - createGroup3 "team" alice bob cath - -- create group 2 - alice ##> "/g club" - alice <## "group #club is created" - alice <## "to add members use /a club or /create link #club" - alice ##> "/a club bob" - concurrentlyN_ - [ alice <## "invitation to join the group #club sent to bob", - do - bob <## "#club: alice invites you to join the group as member" - bob <## "use /j club to accept" - ] - bob ##> "/j club" - concurrently_ - (alice <## "#club: bob joined the group") - (bob <## "#club: you joined the group") - alice ##> "/a club cath" - concurrentlyN_ - [ alice <## "invitation to join the group #club sent to cath", - do - cath <## "#club: alice invites you to join the group as member" - cath <## "use /j club to accept" - ] - cath ##> "/j club" - concurrentlyN_ - [ alice <## "#club: cath joined the group", - do - cath <## "#club: you joined the group" - cath <## "#club: member bob_1 (Bob) is connected" - cath <## "contact bob_1 is merged into bob" - cath <## "use @bob to send messages", - do - bob <## "#club: alice added cath_1 (Catherine) to the group (connecting...)" - bob <## "#club: new member cath_1 is connected" - bob <## "contact cath_1 is merged into cath" - bob <## "use @cath to send messages" - ] - -- list contacts - bob ##> "/contacts" - bob <## "alice (Alice)" - bob <## "cath (Catherine)" - cath ##> "/contacts" - cath <## "alice (Alice)" - cath <## "bob (Bob)" - -- delete group 1, contacts and profiles are kept - deleteGroup alice bob cath "team" - bob ##> "/contacts" - bob <## "alice (Alice)" - bob <## "cath (Catherine)" - bob `hasContactProfiles` ["alice", "bob", "cath"] - cath ##> "/contacts" - cath <## "alice (Alice)" - cath <## "bob (Bob)" - cath `hasContactProfiles` ["alice", "bob", "cath"] - -- delete group 2, unused contacts and profiles are deleted - deleteGroup alice bob cath "club" - threadDelay 3000000 - bob ##> "/contacts" - bob <## "alice (Alice)" - bob `hasContactProfiles` ["alice", "bob"] - cath ##> "/contacts" - cath <## "alice (Alice)" - cath `hasContactProfiles` ["alice", "cath"] - where - cfg = mkCfgCreateGroupDirect $ testCfg {initialCleanupManagerDelay = 0, cleanupManagerInterval = 1, cleanupManagerStepDelay = 0} - deleteGroup :: HasCallStack => TestCC -> TestCC -> TestCC -> String -> IO () - deleteGroup alice bob cath group = do - alice ##> ("/d #" <> group) - concurrentlyN_ - [ alice <## ("#" <> group <> ": you deleted the group"), - do - bob <## ("#" <> group <> ": alice deleted the group") - bob <## ("use /d #" <> group <> " to delete the local copy of the group"), - do - cath <## ("#" <> group <> ": alice deleted the group") - cath <## ("use /d #" <> group <> " to delete the local copy of the group") - ] - bob ##> ("/d #" <> group) - bob <## ("#" <> group <> ": you deleted the group") - cath ##> ("/d #" <> group) - cath <## ("#" <> group <> ": you deleted the group") - testGroupDescription :: HasCallStack => TestParams -> IO () testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do connectUsers alice bob @@ -1630,7 +1509,7 @@ testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile ] alice ##> "/group_profile team" alice <## "#team" - groupInfo alice + groupInfo' alice alice ##> "/group_descr team Welcome to the team!" alice <## "description changed to:" alice <## "Welcome to the team!" @@ -1641,7 +1520,7 @@ testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile alice <## "#team" alice <## "description:" alice <## "Welcome to the team!" - groupInfo alice + groupInfo' alice connectUsers alice cath addMember "team" alice cath GRMember cath ##> "/j team" @@ -1671,8 +1550,8 @@ testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile bobAddedDan cath ] where - groupInfo :: HasCallStack => TestCC -> IO () - groupInfo alice = do + groupInfo' :: HasCallStack => TestCC -> IO () + groupInfo' alice = do alice <## "group preferences:" alice <## "Disappearing messages: off" alice <## "Direct messages: on" @@ -1689,7 +1568,7 @@ testGroupDescription = testChat4 aliceProfile bobProfile cathProfile danProfile testGroupModerate :: HasCallStack => TestParams -> IO () testGroupModerate = - testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ + testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath disableFullDeletion3 "team" alice bob cath @@ -1772,7 +1651,7 @@ testGroupModerateMultiple = testGroupModerateFullDelete :: HasCallStack => TestParams -> IO () testGroupModerateFullDelete = - testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ + testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath disableFullDeletion3 "team" alice bob cath @@ -1841,7 +1720,7 @@ testGroupDelayedModeration ps = do bob <## "#team: connected to server(s)" bob <## "#team: alice added cath (Catherine) to the group (connecting...)" withTestChatCfg ps cfg "cath" $ \cath -> do - cath <## "2 contacts connected (use /cs for the list)" + cath <## "1 contacts connected (use /cs for the list)" cath <## "#team: connected to server(s)" cath <## "#team: member bob (Bob) is connected" bob @@ -1854,7 +1733,8 @@ testGroupDelayedModeration ps = do r <- chat <$> getTermLine bob r `shouldMatchList` [(0, "connected"), (0, "hi [marked deleted by alice]")] where - cfg = testCfgCreateGroupDirect + -- version before forwarding, so cath doesn't expect alice to forward messages (groupForwardVersion = 4) + cfg = testCfg {chatVRange = mkVersionRange (VersionChat 1) (VersionChat 3)} testGroupDelayedModerationFullDelete :: HasCallStack => TestParams -> IO () testGroupDelayedModerationFullDelete ps = do @@ -1899,7 +1779,7 @@ testGroupDelayedModerationFullDelete ps = do bob <## "updated group preferences:" bob <## "Full deletion: on" withTestChatCfg ps cfg "cath" $ \cath -> do - cath <## "2 contacts connected (use /cs for the list)" + cath <## "1 contacts connected (use /cs for the list)" cath <## "#team: connected to server(s)" cath <## "#team: member bob (Bob) is connected" bob @@ -1912,7 +1792,8 @@ testGroupDelayedModerationFullDelete ps = do r <- chat <$> getTermLine bob r `shouldMatchList` [(0, "Full deletion: on"), (0, "connected"), (0, "moderated [deleted by alice]")] where - cfg = testCfgCreateGroupDirect + -- version before forwarding, so cath doesn't expect alice to forward messages (groupForwardVersion = 4) + cfg = testCfg {chatVRange = mkVersionRange (VersionChat 1) (VersionChat 3)} testSendMulti :: HasCallStack => TestParams -> IO () testSendMulti = @@ -2141,113 +2022,9 @@ testGroupAsync ps = do dan <##> cath dan <##> alice -testGroupLink :: HasCallStack => TestParams -> IO () -testGroupLink = - testChatCfg3 testCfgGroupLinkViaContact aliceProfile bobProfile cathProfile $ - \alice bob cath -> do - threadDelay 100000 - alice ##> "/g team" - alice <## "group #team is created" - alice <## "to add members use /a team or /create link #team" - alice ##> "/show link #team" - alice <## "no group link, to create: /create link #team" - alice ##> "/create link #team" - _ <- getGroupLink alice "team" GRMember True - alice ##> "/delete link #team" - alice <## "Group link is deleted - joined members will remain connected." - alice <## "To create a new group link use /create link #team" - alice ##> "/create link #team" - gLink <- getGroupLink alice "team" GRMember True - alice ##> "/show link #team" - _ <- getGroupLink alice "team" GRMember False - alice ##> "/create link #team" - alice <## "you already have link for this group, to show: /show link #team" - bob ##> ("/c " <> gLink) - bob <## "connection request sent!" - alice <## "bob (Bob): accepting request to join group #team..." - concurrentlyN_ - [ do - alice <## "bob (Bob): contact is connected" - alice <## "bob invited to group #team via your group link" - alice <## "#team: bob joined the group", - do - bob <## "alice (Alice): contact is connected" - bob <## "#team: you joined the group" - ] - threadDelay 100000 - alice #$> ("/_get chat #1 count=100", chat, sndGroupFeatures <> [(0, "invited via your group link"), (0, "connected")]) - -- contacts connected via group link are not in chat previews - alice @@@ [("#team", "connected")] - bob @@@ [("#team", "connected")] - alice <##> bob - alice @@@ [("@bob", "hey"), ("#team", "connected")] - - -- user address doesn't interfere - alice ##> "/ad" - cLink <- getContactLink alice True - cath ##> ("/c " <> cLink) - alice <#? cath - alice ##> "/ac cath" - alice <## "cath (Catherine): accepting contact request, you can send messages to contact" - concurrently_ - (cath <## "alice (Alice): contact is connected") - (alice <## "cath (Catherine): contact is connected") - alice <##> cath - - -- third member - cath ##> ("/c " <> gLink) - cath <## "connection request sent!" - alice <## "cath_1 (Catherine): accepting request to join group #team..." - -- if contact existed it is merged - concurrentlyN_ - [ alice - <### [ "cath_1 (Catherine): contact is connected", - "contact cath_1 is merged into cath", - "use @cath to send messages", - EndsWith "invited to group #team via your group link", - EndsWith "joined the group" - ], - cath - <### [ "alice_1 (Alice): contact is connected", - "contact alice_1 is merged into alice", - "use @alice to send messages", - "#team: you joined the group", - "#team: member bob (Bob) is connected" - ], - do - bob <## "#team: alice added cath (Catherine) to the group (connecting...)" - bob <## "#team: new member cath is connected" - ] - alice #> "#team hello" - concurrently_ - (bob <# "#team alice> hello") - (cath <# "#team alice> hello") - bob #> "#team hi there" - concurrently_ - (alice <# "#team bob> hi there") - (cath <# "#team bob> hi there") - cath #> "#team hey team" - concurrently_ - (alice <# "#team cath> hey team") - (bob <# "#team cath> hey team") - - threadDelay 100000 - - -- leaving team removes link - alice ##> "/l team" - concurrentlyN_ - [ do - alice <## "#team: you left the group" - alice <## "use /d #team to delete the group", - bob <## "#team: alice left the group", - cath <## "#team: alice left the group" - ] - alice ##> "/show link #team" - alice <## "no group link, to create: /create link #team" - testGroupLinkDeleteGroupRejoin :: HasCallStack => TestParams -> IO () testGroupLinkDeleteGroupRejoin = - testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $ + testChat2 aliceProfile bobProfile $ \alice bob -> do threadDelay 100000 alice ##> "/g team" @@ -2259,16 +2036,11 @@ testGroupLinkDeleteGroupRejoin = bob <## "connection request sent!" alice <## "bob (Bob): accepting request to join group #team..." concurrentlyN_ - [ do - alice <## "bob (Bob): contact is connected" - alice <## "bob invited to group #team via your group link" - alice <## "#team: bob joined the group", + [ alice <## "#team: bob joined the group", do - bob <## "alice (Alice): contact is connected" + bob <## "#team: joining the group..." bob <## "#team: you joined the group" ] - -- use contact so it's not deleted when deleting group - bob <##> alice bob ##> "/l team" concurrentlyN_ [ do @@ -2283,62 +2055,20 @@ testGroupLinkDeleteGroupRejoin = bob <## "connection request sent!" alice <## "bob_1 (Bob): accepting request to join group #team..." concurrentlyN_ - [ alice - <### [ "bob_1 (Bob): contact is connected", - "contact bob_1 is merged into bob", - "use @bob to send messages", - EndsWith "invited to group #team via your group link", - EndsWith "joined the group" - ], + [ alice <## "#team: bob_1 joined the group", bob - <### [ "alice_1 (Alice): contact is connected", - "contact alice_1 is merged into alice", - "use @alice to send messages", + <### [ "#team: joining the group...", "#team: you joined the group" ] ] alice #> "#team hello" bob <# "#team alice> hello" bob #> "#team hi there" - alice <# "#team bob> hi there" + alice <# "#team bob_1> hi there" -testGroupLinkContactUsed :: HasCallStack => TestParams -> IO () -testGroupLinkContactUsed = - testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $ - \alice bob -> do - threadDelay 100000 - alice ##> "/g team" - alice <## "group #team is created" - alice <## "to add members use /a team or /create link #team" - alice ##> "/create link #team" - gLink <- getGroupLink alice "team" GRMember True - bob ##> ("/c " <> gLink) - bob <## "connection request sent!" - alice <## "bob (Bob): accepting request to join group #team..." - concurrentlyN_ - [ do - alice <## "bob (Bob): contact is connected" - alice <## "bob invited to group #team via your group link" - alice <## "#team: bob joined the group", - do - bob <## "alice (Alice): contact is connected" - bob <## "#team: you joined the group" - ] - -- sending/receiving a message marks contact as used - threadDelay 100000 - alice @@@ [("#team", "connected")] - bob @@@ [("#team", "connected")] - alice #> "@bob hello" - bob <# "alice> hello" - threadDelay 500000 - alice #$> ("/clear bob", id, "bob: all messages are removed locally ONLY") - alice @@@ [("@bob", ""), ("#team", "connected")] - bob #$> ("/clear alice", id, "alice: all messages are removed locally ONLY") - bob @@@ [("@alice", ""), ("#team", "connected")] - -testGroupLinkIncognitoMembership :: HasCallStack => TestParams -> IO () -testGroupLinkIncognitoMembership = - testChatCfg4 testCfgGroupLinkViaContact aliceProfile bobProfile cathProfile danProfile $ +testGroupLinkIncognitoJoinInvite :: HasCallStack => TestParams -> IO () +testGroupLinkIncognitoJoinInvite = + testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do -- bob connected incognito to alice alice ##> "/c" @@ -2374,41 +2104,25 @@ testGroupLinkIncognitoMembership = cath ##> ("/c " <> gLink) cath <## "connection request sent!" bob <## "cath (Catherine): accepting request to join group #team..." - _ <- getTermLine bob concurrentlyN_ - [ do - bob <## ("cath (Catherine): contact is connected, your incognito profile for this contact is " <> bobIncognito) - bob <## "use /i cath to print out this incognito profile again" - bob <## "cath invited to group #team via your group link" - bob <## "#team: cath joined the group", + [ bob <## "#team: cath joined the group", do - cath <## (bobIncognito <> ": contact is connected") + cath <## "#team: joining the group..." cath <## "#team: you joined the group" cath <## "#team: member alice (Alice) is connected", do alice <## ("#team: " <> bobIncognito <> " added cath (Catherine) to the group (connecting...)") alice <## "#team: new member cath is connected" ] - bob ?#> "@cath hi, I'm incognito" - cath <# (bobIncognito <> "> hi, I'm incognito") - cath #> ("@" <> bobIncognito <> " hey, I'm cath") - bob ?<# "cath> hey, I'm cath" -- dan joins incognito dan ##> ("/c i " <> gLink) danIncognito <- getTermLine dan dan <## "connection request sent incognito!" bob <## (danIncognito <> ": accepting request to join group #team...") - _ <- getTermLine bob - _ <- getTermLine dan concurrentlyN_ - [ do - bob <## (danIncognito <> ": contact is connected, your incognito profile for this contact is " <> bobIncognito) - bob <## ("use /i " <> danIncognito <> " to print out this incognito profile again") - bob <## (danIncognito <> " invited to group #team via your group link") - bob <## ("#team: " <> danIncognito <> " joined the group"), + [ bob <## ("#team: " <> danIncognito <> " joined the group"), do - dan <## (bobIncognito <> ": contact is connected, your incognito profile for this contact is " <> danIncognito) - dan <## ("use /i " <> bobIncognito <> " to print out this incognito profile again") + dan <## "#team: joining the group..." dan <## ("#team: you joined the group incognito as " <> danIncognito) dan <### [ "#team: member alice (Alice) is connected", @@ -2421,10 +2135,6 @@ testGroupLinkIncognitoMembership = cath <## ("#team: " <> bobIncognito <> " added " <> danIncognito <> " to the group (connecting...)") cath <## ("#team: new member " <> danIncognito <> " is connected") ] - bob ?#> ("@" <> danIncognito <> " hi, I'm incognito") - dan ?<# (bobIncognito <> "> hi, I'm incognito") - dan ?#> ("@" <> bobIncognito <> " hey, me too") - bob ?<# (danIncognito <> "> hey, me too") alice #> "#team hello" concurrentlyN_ [ bob ?<# "#team alice> hello", @@ -2450,372 +2160,9 @@ testGroupLinkIncognitoMembership = cath <# ("#team " <> danIncognito <> "> how is it going?") ] -testGroupLinkUnusedHostContactDeleted :: HasCallStack => TestParams -> IO () -testGroupLinkUnusedHostContactDeleted = - testChatCfg2 cfg aliceProfile bobProfile $ - \alice bob -> do - -- create group 1 - threadDelay 100000 - alice ##> "/g team" - alice <## "group #team is created" - alice <## "to add members use /a team or /create link #team" - alice ##> "/create link #team" - gLinkTeam <- getGroupLink alice "team" GRMember True - bob ##> ("/c " <> gLinkTeam) - bob <## "connection request sent!" - alice <## "bob (Bob): accepting request to join group #team..." - concurrentlyN_ - [ do - alice <## "bob (Bob): contact is connected" - alice <## "bob invited to group #team via your group link" - alice <## "#team: bob joined the group", - do - bob <## "alice (Alice): contact is connected" - bob <## "#team: you joined the group" - ] - -- create group 2 - alice ##> "/g club" - alice <## "group #club is created" - alice <## "to add members use /a club or /create link #club" - alice ##> "/create link #club" - gLinkClub <- getGroupLink alice "club" GRMember True - bob ##> ("/c " <> gLinkClub) - bob <## "connection request sent!" - alice <## "bob_1 (Bob): accepting request to join group #club..." - concurrentlyN_ - [ alice - <### [ "bob_1 (Bob): contact is connected", - "contact bob_1 is merged into bob", - "use @bob to send messages", - EndsWith "invited to group #club via your group link", - EndsWith "joined the group" - ], - bob - <### [ "alice_1 (Alice): contact is connected", - "contact alice_1 is merged into alice", - "use @alice to send messages", - "#club: you joined the group" - ] - ] - -- list contacts - bob ##> "/contacts" - bob <## "alice (Alice)" - -- delete group 1, host contact and profile are kept - bobLeaveDeleteGroup alice bob "team" - bob ##> "/contacts" - bob <## "alice (Alice)" - bob `hasContactProfiles` ["alice", "bob"] - -- delete group 2, unused host contact and profile are deleted - bobLeaveDeleteGroup alice bob "club" - threadDelay 3000000 - bob ##> "/contacts" - (bob TestCC -> TestCC -> String -> IO () - bobLeaveDeleteGroup alice bob group = do - bob ##> ("/l " <> group) - concurrentlyN_ - [ do - bob <## ("#" <> group <> ": you left the group") - bob <## ("use /d #" <> group <> " to delete the group"), - alice <## ("#" <> group <> ": bob left the group") - ] - bob ##> ("/d #" <> group) - bob <## ("#" <> group <> ": you deleted the group") - -testGroupLinkIncognitoUnusedHostContactsDeleted :: HasCallStack => TestParams -> IO () -testGroupLinkIncognitoUnusedHostContactsDeleted = - testChatCfg2 cfg aliceProfile bobProfile $ - \alice bob -> do - bobIncognitoTeam <- createGroupBobIncognito alice bob "team" "alice" - bobIncognitoClub <- createGroupBobIncognito alice bob "club" "alice_1" - bobIncognitoTeam `shouldNotBe` bobIncognitoClub - -- list contacts - bob ##> "/contacts" - bob <## "i alice (Alice)" - bob <## "i alice_1 (Alice)" - bob `hasContactProfiles` ["alice", "alice", "bob", T.pack bobIncognitoTeam, T.pack bobIncognitoClub] - -- delete group 1, unused host contact and profile are deleted - bobLeaveDeleteGroup alice bob "team" bobIncognitoTeam - threadDelay 3000000 - bob ##> "/contacts" - bob <## "i alice_1 (Alice)" - bob `hasContactProfiles` ["alice", "bob", T.pack bobIncognitoClub] - -- delete group 2, unused host contact and profile are deleted - bobLeaveDeleteGroup alice bob "club" bobIncognitoClub - threadDelay 3000000 - bob ##> "/contacts" - (bob TestCC -> TestCC -> String -> String -> IO String - createGroupBobIncognito alice bob group bobsAliceContact = do - alice ##> ("/g " <> group) - alice <## ("group #" <> group <> " is created") - alice <## ("to add members use /a " <> group <> " or /create link #" <> group) - alice ##> ("/create link #" <> group) - gLinkTeam <- getGroupLink alice group GRMember True - bob ##> ("/c i " <> gLinkTeam) - bobIncognito <- getTermLine bob - bob <## "connection request sent incognito!" - alice <## (bobIncognito <> ": accepting request to join group #" <> group <> "...") - _ <- getTermLine bob - concurrentlyN_ - [ do - alice <## (bobIncognito <> ": contact is connected") - alice <## (bobIncognito <> " invited to group #" <> group <> " via your group link") - alice <## ("#" <> group <> ": " <> bobIncognito <> " joined the group"), - do - bob <## (bobsAliceContact <> " (Alice): contact is connected, your incognito profile for this contact is " <> bobIncognito) - bob <## ("use /i " <> bobsAliceContact <> " to print out this incognito profile again") - bob <## ("#" <> group <> ": you joined the group incognito as " <> bobIncognito) - ] - pure bobIncognito - bobLeaveDeleteGroup :: HasCallStack => TestCC -> TestCC -> String -> String -> IO () - bobLeaveDeleteGroup alice bob group bobIncognito = do - bob ##> ("/l " <> group) - concurrentlyN_ - [ do - bob <## ("#" <> group <> ": you left the group") - bob <## ("use /d #" <> group <> " to delete the group"), - alice <## ("#" <> group <> ": " <> bobIncognito <> " left the group") - ] - bob ##> ("/d #" <> group) - bob <## ("#" <> group <> ": you deleted the group") - -testGroupLinkMemberRole :: HasCallStack => TestParams -> IO () -testGroupLinkMemberRole = - testChatCfg3 testCfgGroupLinkViaContact aliceProfile bobProfile cathProfile $ - \alice bob cath -> do - threadDelay 100000 - alice ##> "/g team" - alice <## "group #team is created" - alice <## "to add members use /a team or /create link #team" - alice ##> "/create link #team admin" - alice <## "#team: initial role for group member cannot be admin, use member or observer" - alice ##> "/create link #team observer" - gLink <- getGroupLink alice "team" GRObserver True - bob ##> ("/c " <> gLink) - bob <## "connection request sent!" - alice <## "bob (Bob): accepting request to join group #team..." - concurrentlyN_ - [ do - alice <## "bob (Bob): contact is connected" - alice <## "bob invited to group #team via your group link" - alice <## "#team: bob joined the group", - do - bob <## "alice (Alice): contact is connected" - bob <## "#team: you joined the group" - ] - alice ##> "/set link role #team admin" - alice <## "#team: initial role for group member cannot be admin, use member or observer" - alice ##> "/set link role #team member" - _ <- getGroupLink alice "team" GRMember False - cath ##> ("/c " <> gLink) - cath <## "connection request sent!" - alice <## "cath (Catherine): accepting request to join group #team..." - -- if contact existed it is merged - concurrentlyN_ - [ alice - <### [ "cath (Catherine): contact is connected", - EndsWith "invited to group #team via your group link", - EndsWith "joined the group" - ], - cath - <### [ "alice (Alice): contact is connected", - "#team: you joined the group", - "#team: member bob (Bob) is connected" - ], - do - bob <## "#team: alice added cath (Catherine) to the group (connecting...)" - bob <## "#team: new member cath is connected" - ] - alice #> "#team hello" - concurrently_ - (bob <# "#team alice> hello") - (cath <# "#team alice> hello") - cath #> "#team hello too" - concurrently_ - (alice <# "#team cath> hello too") - (bob <# "#team cath> hello too") - bob ##> "#team hey" - bob <## "#team: you don't have permission to send messages" - alice ##> "/mr #team bob member" - alice <## "#team: you changed the role of bob from observer to member" - concurrently_ - (bob <## "#team: alice changed your role from observer to member") - (cath <## "#team: alice changed the role of bob from observer to member") - bob #> "#team hey now" - concurrently_ - (alice <# "#team bob> hey now") - (cath <# "#team bob> hey now") - -testGroupLinkLeaveDelete :: HasCallStack => TestParams -> IO () -testGroupLinkLeaveDelete = - testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ - \alice bob cath -> do - connectUsers alice bob - connectUsers cath bob - alice ##> "/g team" - alice <## "group #team is created" - alice <## "to add members use /a team or /create link #team" - alice ##> "/create link #team" - gLink <- getGroupLink alice "team" GRMember True - bob ##> ("/c " <> gLink) - bob <## "connection request sent!" - alice <## "bob_1 (Bob): accepting request to join group #team..." - concurrentlyN_ - [ alice - <### [ "bob_1 (Bob): contact is connected", - "contact bob_1 is merged into bob", - "use @bob to send messages", - EndsWith "invited to group #team via your group link", - EndsWith "joined the group" - ], - bob - <### [ "alice_1 (Alice): contact is connected", - "contact alice_1 is merged into alice", - "use @alice to send messages", - "#team: you joined the group" - ] - ] - cath ##> ("/c " <> gLink) - cath <## "connection request sent!" - alice <## "cath (Catherine): accepting request to join group #team..." - concurrentlyN_ - [ alice - <### [ "cath (Catherine): contact is connected", - "cath invited to group #team via your group link", - "#team: cath joined the group" - ], - cath - <### [ "alice (Alice): contact is connected", - "#team: you joined the group", - "#team: member bob_1 (Bob) is connected", - "contact bob_1 is merged into bob", - "use @bob to send messages" - ], - bob - <### [ "#team: alice added cath_1 (Catherine) to the group (connecting...)", - "#team: new member cath_1 is connected", - "contact cath_1 is merged into cath", - "use @cath to send messages" - ] - ] - bob ##> "/l team" - concurrentlyN_ - [ do - bob <## "#team: you left the group" - bob <## "use /d #team to delete the group", - alice <## "#team: bob left the group", - cath <## "#team: bob left the group" - ] - bob ##> "/contacts" - bob <## "alice (Alice)" - bob <## "cath (Catherine)" - bob ##> "/d #team" - bob <## "#team: you deleted the group" - bob ##> "/contacts" - bob <## "alice (Alice)" - bob <## "cath (Catherine)" - -testPlanGroupLinkOkKnown :: HasCallStack => TestParams -> IO () -testPlanGroupLinkOkKnown = - testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $ - \alice bob -> do - threadDelay 100000 - alice ##> "/g team" - alice <## "group #team is created" - alice <## "to add members use /a team or /create link #team" - alice ##> "/create link #team" - gLink <- getGroupLink alice "team" GRMember True - - bob ##> ("/_connect plan 1 " <> gLink) - bob <## "group link: ok to connect" - - bob ##> ("/c " <> gLink) - bob <## "connection request sent!" - alice <## "bob (Bob): accepting request to join group #team..." - concurrentlyN_ - [ do - alice <## "bob (Bob): contact is connected" - alice <## "bob invited to group #team via your group link" - alice <## "#team: bob joined the group", - do - bob <## "alice (Alice): contact is connected" - bob <## "#team: you joined the group" - ] - alice #> "#team hi" - bob <# "#team alice> hi" - bob #> "#team hey" - alice <# "#team bob> hey" - - bob ##> ("/_connect plan 1 " <> gLink) - bob <## "group link: known group #team" - bob <## "use #team to send messages" - - let gLinkSchema2 = linkAnotherSchema gLink - bob ##> ("/_connect plan 1 " <> gLinkSchema2) - bob <## "group link: known group #team" - bob <## "use #team to send messages" - - bob ##> ("/c " <> gLink) - bob <## "group link: known group #team" - bob <## "use #team to send messages" - -testPlanHostContactDeletedGroupLinkKnown :: HasCallStack => TestParams -> IO () -testPlanHostContactDeletedGroupLinkKnown = - testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $ - \alice bob -> do - threadDelay 100000 - alice ##> "/g team" - alice <## "group #team is created" - alice <## "to add members use /a team or /create link #team" - alice ##> "/create link #team" - gLink <- getGroupLink alice "team" GRMember True - - bob ##> ("/c " <> gLink) - bob <## "connection request sent!" - alice <## "bob (Bob): accepting request to join group #team..." - concurrentlyN_ - [ do - alice <## "bob (Bob): contact is connected" - alice <## "bob invited to group #team via your group link" - alice <## "#team: bob joined the group", - do - bob <## "alice (Alice): contact is connected" - bob <## "#team: you joined the group" - ] - alice #> "#team hi" - bob <# "#team alice> hi" - bob #> "#team hey" - alice <# "#team bob> hey" - - alice <##> bob - threadDelay 500000 - bob ##> "/d alice" - bob <## "alice: contact is deleted" - alice <## "bob (Bob) deleted contact with you" - - bob ##> ("/_connect plan 1 " <> gLink) - bob <## "group link: known group #team" - bob <## "use #team to send messages" - - let gLinkSchema2 = linkAnotherSchema gLink - bob ##> ("/_connect plan 1 " <> gLinkSchema2) - bob <## "group link: known group #team" - bob <## "use #team to send messages" - - bob ##> ("/c " <> gLink) - bob <## "group link: known group #team" - bob <## "use #team to send messages" - testPlanGroupLinkOwn :: HasCallStack => TestParams -> IO () testPlanGroupLinkOwn ps = - withNewTestChatCfg ps (mkCfgGroupLinkViaContact testCfgSlow) "alice" aliceProfile $ \alice -> do + withNewTestChat ps "alice" aliceProfile $ \alice -> do threadDelay 100000 alice ##> "/g team" alice <## "group #team is created" @@ -2834,18 +2181,14 @@ testPlanGroupLinkOwn ps = alice <## "connection request sent!" alice <## "alice_1 (Alice): accepting request to join group #team..." alice - <### [ "alice_1 (Alice): contact is connected", - "alice_1 invited to group #team via your group link", - "#team: alice_1 joined the group", - "alice_2 (Alice): contact is connected", - "#team_1: you joined the group", - "contact alice_2 is merged into alice_1", - "use @alice_1 to send messages" + <### [ "#team: alice_1 joined the group", + "#team_1: joining the group...", + "#team_1: you joined the group" ] alice `send` "#team 1" alice <### [ WithTime "#team 1", - WithTime "#team_1 alice_1> 1" + WithTime "#team_1 alice_2> 1" ] alice `send` "#team_1 2" alice @@ -2859,71 +2202,9 @@ testPlanGroupLinkOwn ps = alice ##> ("/_connect plan 1 " <> gLinkSchema2) alice <## "group link: own link for group #team" - -- group works if merged contact is deleted - alice ##> "/d alice_1" - alice <## "alice_1: contact is deleted" - - alice `send` "#team 3" - alice - <### [ WithTime "#team 3", - WithTime "#team_1 alice_1> 3" - ] - alice `send` "#team_1 4" - alice - <### [ WithTime "#team_1 4", - WithTime "#team alice_1> 4" - ] - -testPlanGroupLinkConnecting :: HasCallStack => TestParams -> IO () -testPlanGroupLinkConnecting ps = do - -- gLink <- withNewTestChatCfg ps cfg "alice" aliceProfile $ \alice -> do - gLink <- withNewTestChatCfg ps cfg "alice" aliceProfile $ \alice -> do - threadDelay 100000 - alice ##> "/g team" - alice <## "group #team is created" - alice <## "to add members use /a team or /create link #team" - alice ##> "/create link #team" - getGroupLink alice "team" GRMember True - -- withNewTestChatCfg ps cfg "bob" bobProfile $ \bob -> do - withNewTestChatCfg ps cfg "bob" bobProfile $ \bob -> do - threadDelay 100000 - - bob ##> ("/c " <> gLink) - bob <## "connection request sent!" - - bob ##> ("/_connect plan 1 " <> gLink) - bob <## "group link: connecting, allowed to reconnect" - - let gLinkSchema2 = linkAnotherSchema gLink - bob ##> ("/_connect plan 1 " <> gLinkSchema2) - bob <## "group link: connecting, allowed to reconnect" - - threadDelay 100000 - -- withTestChatCfg ps cfg "alice" $ \alice -> do - withTestChatCfg ps cfg "alice" $ \alice -> do - alice - <### [ "1 group links active", - "#team: group is empty", - "bob (Bob): accepting request to join group #team..." - ] - -- withTestChatCfg ps cfg "bob" $ \bob -> do - withTestChatCfg ps cfg "bob" $ \bob -> do - threadDelay 500000 - bob ##> ("/_connect plan 1 " <> gLink) - bob <## "group link: connecting" - - let gLinkSchema2 = linkAnotherSchema gLink - bob ##> ("/_connect plan 1 " <> gLinkSchema2) - bob <## "group link: connecting" - - bob ##> ("/c " <> gLink) - bob <## "group link: connecting" - where - cfg = mkCfgGroupLinkViaContact testCfgSlow - testPlanGroupLinkLeaveRejoin :: HasCallStack => TestParams -> IO () testPlanGroupLinkLeaveRejoin = - testChatCfg2 testCfgGroupLinkViaContact aliceProfile bobProfile $ + testChat2 aliceProfile bobProfile $ \alice bob -> do threadDelay 100000 alice ##> "/g team" @@ -2936,12 +2217,9 @@ testPlanGroupLinkLeaveRejoin = bob <## "connection request sent!" alice <## "bob (Bob): accepting request to join group #team..." concurrentlyN_ - [ do - alice <## "bob (Bob): contact is connected" - alice <## "bob invited to group #team via your group link" - alice <## "#team: bob joined the group", + [ alice <## "#team: bob joined the group", do - bob <## "alice (Alice): contact is connected" + bob <## "#team: joining the group..." bob <## "#team: you joined the group" ] @@ -2978,25 +2256,17 @@ testPlanGroupLinkLeaveRejoin = bob <## "connection request sent!" alice <## "bob_1 (Bob): accepting request to join group #team..." concurrentlyN_ - [ alice - <### [ "bob_1 (Bob): contact is connected", - EndsWith "invited to group #team via your group link", - EndsWith "joined the group", - "contact bob_1 is merged into bob", - "use @bob to send messages" - ], + [ alice <## "#team: bob_1 joined the group", bob - <### [ "alice_1 (Alice): contact is connected", - "#team_1: you joined the group", - "contact alice_1 is merged into alice", - "use @alice to send messages" + <### [ "#team_1: joining the group...", + "#team_1: you joined the group" ] ] alice #> "#team hi" - bob <# "#team_1 alice> hi" + bob <# "#team_1 alice_1> hi" bob #> "#team_1 hey" - alice <# "#team bob> hey" + alice <# "#team bob_1> hey" bob ##> ("/_connect plan 1 " <> gLink) bob <## "group link: known group #team_1" @@ -3010,8 +2280,8 @@ testPlanGroupLinkLeaveRejoin = bob <## "group link: known group #team_1" bob <## "use #team_1 to send messages" -testGroupLinkNoContact :: HasCallStack => TestParams -> IO () -testGroupLinkNoContact = +testGroupLink :: HasCallStack => TestParams -> IO () +testGroupLink = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do threadDelay 100000 @@ -3048,16 +2318,34 @@ testGroupLinkNoContact = bob #> "#team hi there" alice <# "#team bob> hi there" + -- user address doesn't interfere + alice ##> "/ad" + cLink <- getContactLink alice True + cath ##> ("/c " <> cLink) + alice <#? cath + alice ##> "/ac cath" + alice <## "cath (Catherine): accepting contact request, you can send messages to contact" + concurrently_ + (cath <## "alice (Alice): contact is connected") + (alice <## "cath (Catherine): contact is connected") + alice <##> cath + + -- third member cath ##> ("/c " <> gLink) cath <## "connection request sent!" concurrentlyN_ [ do - alice <## "cath (Catherine): accepting request to join group #team..." - alice <## "#team: cath joined the group", - do - cath <## "#team: joining the group..." - cath <## "#team: you joined the group" - cath <## "#team: member bob (Bob) is connected", + alice <## "cath_1 (Catherine): accepting request to join group #team..." + alice <## "#team: cath_1 joined the group" + alice <## "contact and member are merged: cath, #team cath_1" + alice <## "use @cath to send messages", + cath + <### [ "#team: joining the group...", + "#team: you joined the group", + "#team: member bob (Bob) is connected", + "contact and member are merged: alice, #team alice_1", + "use @alice to send messages" + ], do bob <## "#team: alice added cath (Catherine) to the group (connecting...)" bob <## "#team: new member cath is connected" @@ -3071,8 +2359,28 @@ testGroupLinkNoContact = alice <# "#team bob> hi cath" cath <# "#team bob> hi cath" -testGroupLinkNoContactInviteesWereConnected :: HasCallStack => TestParams -> IO () -testGroupLinkNoContactInviteesWereConnected = + -- leaving group removes link + alice ##> "/l team" + concurrentlyN_ + [ do + alice <## "#team: you left the group" + alice <## "use /d #team to delete the group", + bob <## "#team: alice left the group", + cath <## "#team: alice left the group" + ] + alice ##> "/show link #team" + alice <## "no group link, to create: /create link #team" + + -- deleting group keeps contacts + alice ##> "/contacts" + alice <## "cath (Catherine)" + alice ##> "/d #team" + alice <## "#team: you deleted the group" + alice ##> "/contacts" + alice <## "cath (Catherine)" + +testGroupLinkInviteesWereConnected :: HasCallStack => TestParams -> IO () +testGroupLinkInviteesWereConnected = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do connectUsers bob cath @@ -3143,8 +2451,8 @@ testGroupLinkNoContactInviteesWereConnected = cath #> "#team 3" [alice, bob] *<# "#team cath> 3" -testGroupLinkNoContactAllMembersWereConnected :: HasCallStack => TestParams -> IO () -testGroupLinkNoContactAllMembersWereConnected = +testGroupLinkAllMembersWereConnected :: HasCallStack => TestParams -> IO () +testGroupLinkAllMembersWereConnected = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do connectUsers alice bob @@ -3234,8 +2542,8 @@ testGroupLinkNoContactAllMembersWereConnected = cath #> "#team 3" [alice, bob] *<# "#team cath> 3" -testGroupLinkNoContactMemberRole :: HasCallStack => TestParams -> IO () -testGroupLinkNoContactMemberRole = +testGroupLinkMemberRole :: HasCallStack => TestParams -> IO () +testGroupLinkMemberRole = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do threadDelay 100000 @@ -3315,8 +2623,8 @@ testGroupLinkNoContactMemberRole = bob <## "#team: cath changed your role from member to admin" alice <## "#team: cath changed the role of bob from member to admin" -testGroupLinkNoContactHostIncognito :: HasCallStack => TestParams -> IO () -testGroupLinkNoContactHostIncognito = +testGroupLinkHostIncognito :: HasCallStack => TestParams -> IO () +testGroupLinkHostIncognito = testChat2 aliceProfile bobProfile $ \alice bob -> do alice ##> "/g i team" @@ -3348,8 +2656,8 @@ testGroupLinkNoContactHostIncognito = bob #> "#team hi there" alice ?<# "#team bob> hi there" -testGroupLinkNoContactInviteeIncognito :: HasCallStack => TestParams -> IO () -testGroupLinkNoContactInviteeIncognito = +testGroupLinkInviteeIncognito :: HasCallStack => TestParams -> IO () +testGroupLinkInviteeIncognito = testChat2 aliceProfile bobProfile $ \alice bob -> do threadDelay 100000 @@ -3382,8 +2690,8 @@ testGroupLinkNoContactInviteeIncognito = bob ?#> "#team hi there" alice <# ("#team " <> bobIncognito <> "> hi there") -testGroupLinkNoContactHostProfileReceived :: HasCallStack => TestParams -> IO () -testGroupLinkNoContactHostProfileReceived = +testGroupLinkHostProfileReceived :: HasCallStack => TestParams -> IO () +testGroupLinkHostProfileReceived = testChat2 aliceProfile bobProfile $ \alice bob -> do let profileImage = "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=" @@ -3410,8 +2718,8 @@ testGroupLinkNoContactHostProfileReceived = aliceImage <- getProfilePictureByName bob "alice" aliceImage `shouldBe` Just profileImage -testGroupLinkNoContactExistingContactMerged :: HasCallStack => TestParams -> IO () -testGroupLinkNoContactExistingContactMerged = +testGroupLinkExistingContactMerged :: HasCallStack => TestParams -> IO () +testGroupLinkExistingContactMerged = testChat2 aliceProfile bobProfile $ \alice bob -> do connectUsers alice bob @@ -3453,8 +2761,8 @@ testGroupLinkNoContactExistingContactMerged = bob #> "#team hi there" alice <# "#team bob> hi there" -testPlanGroupLinkNoContactKnown :: HasCallStack => TestParams -> IO () -testPlanGroupLinkNoContactKnown = +testPlanGroupLinkKnown :: HasCallStack => TestParams -> IO () +testPlanGroupLinkKnown = testChat2 aliceProfile bobProfile $ \alice bob -> do threadDelay 100000 @@ -3490,8 +2798,8 @@ testPlanGroupLinkNoContactKnown = bob <## "group link: known group #team" bob <## "use #team to send messages" -testPlanGroupLinkNoContactConnecting :: HasCallStack => TestParams -> IO () -testPlanGroupLinkNoContactConnecting ps = do +testPlanGroupLinkConnecting :: HasCallStack => TestParams -> IO () +testPlanGroupLinkConnecting ps = do gLink <- withNewTestChat ps "alice" aliceProfile $ \alice -> do threadDelay 100000 alice ##> "/g team" @@ -3537,8 +2845,8 @@ testPlanGroupLinkNoContactConnecting ps = do bob <## "group link: known group #team" bob <## "use #team to send messages" -testPlanGroupLinkNoContactConnectingSlow :: HasCallStack => TestParams -> IO () -testPlanGroupLinkNoContactConnectingSlow ps = do +testPlanGroupLinkConnectingSlow :: HasCallStack => TestParams -> IO () +testPlanGroupLinkConnectingSlow ps = do gLink <- withNewTestChatCfg ps testCfgSlow "alice" aliceProfile $ \alice -> do threadDelay 100000 alice ##> "/g team" @@ -3873,14 +3181,10 @@ testConfigureGroupDeliveryReceipts ps = [ alice <## "#club: cath joined the group", do cath <## "#club: you joined the group" - cath <## "#club: member bob_1 (Bob) is connected" - cath <## "contact bob_1 is merged into bob" - cath <## "use @bob to send messages", + cath <## "#club: member bob_1 (Bob) is connected", do bob <## "#club: alice added cath_1 (Catherine) to the group (connecting...)" bob <## "#club: new member cath_1 is connected" - bob <## "contact cath_1 is merged into cath" - bob <## "use @cath to send messages" ] threadDelay 1000000 @@ -3957,54 +3261,33 @@ testConfigureGroupDeliveryReceipts ps = receipt bob alice cath "team" "25" noReceipt bob alice cath "club" "26" where - cfg = mkCfgCreateGroupDirect $ testCfg {showReceipts = True} + cfg = testCfg {showReceipts = True} receipt cc1 cc2 cc3 gName msg = do - name1 <- userName cc1 cc1 #> ("#" <> gName <> " " <> msg) - cc2 <# ("#" <> gName <> " " <> name1 <> "> " <> msg) - cc3 <# ("#" <> gName <> " " <> name1 <> "> " <> msg) + cc2 .<## ("> " <> msg) + cc3 .<## ("> " <> msg) cc1 % ("#" <> gName <> " " <> msg) cc1 ⩗ ("#" <> gName <> " " <> msg) partialReceipt cc1 cc2 cc3 gName msg = do - name1 <- userName cc1 cc1 #> ("#" <> gName <> " " <> msg) - cc2 <# ("#" <> gName <> " " <> name1 <> "> " <> msg) - cc3 <# ("#" <> gName <> " " <> name1 <> "> " <> msg) + cc2 .<## ("> " <> msg) + cc3 .<## ("> " <> msg) cc1 % ("#" <> gName <> " " <> msg) noReceipt cc1 cc2 cc3 gName msg = do - name1 <- userName cc1 cc1 #> ("#" <> gName <> " " <> msg) - cc2 <# ("#" <> gName <> " " <> name1 <> "> " <> msg) - cc3 <# ("#" <> gName <> " " <> name1 <> "> " <> msg) + cc2 .<## ("> " <> msg) + cc3 .<## ("> " <> msg) cc1 VersionRangeChat -> VersionRangeChat -> VersionRangeChat -> Bool -> TestParams -> IO () -testNoGroupDirectConns hostVRange mem2VRange mem3VRange noDirectConns ps = - withNewTestChatCfg ps testCfg {chatVRange = hostVRange} "alice" aliceProfile $ \alice -> do - withNewTestChatCfg ps testCfg {chatVRange = mem2VRange} "bob" bobProfile $ \bob -> do - withNewTestChatCfg ps testCfg {chatVRange = mem3VRange} "cath" cathProfile $ \cath -> do - createGroup3 "team" alice bob cath - if noDirectConns - then contactsDontExist bob cath - else contactsExist bob cath - where - contactsDontExist bob cath = do +testNoGroupDirectConns :: HasCallStack => TestParams -> IO () +testNoGroupDirectConns = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + createGroup3 "team" alice bob cath bob ##> "/contacts" bob <## "alice (Alice)" cath ##> "/contacts" cath <## "alice (Alice)" - contactsExist bob cath = do - bob ##> "/contacts" - bob - <### [ "alice (Alice)", - "cath (Catherine)" - ] - cath ##> "/contacts" - cath - <### [ "alice (Alice)", - "bob (Bob)" - ] - bob <##> cath testNoDirectDifferentLDNs :: HasCallStack => TestParams -> IO () testNoDirectDifferentLDNs = @@ -4194,7 +3477,7 @@ testMergeContactMultipleMembers = testMergeGroupLinkHostMultipleContacts :: HasCallStack => TestParams -> IO () testMergeGroupLinkHostMultipleContacts = - testChatCfg2 testCfgGroupLinkViaContact bobProfile cathProfile $ + testChat2 bobProfile cathProfile $ \bob cath -> do connectUsers bob cath @@ -4219,16 +3502,14 @@ testMergeGroupLinkHostMultipleContacts = bob <## "cath_2 (Catherine): accepting request to join group #party..." concurrentlyN_ [ bob - <### [ "cath_2 (Catherine): contact is connected", - EndsWith "invited to group #party via your group link", - EndsWith "joined the group", - StartsWith "contact cath_2 is merged into cath", + <### [ EndsWith "joined the group", + "contact and member are merged: cath, #party cath_2", StartsWith "use @cath" ], cath - <### [ "bob_2 (Bob): contact is connected", + <### [ "#party: joining the group...", "#party: you joined the group", - StartsWith "contact bob_2 is merged into bob", + "contact and member are merged: bob, #party bob_2", StartsWith "use @bob" ] ] @@ -4442,7 +3723,7 @@ testMemberContactInvitedConnectionReplaced ps = do testMemberContactIncognito :: HasCallStack => TestParams -> IO () testMemberContactIncognito = - testChatCfg3 testCfgGroupLinkViaContact aliceProfile bobProfile cathProfile $ + testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do -- create group, bob joins incognito threadDelay 100000 @@ -4455,15 +3736,10 @@ testMemberContactIncognito = bobIncognito <- getTermLine bob bob <## "connection request sent incognito!" alice <## (bobIncognito <> ": accepting request to join group #team...") - _ <- getTermLine bob concurrentlyN_ - [ do - alice <## (bobIncognito <> ": contact is connected") - alice <## (bobIncognito <> " invited to group #team via your group link") - alice <## ("#team: " <> bobIncognito <> " joined the group"), + [ alice <## ("#team: " <> bobIncognito <> " joined the group"), do - bob <## ("alice (Alice): contact is connected, your incognito profile for this contact is " <> bobIncognito) - bob <## "use /i alice to print out this incognito profile again" + bob <## "#team: joining the group..." bob <## ("#team: you joined the group incognito as " <> bobIncognito) ] -- cath joins incognito @@ -4471,15 +3747,10 @@ testMemberContactIncognito = cathIncognito <- getTermLine cath cath <## "connection request sent incognito!" alice <## (cathIncognito <> ": accepting request to join group #team...") - _ <- getTermLine cath concurrentlyN_ - [ do - alice <## (cathIncognito <> ": contact is connected") - alice <## (cathIncognito <> " invited to group #team via your group link") - alice <## ("#team: " <> cathIncognito <> " joined the group"), + [ alice <## ("#team: " <> cathIncognito <> " joined the group"), do - cath <## ("alice (Alice): contact is connected, your incognito profile for this contact is " <> cathIncognito) - cath <## "use /i alice to print out this incognito profile again" + cath <## "#team: joining the group..." cath <## ("#team: you joined the group incognito as " <> cathIncognito) cath <## ("#team: member " <> bobIncognito <> " is connected"), do @@ -4641,6 +3912,12 @@ testRecreateMemberContactManyGroups = bob ##> "/d alice" bob <## "alice: contact is deleted" + -- group messages work + alice #> "#team hello" + bob <# "#team alice> hello" + bob #> "#team hi there" + alice <# "#team bob> hi there" + -- alice creates member contact with bob alice ##> "@#team bob hi" alice @@ -6837,6 +6114,6 @@ testUpdatedMentionNames = do let (mc', _, _) = updatedMentionNames (MCText t) (parseMaybeMarkdownList t) mentions in msgContentText mc' mm = M.fromList . map (second mentionedMember) - mentionedMember name_ = CIMention {memberId = MemberId "abcd", memberRef = memberInfo <$> name_} + mentionedMember name_ = CIMention {memberId = MemberId "abcd", memberRef = ciMentionMember <$> name_} where - memberInfo name = CIMentionMember {groupMemberId = 1, displayName = name, localAlias = Nothing, memberRole = GRMember} + ciMentionMember name = CIMentionMember {groupMemberId = 1, displayName = name, localAlias = Nothing, memberRole = GRMember} diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index f12f7276fd..ffdd84406c 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -104,9 +104,11 @@ chatProfileTests = do testUpdateProfile :: HasCallStack => TestParams -> IO () testUpdateProfile = - testChatCfg3 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile $ + testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do - createGroup3 "team" alice bob cath + connectUsers alice bob + connectUsers alice cath + connectUsers bob cath alice ##> "/p" alice <## "user profile: alice (Alice)" alice <## "use /p to change it" @@ -1451,7 +1453,7 @@ testSetResetSetConnectionIncognito = testChat2 aliceProfile bobProfile $ testJoinGroupIncognito :: HasCallStack => TestParams -> IO () testJoinGroupIncognito = - testChatCfg4 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile danProfile $ + testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do -- non incognito connections connectUsers alice bob @@ -1526,13 +1528,13 @@ testJoinGroupIncognito = dan <### [ ConsoleString $ "#secret_club: member " <> cathIncognito <> " is connected", "#secret_club: member bob_1 (Bob) is connected", - "contact bob_1 is merged into bob", + "contact and member are merged: bob, #secret_club bob_1", "use @bob to send messages" ], do bob <## "#secret_club: alice added dan_1 (Daniel) to the group (connecting...)" bob <## "#secret_club: new member dan_1 is connected" - bob <## "contact dan_1 is merged into dan" + bob <## "contact and member are merged: dan, #secret_club dan_1" bob <## "use @dan to send messages", do cath <## "#secret_club: alice added dan_1 (Daniel) to the group (connecting...)" @@ -1563,17 +1565,7 @@ testJoinGroupIncognito = bob <# "#secret_club dan> how is it going?", cath ?<# "#secret_club dan_1> how is it going?" ] - -- cath and bob can send messages via new direct connection, cath is incognito - bob #> ("@" <> cathIncognito <> " hi, I'm bob") - cath ?<# "bob_1> hi, I'm bob" - cath ?#> "@bob_1 hey, I'm incognito" - bob <# (cathIncognito <> "> hey, I'm incognito") - -- cath and dan can send messages via new direct connection, cath is incognito - dan #> ("@" <> cathIncognito <> " hi, I'm dan") - cath ?<# "dan_1> hi, I'm dan" - cath ?#> "@dan_1 hey, I'm incognito" - dan <# (cathIncognito <> "> hey, I'm incognito") - -- non incognito connections are separate + -- non incognito direct connections are separate bob <##> cath dan <##> cath -- list groups @@ -1632,11 +1624,6 @@ testJoinGroupIncognito = ] cath ##> "#secret_club hello" cath <## "you are no longer a member of the group" - -- cath can still message members directly - bob #> ("@" <> cathIncognito <> " I removed you from group") - cath ?<# "bob_1> I removed you from group" - cath ?#> "@bob_1 ok" - bob <# (cathIncognito <> "> ok") testCantInviteContactIncognito :: HasCallStack => TestParams -> IO () testCantInviteContactIncognito = testChat2 aliceProfile bobProfile $ @@ -2205,7 +2192,7 @@ testAllowFullDeletionGroup = testProhibitDirectMessages :: HasCallStack => TestParams -> IO () testProhibitDirectMessages = - testChatCfg4 testCfgCreateGroupDirect aliceProfile bobProfile cathProfile danProfile $ + testChat4 aliceProfile bobProfile cathProfile danProfile $ \alice bob cath dan -> do createGroup3 "team" alice bob cath threadDelay 1000000 @@ -2221,7 +2208,7 @@ testProhibitDirectMessages = alice #> "@cath hello again" cath <# "alice> hello again" bob ##> "@cath hello again" - bob <## "direct messages to indirect contact cath are prohibited" + bob <## "bad chat command: direct messages not allowed" (cath "@dan hi" - alice <## "direct messages to indirect contact dan are prohibited" + alice <## "bad chat command: direct messages not allowed" bob ##> "@dan hi" - bob <## "direct messages to indirect contact dan are prohibited" + bob <## "bad chat command: direct messages not allowed" (dan "@alice hi" - dan <## "direct messages to indirect contact alice are prohibited" + dan <## "bad chat command: direct messages not allowed" dan ##> "@bob hi" - dan <## "direct messages to indirect contact bob are prohibited" + dan <## "bad chat command: direct messages not allowed" dan #> "@cath hi" cath <# "dan> hi" cath #> "@dan hi" diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index 9cb8439500..a6eab378d9 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -361,6 +361,13 @@ cc <#. line = do unless prefix $ print ("expected to start from: " <> line, ", got: " <> l) prefix `shouldBe` True +(.<#) :: HasCallStack => TestCC -> String -> Expectation +cc .<# line = do + l <- dropTime <$> getTermLine cc + let suffix = line `isSuffixOf` l + unless suffix $ print ("expected to end with: " <> line, ", got: " <> l) + suffix `shouldBe` True + (<##..) :: HasCallStack => TestCC -> [String] -> Expectation cc <##.. ls = do l <- getTermLine cc diff --git a/tests/SchemaDump.hs b/tests/SchemaDump.hs index a2dde191cb..c791c8bdac 100644 --- a/tests/SchemaDump.hs +++ b/tests/SchemaDump.hs @@ -103,7 +103,8 @@ testSchemaMigrations = withTmpFiles $ do schema <- getSchema testDB testSchema Migrations.run st True $ MTRUp [m] schema' <- getSchema testDB testSchema - schema' `shouldNotBe` schema + unless (name m `elem` skipComparisonForUpMigrations) $ + schema' `shouldNotBe` schema Migrations.run st True $ MTRDown [downMigr] unless (name m `elem` skipComparisonForDownMigrations) $ do schema'' <- getSchema testDB testSchema @@ -112,6 +113,12 @@ testSchemaMigrations = withTmpFiles $ do schema''' <- getSchema testDB testSchema schema''' `shouldBe` schema' +skipComparisonForUpMigrations :: [String] +skipComparisonForUpMigrations = + [ -- schema doesn't change + "20250129_delete_unused_contacts" + ] + skipComparisonForDownMigrations :: [String] skipComparisonForDownMigrations = [ -- on down migration msg_delivery_events table moves down to the end of the file