From 41e873d5ca41217953adf5fe758efe8831d67e0a Mon Sep 17 00:00:00 2001 From: JRoberts <8711996+jr-simplex@users.noreply.github.com> Date: Wed, 11 Jan 2023 11:00:28 +0400 Subject: [PATCH] core: multiple users view, tests (#1710) --- src/Simplex/Chat/Store.hs | 1 + src/Simplex/Chat/Types.hs | 2 +- src/Simplex/Chat/View.hs | 213 +++++++++++++++++++------------------- tests/ChatTests.hs | 154 ++++++++++++++++++++++++++- 4 files changed, 263 insertions(+), 107 deletions(-) diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index e4a43bd73d..0e6d302044 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -423,6 +423,7 @@ createUser :: DB.Connection -> Profile -> Bool -> ExceptT StoreError IO User createUser db Profile {displayName, fullName, image, preferences = userPreferences} activeUser = checkConstraint SEDuplicateName . liftIO $ do currentTs <- getCurrentTime + when activeUser $ DB.execute_ db "UPDATE users SET active_user = 0" DB.execute db "INSERT INTO users (local_display_name, active_user, contact_id, created_at, updated_at) VALUES (?,?,0,?,?)" diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 1e34018551..da9e0411f5 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -88,7 +88,7 @@ data User = User fullPreferences :: FullPreferences, activeUser :: Bool } - deriving (Show, Generic, FromJSON) + deriving (Eq, Show, Generic, FromJSON) instance ToJSON User where toEncoding = J.genericToEncoding J.defaultOptions diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 73ec7eb7e3..98979dd620 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -64,31 +64,31 @@ responseToView user_ testView liveItems ts = \case CRChatRunning -> ["chat is running"] CRChatStopped -> ["chat stopped"] CRChatSuspended -> ["chat suspended"] - CRApiChats _u chats -> if testView then testViewChats chats else [plain . bshow $ J.encode chats] - CRApiChat _u chat -> if testView then testViewChat chat else [plain . bshow $ J.encode chat] + CRApiChats u chats -> withOtherUser u $ if testView then testViewChats chats else [plain . bshow $ J.encode chats] + CRApiChat u chat -> withOtherUser u $ if testView then testViewChat chat else [plain . bshow $ J.encode chat] CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft] - CRUserSMPServers _u smpServers _ -> viewSMPServers (L.toList smpServers) testView + CRUserSMPServers u smpServers _ -> withOtherUser u $ viewSMPServers (L.toList smpServers) testView CRSmpTestResult testFailure -> viewSMPTestResult testFailure - CRChatItemTTL _u ttl -> viewChatItemTTL ttl + CRChatItemTTL u ttl -> withOtherUser u $ viewChatItemTTL ttl CRNetworkConfig cfg -> viewNetworkConfig cfg - CRContactInfo _u ct cStats customUserProfile -> viewContactInfo ct cStats customUserProfile - CRGroupMemberInfo _u g m cStats -> viewGroupMemberInfo g m cStats - CRContactSwitch _u ct progress -> viewContactSwitch ct progress - CRGroupMemberSwitch _u g m progress -> viewGroupMemberSwitch g m progress - CRConnectionVerified _u verified code -> [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code] - CRContactCode _u ct code -> viewContactCode ct code testView - CRGroupMemberCode _u g m code -> viewGroupMemberCode g m code testView - CRNewChatItem _u (AChatItem _ _ chat item) -> unmuted chat item $ viewChatItem chat item False ts - CRChatItems _u chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems - CRChatItemId _u itemId -> [plain $ maybe "no item" show itemId] - CRChatItemStatusUpdated _u _ -> [] - CRChatItemUpdated _u (AChatItem _ _ chat item) -> unmuted chat item $ viewItemUpdate chat item liveItems ts - CRChatItemDeleted _u (AChatItem _ _ chat deletedItem) toItem byUser timed -> unmuted chat deletedItem $ viewItemDelete chat deletedItem (isJust toItem) byUser timed ts - CRChatItemDeletedNotFound _u Contact {localDisplayName = c} _ -> [ttyFrom $ c <> "> [deleted - original message not found]"] - CRBroadcastSent _u mc n t -> viewSentBroadcast mc n ts t - CRMsgIntegrityError _u mErr -> viewMsgIntegrityError mErr + CRContactInfo u ct cStats customUserProfile -> withOtherUser u $ viewContactInfo ct cStats customUserProfile + CRGroupMemberInfo u g m cStats -> withOtherUser u $ viewGroupMemberInfo g m cStats + CRContactSwitch u ct progress -> withOtherUser u $ viewContactSwitch ct progress + CRGroupMemberSwitch u g m progress -> withOtherUser u $ viewGroupMemberSwitch g m progress + CRConnectionVerified u verified code -> withOtherUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code] + CRContactCode u ct code -> withOtherUser u $ viewContactCode ct code testView + CRGroupMemberCode u g m code -> withOtherUser u $ viewGroupMemberCode g m code testView + CRNewChatItem u (AChatItem _ _ chat item) -> withOtherUser u $ unmuted chat item $ viewChatItem chat item False ts + CRChatItems u chatItems -> withOtherUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems + CRChatItemId u itemId -> withOtherUser u [plain $ maybe "no item" show itemId] + CRChatItemStatusUpdated u _ -> withOtherUser u [] + CRChatItemUpdated u (AChatItem _ _ chat item) -> withOtherUser u $ unmuted chat item $ viewItemUpdate chat item liveItems ts + CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> withOtherUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem (isJust toItem) byUser timed ts + CRChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> withOtherUser u [ttyFrom $ c <> "> [deleted - original message not found]"] + CRBroadcastSent u mc n t -> withOtherUser u $ viewSentBroadcast mc n ts t + CRMsgIntegrityError u mErr -> withOtherUser u $ viewMsgIntegrityError mErr CRCmdAccepted _ -> [] - CRCmdOk _u -> ["ok"] + CRCmdOk u_ -> withOtherUser' u_ ["ok"] CRChatHelp section -> case section of HSMain -> chatHelpInfo HSFiles -> filesHelpInfo @@ -98,64 +98,61 @@ responseToView user_ testView liveItems ts = \case HSMarkdown -> markdownInfo HSSettings -> settingsInfo CRWelcome user -> chatWelcome user - CRContactsList _u cs -> viewContactsList cs - CRUserContactLink _u UserContactLink {connReqContact, autoAccept} -> connReqContact_ "Your chat address:" connReqContact <> autoAcceptStatus_ autoAccept - CRUserContactLinkUpdated _u UserContactLink {autoAccept} -> autoAcceptStatus_ autoAccept - CRContactRequestRejected _u UserContactRequest {localDisplayName = c} -> [ttyContact c <> ": contact request rejected"] - CRGroupCreated _u g -> viewGroupCreated g - CRGroupMembers _u g -> viewGroupMembers g - CRGroupsList _u gs -> viewGroupsList gs - CRSentGroupInvitation _u g c _ -> - if viaGroupLink . contactConn $ c - then [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"] - else ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c] - CRFileTransferStatus _u ftStatus -> viewFileTransferStatus ftStatus - CRUserProfile _u p -> viewUserProfile p - CRUserProfileNoChange _u -> ["user profile did not change"] + CRContactsList u cs -> withOtherUser u $ viewContactsList cs + CRUserContactLink u UserContactLink {connReqContact, autoAccept} -> withOtherUser u $ connReqContact_ "Your chat address:" connReqContact <> autoAcceptStatus_ autoAccept + CRUserContactLinkUpdated u UserContactLink {autoAccept} -> withOtherUser u $ autoAcceptStatus_ autoAccept + CRContactRequestRejected u UserContactRequest {localDisplayName = c} -> withOtherUser u [ttyContact c <> ": contact request rejected"] + CRGroupCreated u g -> withOtherUser u $ viewGroupCreated g + CRGroupMembers u g -> withOtherUser u $ viewGroupMembers g + CRGroupsList u gs -> withOtherUser u $ viewGroupsList gs + CRSentGroupInvitation u g c _ -> + withOtherUser u $ + if viaGroupLink . contactConn $ c + then [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"] + else ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c] + CRFileTransferStatus u ftStatus -> withOtherUser u $ viewFileTransferStatus ftStatus + CRUserProfile u p -> withOtherUser u $ viewUserProfile p + CRUserProfileNoChange u -> withOtherUser u ["user profile did not change"] CRVersionInfo _ -> [plain versionStr, plain updateStr] - CRInvitation _u cReq -> viewConnReqInvitation cReq - CRSentConfirmation _u -> ["confirmation sent!"] - CRSentInvitation _u customUserProfile -> viewSentInvitation customUserProfile testView - CRContactDeleted _u c -> [ttyContact' c <> ": contact is deleted"] - CRChatCleared _u chatInfo -> viewChatCleared chatInfo - CRAcceptingContactRequest _u c -> [ttyFullContact c <> ": accepting contact request..."] - CRContactAlreadyExists _u c -> [ttyFullContact c <> ": contact already exists"] - CRContactRequestAlreadyAccepted _u c -> [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"] - CRUserContactLinkCreated _u cReq -> connReqContact_ "Your new chat address is created!" cReq - CRUserContactLinkDeleted _u -> viewUserContactLinkDeleted - CRUserAcceptedGroupSent _u _g _ -> [] -- [ttyGroup' g <> ": joining the group..."] - CRUserDeletedMember _u g m -> [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"] - CRLeftMemberUser _u g -> [ttyGroup' g <> ": you left the group"] <> groupPreserved g - CRGroupDeletedUser _u g -> [ttyGroup' g <> ": you deleted the group"] - CRRcvFileAccepted _u ci -> savingFile' ci - CRRcvFileAcceptedSndCancelled _u ft -> viewRcvFileSndCancelled ft - CRSndGroupFileCancelled _u _ ftm fts -> viewSndGroupFileCancelled ftm fts - CRRcvFileCancelled _u ft -> receivingFile_ "cancelled" ft - CRUserProfileUpdated _u p p' -> viewUserProfileUpdated p p' - CRContactPrefsUpdated {user = _u, fromContact, toContact} -> case user_ of - Just user -> viewUserContactPrefsUpdated user fromContact toContact - _ -> ["unexpected chat event CRContactPrefsUpdated without current user"] - CRContactAliasUpdated _u c -> viewContactAliasUpdated c - CRConnectionAliasUpdated _u c -> viewConnectionAliasUpdated c - CRContactUpdated {user = _u, fromContact = c, toContact = c'} -> case user_ of - Just user -> viewContactUpdated c c' <> viewContactPrefsUpdated user c c' - _ -> ["unexpected chat event CRContactUpdated without current user"] - CRContactsMerged _u intoCt mergedCt -> viewContactsMerged intoCt mergedCt - CRReceivedContactRequest _u UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile - CRRcvFileStart _u ci -> receivingFile_' "started" ci - CRRcvFileComplete _u ci -> receivingFile_' "completed" ci - CRRcvFileSndCancelled _u ft -> viewRcvFileSndCancelled ft - CRSndFileStart _u _ ft -> sendingFile_ "started" ft - CRSndFileComplete _u _ ft -> sendingFile_ "completed" ft + CRInvitation u cReq -> withOtherUser u $ viewConnReqInvitation cReq + CRSentConfirmation u -> withOtherUser u ["confirmation sent!"] + CRSentInvitation u customUserProfile -> withOtherUser u $ viewSentInvitation customUserProfile testView + CRContactDeleted u c -> withOtherUser u [ttyContact' c <> ": contact is deleted"] + CRChatCleared u chatInfo -> withOtherUser u $ viewChatCleared chatInfo + CRAcceptingContactRequest u c -> withOtherUser u [ttyFullContact c <> ": accepting contact request..."] + CRContactAlreadyExists u c -> withOtherUser u [ttyFullContact c <> ": contact already exists"] + CRContactRequestAlreadyAccepted u c -> withOtherUser u [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"] + CRUserContactLinkCreated u cReq -> withOtherUser u $ connReqContact_ "Your new chat address is created!" cReq + CRUserContactLinkDeleted u -> withOtherUser u viewUserContactLinkDeleted + CRUserAcceptedGroupSent u _g _ -> withOtherUser u [] -- [ttyGroup' g <> ": joining the group..."] + CRUserDeletedMember u g m -> withOtherUser u [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"] + CRLeftMemberUser u g -> withOtherUser u $ [ttyGroup' g <> ": you left the group"] <> groupPreserved g + CRGroupDeletedUser u g -> withOtherUser u [ttyGroup' g <> ": you deleted the group"] + CRRcvFileAccepted u ci -> withOtherUser u $ savingFile' ci + CRRcvFileAcceptedSndCancelled u ft -> withOtherUser u $ viewRcvFileSndCancelled ft + CRSndGroupFileCancelled u _ ftm fts -> withOtherUser u $ viewSndGroupFileCancelled ftm fts + CRRcvFileCancelled u ft -> withOtherUser u $ receivingFile_ "cancelled" ft + CRUserProfileUpdated u p p' -> withOtherUser u $ viewUserProfileUpdated p p' + CRContactPrefsUpdated {user = u, fromContact, toContact} -> withOtherUser u $ viewUserContactPrefsUpdated u fromContact toContact + CRContactAliasUpdated u c -> withOtherUser u $ viewContactAliasUpdated c + CRConnectionAliasUpdated u c -> withOtherUser u $ viewConnectionAliasUpdated c + CRContactUpdated {user = u, fromContact = c, toContact = c'} -> withOtherUser u $ viewContactUpdated c c' <> viewContactPrefsUpdated u c c' + CRContactsMerged u intoCt mergedCt -> withOtherUser u $ viewContactsMerged intoCt mergedCt + CRReceivedContactRequest u UserContactRequest {localDisplayName = c, profile} -> withOtherUser u $ viewReceivedContactRequest c profile + CRRcvFileStart u ci -> withOtherUser u $ receivingFile_' "started" ci + CRRcvFileComplete u ci -> withOtherUser u $ receivingFile_' "completed" ci + CRRcvFileSndCancelled u ft -> withOtherUser u $ viewRcvFileSndCancelled ft + CRSndFileStart u _ ft -> withOtherUser u $ sendingFile_ "started" ft + CRSndFileComplete u _ ft -> withOtherUser u $ sendingFile_ "completed" ft CRSndFileCancelled _ ft -> sendingFile_ "cancelled" ft - CRSndFileRcvCancelled _u _ ft@SndFileTransfer {recipientDisplayName = c} -> - [ttyContact c <> " cancelled receiving " <> sndFile ft] - CRContactConnecting _u _ -> [] - CRContactConnected _u ct userCustomProfile -> viewContactConnected ct userCustomProfile testView - CRContactAnotherClient _u c -> [ttyContact' c <> ": contact is connected to another client"] - CRSubscriptionEnd _u acEntity -> [sShow (connId (entityConnection acEntity :: Connection)) <> ": END"] - CRContactsDisconnected _u srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"] - CRContactsSubscribed _u srv cs -> [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"] + CRSndFileRcvCancelled u _ ft@SndFileTransfer {recipientDisplayName = c} -> + withOtherUser u $ [ttyContact c <> " cancelled receiving " <> sndFile ft] + CRContactConnecting u _ -> withOtherUser u [] + CRContactConnected u ct userCustomProfile -> withOtherUser u $ viewContactConnected ct userCustomProfile testView + CRContactAnotherClient u c -> withOtherUser u [ttyContact' c <> ": contact is connected to another client"] + CRSubscriptionEnd u acEntity -> withOtherUser u [sShow (connId (entityConnection acEntity :: Connection)) <> ": END"] + CRContactsDisconnected u srv cs -> withOtherUser u [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"] + CRContactsSubscribed u srv cs -> withOtherUser u [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"] CRContactSubError c e -> [ttyContact' c <> ": contact error " <> sShow e] CRContactSubSummary summary -> [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors" @@ -169,26 +166,26 @@ responseToView user_ testView liveItems ts = \case addressSS UserContactSubStatus {userContactError} = maybe ("Your address is active! To show: " <> highlight' "/sa") (\e -> "User address error: " <> sShow e <> ", to delete your address: " <> highlight' "/da") userContactError (groupLinkErrors, groupLinksSubscribed) = partition (isJust . userContactError) groupLinks CRGroupInvitation g -> [groupInvitation' g] - CRReceivedGroupInvitation _u g c role -> viewReceivedGroupInvitation g c role - CRUserJoinedGroup _u g _ -> viewUserJoinedGroup g - CRJoinedGroupMember _u g m -> viewJoinedGroupMember g m + CRReceivedGroupInvitation u g c role -> withOtherUser u $ viewReceivedGroupInvitation g c role + CRUserJoinedGroup u g _ -> withOtherUser u $ viewUserJoinedGroup g + CRJoinedGroupMember u g m -> withOtherUser u $ viewJoinedGroupMember g m CRHostConnected p h -> [plain $ "connected to " <> viewHostEvent p h] CRHostDisconnected p h -> [plain $ "disconnected from " <> viewHostEvent p h] - CRJoinedGroupMemberConnecting _u g host m -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"] - CRConnectedToGroupMember _u g m -> [ttyGroup' g <> ": " <> connectedMember m <> " is connected"] - CRMemberRole _u g by m r r' -> viewMemberRoleChanged g by m r r' - CRMemberRoleUser _u g m r r' -> viewMemberRoleUserChanged g m r r' - CRDeletedMemberUser _u g by -> [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g - CRDeletedMember _u g by m -> [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group"] - CRLeftMember _u g m -> [ttyGroup' g <> ": " <> ttyMember m <> " left the group"] + CRJoinedGroupMemberConnecting u g host m -> withOtherUser u [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"] + CRConnectedToGroupMember u g m -> withOtherUser u [ttyGroup' g <> ": " <> connectedMember m <> " is connected"] + CRMemberRole u g by m r r' -> withOtherUser u $ viewMemberRoleChanged g by m r r' + CRMemberRoleUser u g m r r' -> withOtherUser u $ viewMemberRoleUserChanged g m r r' + CRDeletedMemberUser u g by -> withOtherUser u $ [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g + CRDeletedMember u g by m -> withOtherUser u [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group"] + CRLeftMember u g m -> withOtherUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"] CRGroupEmpty g -> [ttyFullGroup g <> ": group is empty"] CRGroupRemoved g -> [ttyFullGroup g <> ": you are no longer a member or group deleted"] - CRGroupDeleted _u g m -> [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> groupName' g) <> " to delete the local copy of the group"] - CRGroupUpdated _u g g' m -> viewGroupUpdated g g' m - CRGroupProfile _u g -> viewGroupProfile g - CRGroupLinkCreated _u g cReq -> groupLink_ "Group link is created!" g cReq - CRGroupLink _u g cReq -> groupLink_ "Group link:" g cReq - CRGroupLinkDeleted _u g -> viewGroupLinkDeleted g + CRGroupDeleted u g m -> withOtherUser u [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group", "use " <> highlight ("/d #" <> groupName' g) <> " to delete the local copy of the group"] + CRGroupUpdated u g g' m -> withOtherUser u $ viewGroupUpdated g g' m + CRGroupProfile u g -> withOtherUser u $ viewGroupProfile g + CRGroupLinkCreated u g cReq -> withOtherUser u $ groupLink_ "Group link is created!" g cReq + CRGroupLink u g cReq -> withOtherUser u $ groupLink_ "Group link:" g cReq + CRGroupLinkDeleted u g -> withOtherUser u $ viewGroupLinkDeleted g CRAcceptingGroupJoinRequest _ g c -> [ttyFullContact c <> ": accepting request to join group " <> ttyGroup' g <> "..."] CRMemberSubError g m e -> [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e] CRMemberSubSummary summary -> viewErrorsSummary (filter (isJust . memberError) summary) " group member errors" @@ -198,16 +195,16 @@ responseToView user_ testView liveItems ts = \case ["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e] CRRcvFileSubError RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e -> ["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e] - CRCallInvitation _u RcvCallInvitation {contact, callType, sharedKey} -> viewCallInvitation contact callType sharedKey - CRCallOffer {user = _u, contact, callType, offer, sharedKey} -> viewCallOffer contact callType offer sharedKey - CRCallAnswer {user = _u, contact, answer} -> viewCallAnswer contact answer - CRCallExtraInfo {user = _u, contact} -> ["call extra info from " <> ttyContact' contact] - CRCallEnded {user = _u, contact} -> ["call with " <> ttyContact' contact <> " ended"] - CRCallInvitations _u _ -> [] + CRCallInvitation u RcvCallInvitation {contact, callType, sharedKey} -> withOtherUser u $ viewCallInvitation contact callType sharedKey + CRCallOffer {user = u, contact, callType, offer, sharedKey} -> withOtherUser u $ viewCallOffer contact callType offer sharedKey + CRCallAnswer {user = u, contact, answer} -> withOtherUser u $ viewCallAnswer contact answer + CRCallExtraInfo {user = u, contact} -> withOtherUser u ["call extra info from " <> ttyContact' contact] + CRCallEnded {user = u, contact} -> withOtherUser u ["call with " <> ttyContact' contact <> " ended"] + CRCallInvitations u _ -> withOtherUser u [] CRUserContactLinkSubscribed -> ["Your address is active! To show: " <> highlight' "/sa"] CRUserContactLinkSubError e -> ["user address error: " <> sShow e, "to delete your address: " <> highlight' "/da"] - CRNewContactConnection _u _ -> [] - CRContactConnectionDeleted _u PendingContactConnection {pccConnId} -> ["connection :" <> sShow pccConnId <> " deleted"] + CRNewContactConnection u _ -> withOtherUser u [] + CRContactConnectionDeleted u PendingContactConnection {pccConnId} -> withOtherUser u ["connection :" <> sShow pccConnId <> " deleted"] CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)] CRNtfToken _ status mode -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode)] CRNtfMessages {} -> [] @@ -218,10 +215,18 @@ responseToView user_ testView liveItems ts = \case ] CRAgentStats stats -> map (plain . intercalate ",") stats CRConnectionDisabled entity -> viewConnectionEntityDisabled entity - CRMessageError _u prefix err -> [plain prefix <> ": " <> plain err] - CRChatCmdError _u e -> viewChatError e - CRChatError _u e -> viewChatError e + CRMessageError u prefix err -> withOtherUser u [plain prefix <> ": " <> plain err] + CRChatCmdError u e -> withOtherUser' u $ viewChatError e + CRChatError u e -> withOtherUser' u $ viewChatError e where + withOtherUser :: User -> [StyledString] -> [StyledString] + withOtherUser = withOtherUser' . Just + withOtherUser' :: Maybe User -> [StyledString] -> [StyledString] + withOtherUser' cmdUser@(Just User {localDisplayName = u}) ss@(s : ss') + | cmdUser /= user_ = "[user: " <> highlight u <> "] " <> s : ss' + | otherwise = ss + withOtherUser' (Just _) [] = [] + withOtherUser' Nothing ss = ss testViewChats :: [AChat] -> [StyledString] testViewChats chats = [sShow $ map toChatView chats] where diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index c07a69ade3..6ca6f940bf 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -172,6 +172,9 @@ chatTests = do describe "mute/unmute messages" $ do it "mute/unmute contact" testMuteContact it "mute/unmute group" testMuteGroup + describe "multiple users" $ do + it "create second user" testCreateSecondUser + it "both users have contact link" testMultipleUserAddresses describe "chat item expiration" $ do it "set chat item TTL" testSetChatItemTTL describe "queue rotation" $ do @@ -4348,6 +4351,126 @@ testMuteGroup = bob ##> "/gs" bob <## "#team" +testCreateSecondUser :: IO () +testCreateSecondUser = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + connectUsers alice bob + + alice ##> "/create user alisa" + showActiveUser alice "alisa" + + -- connect using second user + connectUsers alice bob + alice #> "@bob hello" + bob <# "alisa> hello" + bob #> "@alisa hey" + alice <# "bob> hey" + + alice ##> "/user" + showActiveUser alice "alisa" + + alice ##> "/users" + alice <## "alice (Alice)" + alice <## "alisa (active)" + + -- receive message to first user + bob #> "@alice hey alice" + (alice, "alice") $<# "bob> hey alice" + + connectUsers alice cath + + -- set active user to first user + alice ##> "/user alice" + showActiveUser alice "alice (Alice)" + + alice ##> "/user" + showActiveUser alice "alice (Alice)" + + alice ##> "/users" + alice <## "alice (Alice) (active)" + alice <## "alisa" + + alice <##> bob + + cath #> "@alisa hey alisa" + (alice, "alisa") $<# "cath> hey alisa" + alice ##> "@cath hi cath" + alice <## "no contact cath" + + -- set active user to second user + alice ##> "/_user 2" + showActiveUser alice "alisa" + +testMultipleUserAddresses :: IO () +testMultipleUserAddresses = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + alice ##> "/ad" + cLinkAlice <- getContactLink alice True + bob ##> ("/c " <> cLinkAlice) + alice <#? bob + alice @@@ [("<@bob", "")] + alice ##> "/ac bob" + alice <## "bob (Bob): accepting contact request..." + concurrently_ + (bob <## "alice (Alice): contact is connected") + (alice <## "bob (Bob): contact is connected") + alice @@@ [("@bob", "Voice messages: enabled")] + alice <##> bob + + alice ##> "/create user alisa" + showActiveUser alice "alisa" + + -- connect using second user address + alice ##> "/ad" + cLinkAlisa <- getContactLink alice True + bob ##> ("/c " <> cLinkAlisa) + alice <#? bob + alice #$> ("/_get chats 2 pcc=on", chats, [("<@bob", "")]) + alice ##> "/ac bob" + alice <## "bob (Bob): accepting contact request..." + concurrently_ + (bob <## "alisa: contact is connected") + (alice <## "bob (Bob): contact is connected") + alice #$> ("/_get chats 2 pcc=on", chats, [("@bob", "Voice messages: enabled")]) + alice <##> bob + + bob #> "@alice hey alice" + (alice, "alice") $<# "bob> hey alice" + + -- delete first user address + alice ##> "/user alice" + showActiveUser alice "alice (Alice)" + + alice ##> "/da" + alice <## "Your chat address is deleted - accepted contacts will remain connected." + alice <## "To create a new chat address use /ad" + + -- second user receives request when not active + cath ##> ("/c " <> cLinkAlisa) + cath <## "connection request sent!" + alice <## "[user: alisa] cath (Catherine) wants to connect to you!" + alice <## "to accept: /ac cath" + alice <## "to reject: /rc cath (the sender will NOT be notified)" + + -- accept request + alice ##> "/user alisa" + showActiveUser alice "alisa" + + alice ##> "/ac cath" + alice <## "cath (Catherine): accepting contact request..." + concurrently_ + (cath <## "alisa: contact is connected") + (alice <## "cath (Catherine): contact is connected") + alice #$> ("/_get chats 2 pcc=on", chats, [("@cath", "Voice messages: enabled"), ("@bob", "hey")]) + alice <##> cath + + -- first user doesn't have cath as contact + alice ##> "/user alice" + showActiveUser alice "alice (Alice)" + alice @@@ [("@bob", "hey alice")] + testSetChatItemTTL :: IO () testSetChatItemTTL = testChat2 aliceProfile bobProfile $ @@ -4990,7 +5113,7 @@ connectUsers cc1 cc2 = do showName :: TestCC -> IO String showName (TestCC ChatController {currentUser} _ _ _ _) = do Just User {localDisplayName, profile = LocalProfile {fullName}} <- readTVarIO currentUser - pure . T.unpack $ localDisplayName <> " (" <> fullName <> ")" + pure . T.unpack $ localDisplayName <> optionalFullName localDisplayName fullName createGroup2 :: String -> TestCC -> TestCC -> IO () createGroup2 gName cc1 cc2 = do @@ -5100,7 +5223,13 @@ itemId :: Int -> String itemId i = show $ length chatFeatures + i (@@@) :: TestCC -> [(String, String)] -> Expectation -(@@@) = getChats . map $ \(ldn, msg, _) -> (ldn, msg) +(@@@) = getChats mapChats + +mapChats :: [(String, String, Maybe ConnStatus)] -> [(String, String)] +mapChats = map $ \(ldn, msg, _) -> (ldn, msg) + +chats :: String -> [(String, String)] +chats = mapChats . read (@@@!) :: TestCC -> [(String, String, Maybe ConnStatus)] -> Expectation (@@@!) = getChats id @@ -5174,6 +5303,9 @@ cc <# line = (dropTime <$> getTermLine cc) `shouldReturn` line (?<#) :: TestCC -> String -> Expectation cc ?<# line = (dropTime <$> getTermLine cc) `shouldReturn` "i " <> line +($<#) :: (TestCC, String) -> String -> Expectation +(cc, uName) $<# line = (dropTime . dropUser uName <$> getTermLine cc) `shouldReturn` line + ( Expectation ( name) cc1 <## ("to reject: /rc " <> name <> " (the sender will NOT be notified)") +dropUser :: String -> String -> String +dropUser uName msg = fromMaybe err $ dropUser_ uName msg + where + err = error $ "invalid user: " <> msg + +dropUser_ :: String -> String -> Maybe String +dropUser_ uName msg = do + let userPrefix = "[user: " <> uName <> "] " + if userPrefix `isPrefixOf` msg + then Just $ drop (length userPrefix) msg + else Nothing + dropTime :: String -> String dropTime msg = fromMaybe err $ dropTime_ msg where @@ -5245,3 +5389,9 @@ lastItemId :: TestCC -> IO String lastItemId cc = do cc ##> "/last_item_id" getTermLine cc + +showActiveUser :: TestCC -> String -> Expectation +showActiveUser cc name = do + cc <## ("user profile: " <> name) + cc <## "use /p [] to change it" + cc <## "(the updated profile will be sent to all your contacts)"