From 4816150b99e5bd5a6cf6c189a891a1f0f9468dac Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Fri, 3 Nov 2023 18:15:07 +0000 Subject: [PATCH] core: contacts without connections (#3313) * core: contacts without connections * compiles (some tests don't pass) * remove commented code * filter out user contact (fixes tests) --------- Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> --- .../src/Broadcast/Bot.hs | 3 +- src/Simplex/Chat.hs | 214 ++++++++++-------- src/Simplex/Chat/Controller.hs | 5 +- src/Simplex/Chat/Protocol.hs | 2 +- src/Simplex/Chat/Store/Connections.hs | 5 +- src/Simplex/Chat/Store/Direct.hs | 37 +-- src/Simplex/Chat/Store/Files.hs | 10 +- src/Simplex/Chat/Store/Groups.hs | 27 ++- src/Simplex/Chat/Store/Messages.hs | 32 +-- src/Simplex/Chat/Store/Shared.hs | 17 +- src/Simplex/Chat/Types.hs | 23 +- src/Simplex/Chat/View.hs | 16 +- 12 files changed, 217 insertions(+), 174 deletions(-) diff --git a/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs b/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs index 04b6627f3..3495770d1 100644 --- a/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs +++ b/apps/simplex-broadcast-bot/src/Broadcast/Bot.hs @@ -62,7 +62,8 @@ broadcastBot BroadcastBotOpts {publishers, welcomeMessage, prohibitedMessage} _u MCLink {} -> True MCImage {} -> True _ -> False - broadcastTo ct'@Contact {activeConn = conn@Connection {connStatus}} = + broadcastTo Contact {activeConn = Nothing} = False + broadcastTo ct'@Contact {activeConn = Just conn@Connection {connStatus}} = (connStatus == ConnSndReady || connStatus == ConnReady) && not (connDisabled conn) && contactId' ct' /= contactId' ct diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 52bf4a185..325b767ef 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -614,8 +614,8 @@ processChatCommand = \case let fileName = takeFileName file fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing} chSize <- asks $ fileChunkSize . config - withStore' $ \db -> do - ft@FileTransferMeta {fileId} <- createSndDirectFileTransfer db userId ct file fileInvitation agentConnId_ chSize subMode + withStore $ \db -> do + ft@FileTransferMeta {fileId} <- liftIO $ createSndDirectFileTransfer db userId ct file fileInvitation agentConnId_ chSize subMode fileStatus <- case fileInline of Just IFMSent -> createSndDirectInlineFT db ct ft $> CIFSSndTransfer 0 1 _ -> pure CIFSSndStored @@ -749,7 +749,8 @@ processChatCommand = \case let fileSource = Just $ CryptoFile filePath cfArgs ciFile = CIFile {fileId, fileName, fileSize, fileSource, fileStatus = CIFSSndStored, fileProtocol = FPXFTP} case contactOrGroup of - CGContact Contact {activeConn} -> withStore' $ \db -> createSndFTDescrXFTP db user Nothing activeConn ft fileDescr + CGContact Contact {activeConn} -> forM_ activeConn $ \conn -> + withStore' $ \db -> createSndFTDescrXFTP db user Nothing conn ft fileDescr CGGroup (Group _ ms) -> forM_ ms $ \m -> saveMemberFD m `catchChatError` (toView . CRChatError (Just user)) where -- we are not sending files to pending members, same as with inline files @@ -1190,7 +1191,8 @@ processChatCommand = \case ct <- getContact db user chatId liftIO $ updateContactSettings db user chatId chatSettings pure ct - withAgent $ \a -> toggleConnectionNtfs a (contactConnId ct) (chatHasNtfs chatSettings) + forM_ (contactConnId ct) $ \connId -> + withAgent $ \a -> toggleConnectionNtfs a connId (chatHasNtfs chatSettings) ok user CTGroup -> do ms <- withStore $ \db -> do @@ -1211,9 +1213,12 @@ processChatCommand = \case ok user APIContactInfo contactId -> withUser $ \user@User {userId} -> do -- [incognito] print user's incognito profile for this contact - ct@Contact {activeConn = Connection {customUserProfileId}} <- withStore $ \db -> getContact db user contactId - incognitoProfile <- forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) - connectionStats <- withAgent (`getConnectionServers` contactConnId ct) + ct@Contact {activeConn} <- withStore $ \db -> getContact db user contactId + incognitoProfile <- case activeConn of + Nothing -> pure Nothing + Just Connection {customUserProfileId} -> + forM customUserProfileId $ \profileId -> withStore (\db -> getProfileById db userId profileId) + connectionStats <- mapM (withAgent . flip getConnectionServers) (contactConnId ct) pure $ CRContactInfo user ct connectionStats (fmap fromLocalProfile incognitoProfile) APIGroupInfo gId -> withUser $ \user -> do (g, s) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> liftIO (getGroupSummary db user gId) @@ -1224,8 +1229,11 @@ processChatCommand = \case pure $ CRGroupMemberInfo user g m connectionStats APISwitchContact contactId -> withUser $ \user -> do ct <- withStore $ \db -> getContact db user contactId - connectionStats <- withAgent $ \a -> switchConnectionAsync a "" $ contactConnId ct - pure $ CRContactSwitchStarted user ct connectionStats + case contactConnId ct of + Just connId -> do + connectionStats <- withAgent $ \a -> switchConnectionAsync a "" connId + pure $ CRContactSwitchStarted user ct connectionStats + Nothing -> throwChatError $ CEContactNotActive ct APISwitchGroupMember gId gMemberId -> withUser $ \user -> do (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId case memberConnId m of @@ -1235,8 +1243,11 @@ processChatCommand = \case _ -> throwChatError CEGroupMemberNotActive APIAbortSwitchContact contactId -> withUser $ \user -> do ct <- withStore $ \db -> getContact db user contactId - connectionStats <- withAgent $ \a -> abortConnectionSwitch a $ contactConnId ct - pure $ CRContactSwitchAborted user ct connectionStats + case contactConnId ct of + Just connId -> do + connectionStats <- withAgent $ \a -> abortConnectionSwitch a connId + pure $ CRContactSwitchAborted user ct connectionStats + Nothing -> throwChatError $ CEContactNotActive ct APIAbortSwitchGroupMember gId gMemberId -> withUser $ \user -> do (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId case memberConnId m of @@ -1246,9 +1257,12 @@ processChatCommand = \case _ -> throwChatError CEGroupMemberNotActive APISyncContactRatchet contactId force -> withUser $ \user -> do ct <- withStore $ \db -> getContact db user contactId - cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a (contactConnId ct) force - createInternalChatItem user (CDDirectSnd ct) (CISndConnEvent $ SCERatchetSync rss Nothing) Nothing - pure $ CRContactRatchetSyncStarted user ct cStats + case contactConnId ct of + Just connId -> do + cStats@ConnectionStats {ratchetSyncState = rss} <- withAgent $ \a -> synchronizeRatchet a connId force + createInternalChatItem user (CDDirectSnd ct) (CISndConnEvent $ SCERatchetSync rss Nothing) Nothing + pure $ CRContactRatchetSyncStarted user ct cStats + Nothing -> throwChatError $ CEContactNotActive ct APISyncGroupMemberRatchet gId gMemberId force -> withUser $ \user -> do (g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId case memberConnId m of @@ -1258,16 +1272,19 @@ processChatCommand = \case pure $ CRGroupMemberRatchetSyncStarted user g m cStats _ -> throwChatError CEGroupMemberNotActive APIGetContactCode contactId -> withUser $ \user -> do - ct@Contact {activeConn = conn@Connection {connId}} <- withStore $ \db -> getContact db user contactId - code <- getConnectionCode (contactConnId ct) - ct' <- case contactSecurityCode ct of - Just SecurityCode {securityCode} - | sameVerificationCode code securityCode -> pure ct - | otherwise -> do - withStore' $ \db -> setConnectionVerified db user connId Nothing - pure (ct :: Contact) {activeConn = conn {connectionCode = Nothing}} - _ -> pure ct - pure $ CRContactCode user ct' code + ct@Contact {activeConn} <- withStore $ \db -> getContact db user contactId + case activeConn of + Just conn@Connection {connId} -> do + code <- getConnectionCode $ aConnId conn + ct' <- case contactSecurityCode ct of + Just SecurityCode {securityCode} + | sameVerificationCode code securityCode -> pure ct + | otherwise -> do + withStore' $ \db -> setConnectionVerified db user connId Nothing + pure (ct :: Contact) {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}} + _ -> pure ct + pure $ CRContactCode user ct' code + Nothing -> throwChatError $ CEContactNotActive ct APIGetGroupMemberCode gId gMemberId -> withUser $ \user -> do (g, m@GroupMember {activeConn}) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId case activeConn of @@ -1283,17 +1300,22 @@ processChatCommand = \case pure $ CRGroupMemberCode user g m' code _ -> throwChatError CEGroupMemberNotActive APIVerifyContact contactId code -> withUser $ \user -> do - Contact {activeConn} <- withStore $ \db -> getContact db user contactId - verifyConnectionCode user activeConn code + ct@Contact {activeConn} <- withStore $ \db -> getContact db user contactId + case activeConn of + Just conn -> verifyConnectionCode user conn code + Nothing -> throwChatError $ CEContactNotActive ct APIVerifyGroupMember gId gMemberId code -> withUser $ \user -> do GroupMember {activeConn} <- withStore $ \db -> getGroupMember db user gId gMemberId case activeConn of Just conn -> verifyConnectionCode user conn code _ -> throwChatError CEGroupMemberNotActive APIEnableContact contactId -> withUser $ \user -> do - Contact {activeConn} <- withStore $ \db -> getContact db user contactId - withStore' $ \db -> setConnectionAuthErrCounter db user activeConn 0 - ok user + ct@Contact {activeConn} <- withStore $ \db -> getContact db user contactId + case activeConn of + Just conn -> do + withStore' $ \db -> setConnectionAuthErrCounter db user conn 0 + ok user + Nothing -> throwChatError $ CEContactNotActive ct APIEnableGroupMember gId gMemberId -> withUser $ \user -> do GroupMember {activeConn} <- withStore $ \db -> getGroupMember db user gId gMemberId case activeConn of @@ -1554,16 +1576,19 @@ processChatCommand = \case inv@ReceivedGroupInvitation {fromMember} <- getGroupInvitation db user groupId (inv,) <$> getContactViaMember db user fromMember let ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g@GroupInfo {membership}} = invitation - Contact {activeConn = Connection {peerChatVRange}} = ct - subMode <- chatReadVar subscriptionMode - dm <- directMessage $ XGrpAcpt membership.memberId - agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm subMode - withStore' $ \db -> do - createMemberConnection db userId fromMember agentConnId (fromJVersionRange peerChatVRange) subMode - updateGroupMemberStatus db userId fromMember GSMemAccepted - updateGroupMemberStatus db userId membership GSMemAccepted - updateCIGroupInvitationStatus user - pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing + Contact {activeConn} = ct + case activeConn of + Just Connection {peerChatVRange} -> do + subMode <- chatReadVar subscriptionMode + dm <- directMessage $ XGrpAcpt membership.memberId + agentConnId <- withAgent $ \a -> joinConnection a (aUserId user) True connRequest dm subMode + withStore' $ \db -> do + createMemberConnection db userId fromMember agentConnId (fromJVersionRange peerChatVRange) subMode + updateGroupMemberStatus db userId fromMember GSMemAccepted + updateGroupMemberStatus db userId membership GSMemAccepted + updateCIGroupInvitationStatus user + pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing + Nothing -> throwChatError $ CEContactNotActive ct where updateCIGroupInvitationStatus user = do AChatItem _ _ cInfo ChatItem {content, meta = CIMeta {itemId}} <- withStore $ \db -> getChatItemByGroupId db user groupId @@ -2064,7 +2089,8 @@ processChatCommand = \case void $ sendDirectContactMessage ct' (XInfo mergedProfile') when (directOrUsed ct') $ createSndFeatureItems user' ct ct' updateContactPrefs :: User -> Contact -> Preferences -> m ChatResponse - updateContactPrefs user@User {userId} ct@Contact {activeConn = Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs' + updateContactPrefs _ ct@Contact {activeConn = Nothing} _ = throwChatError $ CEContactNotActive ct + updateContactPrefs user@User {userId} ct@Contact {activeConn = Just Connection {customUserProfileId}, userPreferences = contactUserPrefs} contactUserPrefs' | contactUserPrefs == contactUserPrefs' = pure $ CRContactPrefsUpdated user ct ct | otherwise = do assertDirectAllowed user MDSnd ct XInfo_ @@ -2595,8 +2621,8 @@ acceptContactRequestAsync user UserContactRequest {agentInvitationId = AgentInvI let profileToSend = profileToSendOnAccept user incognitoProfile (cmdId, acId) <- agentAcceptContactAsync user True invId (XInfo profileToSend) subMode withStore' $ \db -> do - ct@Contact {activeConn = Connection {connId}} <- createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId p userContactLinkId xContactId incognitoProfile subMode - setCommandConnId db user cmdId connId + ct@Contact {activeConn} <- createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId p userContactLinkId xContactId incognitoProfile subMode + forM_ activeConn $ \Connection {connId} -> setCommandConnId db user cmdId connId pure ct acceptGroupJoinRequestAsync :: ChatMonad m => User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> Maybe IncognitoProfile -> m GroupMember @@ -2717,7 +2743,7 @@ subscribeUserConnections onlyNeeded agentBatchSubscribe user@User {userId} = do getContactConns :: m ([ConnId], Map ConnId Contact) getContactConns = do cts <- withStore_ ("subscribeUserConnections " <> show userId <> ", getUserContacts") getUserContacts - let connIds = map contactConnId (filter contactActive cts) + let connIds = catMaybes $ map contactConnId (filter contactActive cts) pure (connIds, M.fromList $ zip connIds cts) getUserContactLinkConns :: m ([ConnId], Map ConnId UserContact) getUserContactLinkConns = do @@ -2758,9 +2784,10 @@ subscribeUserConnections onlyNeeded agentBatchSubscribe user@User {userId} = do toView $ CRNetworkStatuses (Just user) $ map (uncurry ConnNetworkStatus) statuses where addStatus :: ConnId -> Contact -> [(AgentConnId, NetworkStatus)] -> [(AgentConnId, NetworkStatus)] - addStatus connId ct = - let ns = (contactAgentConnId ct, netStatus $ resultErr connId rs) - in (ns :) + addStatus _ Contact {activeConn = Nothing} nss = nss + addStatus connId Contact {activeConn = Just Connection {agentConnId}} nss = + let ns = (agentConnId, netStatus $ resultErr connId rs) + in ns : nss netStatus :: Maybe ChatError -> NetworkStatus netStatus = maybe NSConnected $ NSError . errorNetworkStatus errorNetworkStatus :: ChatError -> String @@ -3203,7 +3230,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do cmdId <- createAckCmd conn withAckMessage agentConnId cmdId msgMeta $ do (conn', msg@RcvMessage {chatMsgEvent = ACME _ event}) <- saveRcvMSG conn (ConnectionId connId) msgMeta msgBody cmdId - let ct' = ct {activeConn = conn'} :: Contact + let ct' = ct {activeConn = Just conn'} :: Contact assertDirectAllowed user MDRcv ct' $ toCMEventTag event updateChatLock "directMessage" event case event of @@ -3311,7 +3338,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do (RSAllowed, _, Just cryptoErr) -> processErr cryptoErr (RSAgreed, Just _, _) -> do withStore' $ \db -> setConnectionVerified db user connId Nothing - let ct' = ct {activeConn = conn {connectionCode = Nothing}} :: Contact + let ct' = ct {activeConn = Just $ (conn :: Connection) {connectionCode = Nothing}} :: Contact ratchetSyncEventItem ct' securityCodeChanged ct' _ -> ratchetSyncEventItem ct @@ -3464,11 +3491,12 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do notifyMemberConnected gInfo m Nothing let connectedIncognito = memberIncognito membership when (memberCategory m == GCPreMember) $ probeMatchingMemberContact m connectedIncognito - Just ct@Contact {activeConn = Connection {connStatus}} -> - when (connStatus == ConnReady) $ do - notifyMemberConnected gInfo m $ Just ct - let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo - when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True + Just ct@Contact {activeConn} -> + forM_ activeConn $ \Connection {connStatus} -> + when (connStatus == ConnReady) $ do + notifyMemberConnected gInfo m $ Just ct + let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo + when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True MSG msgMeta _msgFlags msgBody -> do cmdId <- createAckCmd conn withAckMessage agentConnId cmdId msgMeta $ do @@ -4279,7 +4307,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do _ -> do event <- withStore $ \db -> do ci' <- updateDirectCIFileStatus db user fileId $ CIFSSndTransfer 0 1 - sft <- liftIO $ createSndDirectInlineFT db ct ft + sft <- createSndDirectInlineFT db ct ft pure $ CRSndFileStart user ci' sft toView event ifM @@ -4395,30 +4423,31 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do processGroupInvitation :: Contact -> GroupInvitation -> RcvMessage -> MsgMeta -> m () processGroupInvitation ct inv msg msgMeta = do - let Contact {localDisplayName = c, activeConn = Connection {connId, peerChatVRange, customUserProfileId, groupLinkId = groupLinkId'}} = ct + let Contact {localDisplayName = c, activeConn} = ct GroupInvitation {fromMember = (MemberIdRole fromMemId fromRole), invitedMember = (MemberIdRole memId memRole), connRequest, groupLinkId} = inv - checkIntegrityCreateItem (CDDirectRcv ct) msgMeta - when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c) - when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId - -- [incognito] if direct connection with host is incognito, create membership using the same incognito profile - (gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership = membership@GroupMember {groupMemberId, memberId}}, hostId) <- withStore $ \db -> createGroupInvitation db user ct inv customUserProfileId - if sameGroupLinkId groupLinkId groupLinkId' - then do - subMode <- chatReadVar subscriptionMode - dm <- directMessage $ XGrpAcpt memberId - connIds <- joinAgentConnectionAsync user True connRequest dm subMode - withStore' $ \db -> do - setViaGroupLinkHash db groupId connId - createMemberConnectionAsync db user hostId connIds (fromJVersionRange peerChatVRange) subMode - updateGroupMemberStatusById db userId hostId GSMemAccepted - updateGroupMemberStatus db userId membership GSMemAccepted - toView $ CRUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct) - else do - let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole - ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta content - withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci) - toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) - toView $ CRReceivedGroupInvitation {user, groupInfo = gInfo, contact = ct, fromMemberRole = fromRole, memberRole = memRole} + forM_ activeConn $ \Connection {connId, peerChatVRange, customUserProfileId, groupLinkId = groupLinkId'} -> do + checkIntegrityCreateItem (CDDirectRcv ct) msgMeta + when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c) + when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId + -- [incognito] if direct connection with host is incognito, create membership using the same incognito profile + (gInfo@GroupInfo {groupId, localDisplayName, groupProfile, membership = membership@GroupMember {groupMemberId, memberId}}, hostId) <- withStore $ \db -> createGroupInvitation db user ct inv customUserProfileId + if sameGroupLinkId groupLinkId groupLinkId' + then do + subMode <- chatReadVar subscriptionMode + dm <- directMessage $ XGrpAcpt memberId + connIds <- joinAgentConnectionAsync user True connRequest dm subMode + withStore' $ \db -> do + setViaGroupLinkHash db groupId connId + createMemberConnectionAsync db user hostId connIds (fromJVersionRange peerChatVRange) subMode + updateGroupMemberStatusById db userId hostId GSMemAccepted + updateGroupMemberStatus db userId membership GSMemAccepted + toView $ CRUserAcceptedGroupSent user gInfo {membership = membership {memberStatus = GSMemAccepted}} (Just ct) + else do + let content = CIRcvGroupInvitation (CIGroupInvitation {groupId, groupMemberId, localDisplayName, groupProfile, status = CIGISPending}) memRole + ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta content + withStore' $ \db -> setGroupInvitationChatItemId db user groupId (chatItemId' ci) + toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci) + toView $ CRReceivedGroupInvitation {user, groupInfo = gInfo, contact = ct, fromMemberRole = fromRole, memberRole = memRole} where sameGroupLinkId :: Maybe GroupLinkId -> Maybe GroupLinkId -> Bool sameGroupLinkId (Just gli) (Just gli') = gli == gli' @@ -4441,7 +4470,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do contactConns <- withStore $ \db -> getContactConnections db userId ct' deleteAgentConnectionsAsync user $ map aConnId contactConns forM_ contactConns $ \conn -> withStore' $ \db -> updateConnectionStatus db conn ConnDeleted - let ct'' = ct' {activeConn = (contactConn ct') {connStatus = ConnDeleted}} :: Contact + activeConn' <- forM (contactConn ct') $ \conn -> pure conn {connStatus = ConnDeleted} + let ct'' = ct' {activeConn = activeConn'} :: Contact ci <- saveRcvChatItem user (CDDirectRcv ct'') msg msgMeta (CIRcvDirectEvent RDEContactDeleted) toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct'') ci) toView $ CRContactDeletedByContact user ct'' @@ -4951,20 +4981,21 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do Nothing -> createNewContact subMode Just mContactId -> do mCt <- withStore $ \db -> getContact db user mContactId - let Contact {activeConn = Connection {connId}, contactGrpInvSent} = mCt - if contactGrpInvSent - then do - ownConnReq <- withStore $ \db -> getConnReqInv db connId - -- in case both members sent x.grp.direct.inv before receiving other's for processing, - -- only the one who received greater connReq joins, the other creates items and waits for confirmation - if strEncode connReq > strEncode ownConnReq - then joinExistingContact subMode mCt - else createItems mCt m - else joinExistingContact subMode mCt + let Contact {activeConn, contactGrpInvSent} = mCt + forM_ activeConn $ \Connection {connId} -> + if contactGrpInvSent + then do + ownConnReq <- withStore $ \db -> getConnReqInv db connId + -- in case both members sent x.grp.direct.inv before receiving other's for processing, + -- only the one who received greater connReq joins, the other creates items and waits for confirmation + if strEncode connReq > strEncode ownConnReq + then joinExistingContact subMode mCt + else createItems mCt m + else joinExistingContact subMode mCt where joinExistingContact subMode mCt = do connIds <- joinConn subMode - mCt' <- withStore' $ \db -> updateMemberContactInvited db user connIds g mConn mCt subMode + mCt' <- withStore $ \db -> updateMemberContactInvited db user connIds g mConn mCt subMode createItems mCt' m securityCodeChanged mCt' createNewContact subMode = do @@ -5054,7 +5085,7 @@ parseFileDescription = sendDirectFileInline :: ChatMonad m => Contact -> FileTransferMeta -> SharedMsgId -> m () sendDirectFileInline ct ft sharedMsgId = do msgDeliveryId <- sendFileInline_ ft sharedMsgId $ sendDirectContactMessage ct - withStore' $ \db -> updateSndDirectFTDelivery db ct ft msgDeliveryId + withStore $ \db -> updateSndDirectFTDelivery db ct ft msgDeliveryId sendMemberFileInline :: ChatMonad m => GroupMember -> Connection -> FileTransferMeta -> SharedMsgId -> m () sendMemberFileInline m@GroupMember {groupId} conn ft sharedMsgId = do @@ -5247,7 +5278,8 @@ deleteOrUpdateMemberRecord user@User {userId} member = Nothing -> deleteGroupMember db user member sendDirectContactMessage :: (MsgEncodingI e, ChatMonad m) => Contact -> ChatMsgEvent e -> m (SndMessage, Int64) -sendDirectContactMessage ct@Contact {activeConn = conn@Connection {connId, connStatus}, contactStatus} chatMsgEvent +sendDirectContactMessage ct@Contact {activeConn = Nothing} _ = throwChatError $ CEContactNotReady ct +sendDirectContactMessage ct@Contact {activeConn = Just conn@Connection {connId, connStatus}, contactStatus} chatMsgEvent | connStatus /= ConnReady && connStatus /= ConnSndReady = throwChatError $ CEContactNotReady ct | contactStatus /= CSActive = throwChatError $ CEContactNotActive ct | connDisabled conn = throwChatError $ CEContactDisabled ct diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 5f386dea0..c62569235 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -436,7 +436,7 @@ data ChatResponse | CRServerTestResult {user :: User, testServer :: AProtoServerWithAuth, testFailure :: Maybe ProtocolTestFailure} | CRChatItemTTL {user :: User, chatItemTTL :: Maybe Int64} | CRNetworkConfig {networkConfig :: NetworkConfig} - | CRContactInfo {user :: User, contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile} + | CRContactInfo {user :: User, contact :: Contact, connectionStats_ :: Maybe ConnectionStats, customUserProfile :: Maybe Profile} | CRGroupInfo {user :: User, groupInfo :: GroupInfo, groupSummary :: GroupSummary} | CRGroupMemberInfo {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats} | CRContactSwitchStarted {user :: User, contact :: Contact, connectionStats :: ConnectionStats} @@ -1064,7 +1064,8 @@ chatModifyVar f newValue = asks f >>= atomically . (`modifyTVar'` newValue) {-# INLINE chatModifyVar #-} setContactNetworkStatus :: ChatMonad' m => Contact -> NetworkStatus -> m () -setContactNetworkStatus ct = chatModifyVar connNetworkStatuses . M.insert (contactAgentConnId ct) +setContactNetworkStatus Contact {activeConn = Nothing} _ = pure () +setContactNetworkStatus Contact {activeConn = Just Connection {agentConnId}} status = chatModifyVar connNetworkStatuses $ M.insert agentConnId status tryChatError :: ChatMonad m => m a -> m (Either ChatError a) tryChatError = tryAllErrors mkChatError diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 58aa26f28..43ca5913f 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -82,7 +82,7 @@ instance ToJSON ConnectionEntity where updateEntityConnStatus :: ConnectionEntity -> ConnStatus -> ConnectionEntity updateEntityConnStatus connEntity connStatus = case connEntity of - RcvDirectMsgConnection c ct_ -> RcvDirectMsgConnection (st c) ((\ct -> (ct :: Contact) {activeConn = st c}) <$> ct_) + RcvDirectMsgConnection c ct_ -> RcvDirectMsgConnection (st c) ((\ct -> (ct :: Contact) {activeConn = Just $ st c}) <$> ct_) RcvGroupMsgConnection c gInfo m@GroupMember {activeConn = c'} -> RcvGroupMsgConnection (st c) gInfo m {activeConn = st <$> c'} SndFileConnection c ft -> SndFileConnection (st c) ft RcvFileConnection c ft -> RcvFileConnection (st c) ft diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index d73ac705d..b5b377ea5 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -81,10 +81,11 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do |] (userId, contactId) toContact' :: Int64 -> Connection -> [(ProfileId, ContactName, Text, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Maybe Int64, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool)] -> Either StoreError Contact - toContact' contactId activeConn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)] = + toContact' contactId conn [(profileId, localDisplayName, displayName, fullName, image, contactLink, localAlias, viaGroup, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)] = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} - mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn + mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn + activeConn = Just conn in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} toContact' _ _ _ = Left $ SEInternalError "referenced contact not found" getGroupAndMember_ :: Int64 -> Connection -> ExceptT StoreError IO (GroupInfo, GroupMember) diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 477361acd..ba420b980 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -194,13 +194,13 @@ createIncognitoProfile db User {userId} p = do createIncognitoProfile_ db userId createdAt p createDirectContact :: DB.Connection -> User -> Connection -> Profile -> ExceptT StoreError IO Contact -createDirectContact db user@User {userId} activeConn@Connection {connId, localAlias} p@Profile {preferences} = do +createDirectContact db user@User {userId} conn@Connection {connId, localAlias} p@Profile {preferences} = do createdAt <- liftIO getCurrentTime (localDisplayName, contactId, profileId) <- createContact_ db userId connId p localAlias Nothing createdAt (Just createdAt) let profile = toLocalProfile profileId p localAlias userPreferences = emptyChatPrefs - mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn - pure $ Contact {contactId, localDisplayName, profile, activeConn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False} + mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn + pure $ Contact {contactId, localDisplayName, profile, activeConn = Just conn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False} deleteContactConnectionsAndFiles :: DB.Connection -> UserId -> Contact -> IO () deleteContactConnectionsAndFiles db userId Contact {contactId} = do @@ -218,7 +218,7 @@ deleteContactConnectionsAndFiles db userId Contact {contactId} = do DB.execute db "DELETE FROM files WHERE user_id = ? AND contact_id = ?" (userId, contactId) deleteContact :: DB.Connection -> User -> Contact -> IO () -deleteContact db user@User {userId} Contact {contactId, localDisplayName, activeConn = Connection {customUserProfileId}} = do +deleteContact db user@User {userId} Contact {contactId, localDisplayName, activeConn} = do DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId) ctMember :: (Maybe ContactId) <- maybeFirstRow fromOnly $ DB.query db "SELECT contact_id FROM group_members WHERE user_id = ? AND contact_id = ? LIMIT 1" (userId, contactId) if isNothing ctMember @@ -229,16 +229,20 @@ deleteContact db user@User {userId} Contact {contactId, localDisplayName, active currentTs <- getCurrentTime DB.execute db "UPDATE group_members SET contact_id = NULL, updated_at = ? WHERE user_id = ? AND contact_id = ?" (currentTs, userId, contactId) DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId) - forM_ customUserProfileId $ \profileId -> deleteUnusedIncognitoProfileById_ db user profileId + forM_ activeConn $ \Connection {customUserProfileId} -> + forM_ customUserProfileId $ \profileId -> + deleteUnusedIncognitoProfileById_ db user profileId -- should only be used if contact is not member of any groups deleteContactWithoutGroups :: DB.Connection -> User -> Contact -> IO () -deleteContactWithoutGroups db user@User {userId} Contact {contactId, localDisplayName, activeConn = Connection {customUserProfileId}} = do +deleteContactWithoutGroups db user@User {userId} Contact {contactId, localDisplayName, activeConn} = do DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND contact_id = ?" (userId, contactId) deleteContactProfile_ db userId contactId DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName) DB.execute db "DELETE FROM contacts WHERE user_id = ? AND contact_id = ?" (userId, contactId) - forM_ customUserProfileId $ \profileId -> deleteUnusedIncognitoProfileById_ db user profileId + forM_ activeConn $ \Connection {customUserProfileId} -> + forM_ customUserProfileId $ \profileId -> + deleteUnusedIncognitoProfileById_ db user profileId setContactDeleted :: DB.Connection -> User -> Contact -> IO () setContactDeleted db User {userId} Contact {contactId} = do @@ -307,19 +311,19 @@ updateContactProfile db user@User {userId} c p' updateContact_ db userId contactId localDisplayName ldn currentTs pure $ Right c {localDisplayName = ldn, profile, mergedPreferences} where - Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}, activeConn, userPreferences} = c + Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}, userPreferences} = c Profile {displayName = newName, preferences} = p' profile = toLocalProfile profileId p' localAlias - mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn + mergedPreferences = contactUserPreferences user userPreferences preferences $ contactConnIncognito c updateContactUserPreferences :: DB.Connection -> User -> Contact -> Preferences -> IO Contact -updateContactUserPreferences db user@User {userId} c@Contact {contactId, activeConn} userPreferences = do +updateContactUserPreferences db user@User {userId} c@Contact {contactId} userPreferences = do updatedAt <- getCurrentTime DB.execute db "UPDATE contacts SET user_preferences = ?, updated_at = ? WHERE user_id = ? AND contact_id = ?" (userPreferences, updatedAt, userId, contactId) - let mergedPreferences = contactUserPreferences user userPreferences (preferences' c) $ connIncognito activeConn + let mergedPreferences = contactUserPreferences user userPreferences (preferences' c) $ contactConnIncognito c pure $ c {mergedPreferences, userPreferences} updateContactAlias :: DB.Connection -> UserId -> Contact -> LocalAlias -> IO Contact @@ -453,7 +457,8 @@ getContactByName db user localDisplayName = do getUserContacts :: DB.Connection -> User -> IO [Contact] getUserContacts db user@User {userId} = do contactIds <- map fromOnly <$> DB.query db "SELECT contact_id FROM contacts WHERE user_id = ? AND deleted = 0" (Only userId) - rights <$> mapM (runExceptT . getContact db user) contactIds + contacts <- rights <$> mapM (runExceptT . getContact db user) contactIds + pure $ filter (\Contact {activeConn} -> isJust activeConn) contacts createOrUpdateContactRequest :: DB.Connection -> User -> Int64 -> InvitationId -> VersionRange -> Profile -> Maybe XContactId -> ExceptT StoreError IO ContactOrRequest createOrUpdateContactRequest db user@User {userId} userContactLinkId invId (VersionRange minV maxV) Profile {displayName, fullName, image, contactLink, preferences} xContactId_ = @@ -642,9 +647,9 @@ createAcceptedContact db user@User {userId, profile = LocalProfile {preferences} "INSERT INTO contacts (user_id, local_display_name, contact_profile_id, enable_ntfs, user_preferences, created_at, updated_at, chat_ts, xcontact_id) VALUES (?,?,?,?,?,?,?,?,?)" (userId, localDisplayName, profileId, True, userPreferences, createdAt, createdAt, createdAt, xContactId) contactId <- insertedRowId db - activeConn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode - let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn - pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False} + conn <- createConnection_ db userId ConnContact (Just contactId) agentConnId cReqChatVRange Nothing (Just userContactLinkId) customUserProfileId 0 createdAt subMode + let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito conn + pure $ Contact {contactId, localDisplayName, profile = toLocalProfile profileId profile "", activeConn = Just conn, viaGroup = Nothing, contactUsed = False, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = createdAt, updatedAt = createdAt, chatTs = Just createdAt, contactGroupMemberId = Nothing, contactGrpInvSent = False} getContactIdByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO Int64 getContactIdByName db User {userId} cName = @@ -656,7 +661,7 @@ getContact db user contactId = getContact_ db user contactId False getContact_ :: DB.Connection -> User -> Int64 -> Bool -> ExceptT StoreError IO Contact getContact_ db user@User {userId} contactId deleted = - ExceptT . fmap join . firstRow (toContactOrError user) (SEContactNotFound contactId) $ + ExceptT . firstRow (toContact user) (SEContactNotFound contactId) $ DB.query db [sql| diff --git a/src/Simplex/Chat/Store/Files.hs b/src/Simplex/Chat/Store/Files.hs index a710696da..7d950b25f 100644 --- a/src/Simplex/Chat/Store/Files.hs +++ b/src/Simplex/Chat/Store/Files.hs @@ -207,8 +207,9 @@ createSndGroupFileTransferConnection db user@User {userId} fileId (cmdId, acId) "INSERT INTO snd_files (file_id, file_status, connection_id, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" (fileId, FSAccepted, connId, groupMemberId, currentTs, currentTs) -createSndDirectInlineFT :: DB.Connection -> Contact -> FileTransferMeta -> IO SndFileTransfer -createSndDirectInlineFT db Contact {localDisplayName = n, activeConn = Connection {connId, agentConnId}} FileTransferMeta {fileId, fileName, filePath, fileSize, chunkSize, fileInline} = do +createSndDirectInlineFT :: DB.Connection -> Contact -> FileTransferMeta -> ExceptT StoreError IO SndFileTransfer +createSndDirectInlineFT _ Contact {localDisplayName, activeConn = Nothing} _ = throwError $ SEContactNotReady localDisplayName +createSndDirectInlineFT db Contact {localDisplayName = n, activeConn = Just Connection {connId, agentConnId}} FileTransferMeta {fileId, fileName, filePath, fileSize, chunkSize, fileInline} = liftIO $ do currentTs <- getCurrentTime let fileStatus = FSConnected fileInline' = Just $ fromMaybe IFMOffer fileInline @@ -229,8 +230,9 @@ createSndGroupInlineFT db GroupMember {groupMemberId, localDisplayName = n} Conn (fileId, fileStatus, fileInline', connId, groupMemberId, currentTs, currentTs) pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, groupMemberId = Just groupMemberId, fileStatus, fileDescrId = Nothing, fileInline = fileInline'} -updateSndDirectFTDelivery :: DB.Connection -> Contact -> FileTransferMeta -> Int64 -> IO () -updateSndDirectFTDelivery db Contact {activeConn = Connection {connId}} FileTransferMeta {fileId} msgDeliveryId = +updateSndDirectFTDelivery :: DB.Connection -> Contact -> FileTransferMeta -> Int64 -> ExceptT StoreError IO () +updateSndDirectFTDelivery _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName +updateSndDirectFTDelivery db Contact {activeConn = Just Connection {connId}} FileTransferMeta {fileId} msgDeliveryId = liftIO $ DB.execute db "UPDATE snd_files SET last_inline_msg_delivery_id = ? WHERE connection_id = ? AND file_id = ? AND file_inline IS NOT NULL" diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index bddca0deb..09c59eee6 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -314,7 +314,8 @@ createNewGroup db gVar user@User {userId} groupProfile incognitoProfile = Except -- | creates a new group record for the group the current user was invited to, or returns an existing one createGroupInvitation :: DB.Connection -> User -> Contact -> GroupInvitation -> Maybe ProfileId -> ExceptT StoreError IO (GroupInfo, GroupMemberId) -createGroupInvitation db user@User {userId} contact@Contact {contactId, activeConn = Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do +createGroupInvitation _ _ Contact {localDisplayName, activeConn = Nothing} _ _ = throwError $ SEContactNotReady localDisplayName +createGroupInvitation db user@User {userId} contact@Contact {contactId, activeConn = Just Connection {customUserProfileId}} GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} incognitoProfileId = do liftIO getInvitationGroupId_ >>= \case Nothing -> createGroupInvitation_ Just gId -> do @@ -705,7 +706,8 @@ getGroupInvitation db user groupId = DB.query db "SELECT g.inv_queue_info FROM groups g WHERE g.group_id = ? AND g.user_id = ?" (groupId, userId) createNewContactMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupId -> Contact -> GroupMemberRole -> ConnId -> ConnReqInvitation -> SubscriptionMode -> ExceptT StoreError IO GroupMember -createNewContactMember db gVar User {userId, userContactId} groupId Contact {contactId, localDisplayName, profile, activeConn = Connection {peerChatVRange}} memberRole agentConnId connRequest subMode = +createNewContactMember _ _ _ _ Contact {localDisplayName, activeConn = Nothing} _ _ _ _ = throwError $ SEContactNotReady localDisplayName +createNewContactMember db gVar User {userId, userContactId} groupId Contact {contactId, localDisplayName, profile, activeConn = Just Connection {peerChatVRange}} memberRole agentConnId connRequest subMode = createWithRandomId gVar $ \memId -> do createdAt <- liftIO getCurrentTime member@GroupMember {groupMemberId} <- createMember_ (MemberId memId) createdAt @@ -1725,15 +1727,15 @@ createMemberContact connId <- insertedRowId db let ctConn = Connection {connId, agentConnId = AgentConnId acId, peerChatVRange, connType = ConnContact, contactConnInitiated = True, entityId = Just contactId, viaContact = Nothing, viaUserContactLink = Nothing, viaGroupLink = False, groupLinkId = Nothing, customUserProfileId, connLevel, connStatus = ConnNew, localAlias = "", createdAt = currentTs, connectionCode = Nothing, authErrCounter = 0} mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn - pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False} + pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False} getMemberContact :: DB.Connection -> User -> ContactId -> ExceptT StoreError IO (GroupInfo, GroupMember, Contact, ConnReqInvitation) getMemberContact db user contactId = do ct <- getContact db user contactId - let Contact {contactGroupMemberId, activeConn = Connection {connId}} = ct - cReq <- getConnReqInv db connId - case contactGroupMemberId of - Just groupMemberId -> do + let Contact {contactGroupMemberId, activeConn} = ct + case (activeConn, contactGroupMemberId) of + (Just Connection {connId}, Just groupMemberId) -> do + cReq <- getConnReqInv db connId m@GroupMember {groupId} <- getGroupMemberById db user groupMemberId g <- getGroupInfo db user groupId pure (g, m, ct, cReq) @@ -1762,7 +1764,7 @@ createMemberContactInvited contactId <- createContactUpdateMember currentTs userPreferences ctConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn - mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False} + mCt' = Contact {contactId, localDisplayName = memberLDN, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Nothing, contactGrpInvSent = False} m' = m {memberContactId = Just contactId} pure (mCt', m') where @@ -1786,13 +1788,14 @@ createMemberContactInvited (contactId, currentTs, groupMemberId) pure contactId -updateMemberContactInvited :: DB.Connection -> User -> (CommandId, ConnId) -> GroupInfo -> Connection -> Contact -> SubscriptionMode -> IO Contact -updateMemberContactInvited db user connIds gInfo mConn ct@Contact {contactId, activeConn = oldContactConn} subMode = do +updateMemberContactInvited :: DB.Connection -> User -> (CommandId, ConnId) -> GroupInfo -> Connection -> Contact -> SubscriptionMode -> ExceptT StoreError IO Contact +updateMemberContactInvited _ _ _ _ _ Contact {localDisplayName, activeConn = Nothing} _ = throwError $ SEContactNotReady localDisplayName +updateMemberContactInvited db user connIds gInfo mConn ct@Contact {contactId, activeConn = Just oldContactConn} subMode = liftIO $ do updateConnectionStatus db oldContactConn ConnDeleted - activeConn <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode + activeConn' <- createMemberContactConn_ db user connIds gInfo mConn contactId subMode ct' <- updateContactStatus db user ct CSActive ct'' <- resetMemberContactFields db ct' - pure (ct'' :: Contact) {activeConn} + pure (ct'' :: Contact) {activeConn = Just activeConn'} resetMemberContactFields :: DB.Connection -> Contact -> IO Contact resetMemberContactFields db ct@Contact {contactId} = do diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 35a8bad69..0136ac660 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -497,7 +497,7 @@ getDirectChatPreviews_ db user@User {userId} = do ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent FROM contacts ct JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id - JOIN connections c ON c.contact_id = ct.contact_id + LEFT JOIN connections c ON c.contact_id = ct.contact_id LEFT JOIN ( SELECT contact_id, MAX(chat_item_id) AS MaxId FROM chat_items @@ -514,25 +514,31 @@ getDirectChatPreviews_ db user@User {userId} = do ) ChatStats ON ChatStats.contact_id = ct.contact_id LEFT JOIN chat_items ri ON ri.user_id = i.user_id AND ri.contact_id = i.contact_id AND ri.shared_msg_id = i.quoted_shared_msg_id WHERE ct.user_id = ? - AND ((c.conn_level = 0 AND c.via_group_link = 0) OR ct.contact_used = 1) + AND ct.is_user = 0 AND ct.deleted = 0 - AND c.connection_id = ( - SELECT cc_connection_id FROM ( - SELECT - cc.connection_id AS cc_connection_id, - cc.created_at AS cc_created_at, - (CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord - FROM connections cc - WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id - ORDER BY cc_conn_status_ord DESC, cc_created_at DESC - LIMIT 1 + AND ( + ( + ((c.conn_level = 0 AND c.via_group_link = 0) OR ct.contact_used = 1) + AND c.connection_id = ( + SELECT cc_connection_id FROM ( + SELECT + cc.connection_id AS cc_connection_id, + cc.created_at AS cc_created_at, + (CASE WHEN cc.conn_status = ? OR cc.conn_status = ? THEN 1 ELSE 0 END) AS cc_conn_status_ord + FROM connections cc + WHERE cc.user_id = ct.user_id AND cc.contact_id = ct.contact_id + ORDER BY cc_conn_status_ord DESC, cc_created_at DESC + LIMIT 1 + ) + ) ) + OR c.connection_id IS NULL ) ORDER BY i.item_ts DESC |] (CISRcvNew, userId, ConnReady, ConnSndReady) where - toDirectChatPreview :: UTCTime -> ContactRow :. ConnectionRow :. ChatStatsRow :. MaybeChatItemRow :. QuoteRow -> AChat + toDirectChatPreview :: UTCTime -> ContactRow :. MaybeConnectionRow :. ChatStatsRow :. MaybeChatItemRow :. QuoteRow -> AChat toDirectChatPreview currentTs (contactRow :. connRow :. statsRow :. ciRow_) = let contact = toContact user $ contactRow :. connRow ci_ = toDirectChatItemList currentTs ciRow_ diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 2ad447aa8..3f7378969 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -254,24 +254,15 @@ deleteUnusedIncognitoProfileById_ db User {userId} profileId = type ContactRow = (ContactId, ProfileId, ContactName, Maybe Int64, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, LocalAlias, Bool, ContactStatus) :. (Maybe MsgFilter, Maybe Bool, Bool, Maybe Preferences, Preferences, UTCTime, UTCTime, Maybe UTCTime, Maybe GroupMemberId, Bool) -toContact :: User -> ContactRow :. ConnectionRow -> Contact +toContact :: User -> ContactRow :. MaybeConnectionRow -> Contact toContact user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) = let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} - activeConn = toConnection connRow + activeConn = toMaybeConnection connRow chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} - mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn + incognito = maybe False connIncognito activeConn + mergedPreferences = contactUserPreferences user userPreferences preferences incognito in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} -toContactOrError :: User -> ContactRow :. MaybeConnectionRow -> Either StoreError Contact -toContactOrError user (((contactId, profileId, localDisplayName, viaGroup, displayName, fullName, image, contactLink, localAlias, contactUsed, contactStatus) :. (enableNtfs_, sendRcpts, favorite, preferences, userPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent)) :. connRow) = - let profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences, localAlias} - chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts, favorite} - in case toMaybeConnection connRow of - Just activeConn -> - let mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito activeConn - in Right Contact {contactId, localDisplayName, profile, activeConn, viaGroup, contactUsed, contactStatus, chatSettings, userPreferences, mergedPreferences, createdAt, updatedAt, chatTs, contactGroupMemberId, contactGrpInvSent} - _ -> Left $ SEContactNotReady localDisplayName - getProfileById :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalProfile getProfileById db userId profileId = ExceptT . firstRow toProfile (SEProfileNotFound profileId) $ diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 23ed60863..c92b25fb2 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -170,7 +170,7 @@ data Contact = Contact { contactId :: ContactId, localDisplayName :: ContactName, profile :: LocalProfile, - activeConn :: Connection, + activeConn :: Maybe Connection, viaGroup :: Maybe Int64, contactUsed :: Bool, contactStatus :: ContactStatus, @@ -189,32 +189,31 @@ instance ToJSON Contact where toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} -contactConn :: Contact -> Connection +contactConn :: Contact -> Maybe Connection contactConn Contact {activeConn} = activeConn -contactAgentConnId :: Contact -> AgentConnId -contactAgentConnId Contact {activeConn = Connection {agentConnId}} = agentConnId - -contactConnId :: Contact -> ConnId -contactConnId = aConnId . contactConn +contactConnId :: Contact -> Maybe ConnId +contactConnId c = aConnId <$> contactConn c type IncognitoEnabled = Bool contactConnIncognito :: Contact -> IncognitoEnabled -contactConnIncognito = connIncognito . contactConn +contactConnIncognito = maybe False connIncognito . contactConn contactDirect :: Contact -> Bool -contactDirect Contact {activeConn = Connection {connLevel, viaGroupLink}} = connLevel == 0 && not viaGroupLink +contactDirect Contact {activeConn} = maybe True direct activeConn + where + direct Connection {connLevel, viaGroupLink} = connLevel == 0 && not viaGroupLink directOrUsed :: Contact -> Bool directOrUsed ct@Contact {contactUsed} = contactDirect ct || contactUsed anyDirectOrUsed :: Contact -> Bool -anyDirectOrUsed Contact {contactUsed, activeConn = Connection {connLevel}} = connLevel == 0 || contactUsed +anyDirectOrUsed Contact {contactUsed, activeConn} = ((\c -> c.connLevel) <$> activeConn) == Just 0 || contactUsed contactReady :: Contact -> Bool -contactReady Contact {activeConn} = connReady activeConn +contactReady Contact {activeConn} = maybe False connReady activeConn contactActive :: Contact -> Bool contactActive Contact {contactStatus} = contactStatus == CSActive @@ -223,7 +222,7 @@ contactDeleted :: Contact -> Bool contactDeleted Contact {contactStatus} = contactStatus == CSDeleted contactSecurityCode :: Contact -> Maybe SecurityCode -contactSecurityCode Contact {activeConn} = connectionCode activeConn +contactSecurityCode Contact {activeConn} = connectionCode =<< activeConn data ContactStatus = CSActive diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 8494a7fc1..f1da12497 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -137,9 +137,11 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView CRGroupsList u gs -> ttyUser u $ viewGroupsList gs CRSentGroupInvitation u g c _ -> ttyUser 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] + case contactConn c of + Just Connection {viaGroupLink} + | viaGroupLink -> [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"] + | otherwise -> ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c] + Nothing -> [] CRFileTransferStatus u ftStatus -> ttyUser u $ viewFileTransferStatus ftStatus CRFileTransferStatusXFTP u ci -> ttyUser u $ viewFileTransferStatusXFTP ci CRUserProfile u p -> ttyUser u $ viewUserProfile p @@ -325,7 +327,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView testViewChats chats = [sShow $ map toChatView chats] where toChatView :: AChat -> (Text, Text, Maybe ConnStatus) - toChatView (AChat _ (Chat (DirectChat Contact {localDisplayName, activeConn}) items _)) = ("@" <> localDisplayName, toCIPreview items Nothing, Just $ connStatus activeConn) + toChatView (AChat _ (Chat (DirectChat Contact {localDisplayName, activeConn}) items _)) = ("@" <> localDisplayName, toCIPreview items Nothing, connStatus <$> activeConn) toChatView (AChat _ (Chat (GroupChat GroupInfo {membership, localDisplayName}) items _)) = ("#" <> localDisplayName, toCIPreview items (Just membership), Nothing) toChatView (AChat _ (Chat (ContactRequest UserContactRequest {localDisplayName}) items _)) = ("<@" <> localDisplayName, toCIPreview items Nothing, Nothing) toChatView (AChat _ (Chat (ContactConnection PendingContactConnection {pccConnId, pccConnStatus}) items _)) = (":" <> T.pack (show pccConnId), toCIPreview items Nothing, Just pccConnStatus) @@ -1038,10 +1040,10 @@ viewNetworkConfig NetworkConfig {socksProxy, tcpTimeout} = "use " <> highlight' "/network socks=[ timeout=]" <> " to change settings" ] -viewContactInfo :: Contact -> ConnectionStats -> Maybe Profile -> [StyledString] +viewContactInfo :: Contact -> Maybe ConnectionStats -> Maybe Profile -> [StyledString] viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, contactLink}, activeConn} stats incognitoProfile = ["contact ID: " <> sShow contactId] - <> viewConnectionStats stats + <> maybe [] viewConnectionStats stats <> maybe [] (\l -> ["contact address: " <> (plain . strEncode) (simplexChatContact l)]) contactLink <> maybe ["you've shared main profile with this contact"] @@ -1049,7 +1051,7 @@ viewContactInfo ct@Contact {contactId, profile = LocalProfile {localAlias, conta incognitoProfile <> ["alias: " <> plain localAlias | localAlias /= ""] <> [viewConnectionVerified (contactSecurityCode ct)] - <> [viewPeerChatVRange (peerChatVRange activeConn)] + <> maybe [] (\ac -> [viewPeerChatVRange (peerChatVRange ac)]) activeConn viewGroupInfo :: GroupInfo -> GroupSummary -> [StyledString] viewGroupInfo GroupInfo {groupId} s =