diff --git a/bots/api/EVENTS.md b/bots/api/EVENTS.md index 6633c58354..39801bcb5c 100644 --- a/bots/api/EVENTS.md +++ b/bots/api/EVENTS.md @@ -361,6 +361,7 @@ Another member left the group. - user: [User](./TYPES.md#user) - groupInfo: [GroupInfo](./TYPES.md#groupinfo) - member: [GroupMember](./TYPES.md#groupmember) +- msgSigned: bool --- diff --git a/packages/simplex-chat-client/types/typescript/src/events.ts b/packages/simplex-chat-client/types/typescript/src/events.ts index 178d11654a..4c569c1788 100644 --- a/packages/simplex-chat-client/types/typescript/src/events.ts +++ b/packages/simplex-chat-client/types/typescript/src/events.ts @@ -251,6 +251,7 @@ export namespace CEvt { user: T.User groupInfo: T.GroupInfo member: T.GroupMember + msgSigned: boolean } export interface DeletedMemberUser extends Interface { diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 3b28064790..903c5facaf 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -863,7 +863,7 @@ data ChatEvent | CEvtConnectedToGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember, memberContact :: Maybe Contact} | CEvtDeletedMember {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember, withMessages :: Bool, msgSigned :: Bool} | CEvtDeletedMemberUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember, withMessages :: Bool, msgSigned :: Bool} - | CEvtLeftMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember} + | CEvtLeftMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember, msgSigned :: Bool} | CEvtUnknownMemberCreated {user :: User, groupInfo :: GroupInfo, forwardedByMember :: GroupMember, member :: GroupMember} | CEvtUnknownMemberBlocked {user :: User, groupInfo :: GroupInfo, blockedByMember :: GroupMember, member :: GroupMember} | CEvtUnknownMemberAnnounced {user :: User, groupInfo :: GroupInfo, announcingMember :: GroupMember, unknownMember :: GroupMember, announcedMember :: GroupMember} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index 5aab0c5871..5fd75dc133 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -766,7 +766,7 @@ processChatCommand vr nm = \case assertUserGroupRole gInfo GRObserver -- can still delete messages sent earlier let msgIds = itemsMsgIds items events = L.nonEmpty $ map (\msgId -> XMsgDel msgId Nothing $ toMsgScope gInfo <$> chatScopeInfo) msgIds - mapM_ (sendGroupMessages user gInfo Nothing recipients) events + mapM_ (sendGroupMessages user gInfo Nothing False recipients) events -- TODO delGroupChatItems sends deletion events too. Are they needed? delGroupChatItems user gInfo chatScopeInfo items False pure $ CRChatItemsDeleted user deletions True False @@ -2000,17 +2000,18 @@ processChatCommand vr nm = \case Just sl -> pure sl Nothing -> throwChatError $ CEException "failed to retrieve relays: no short link" (FixedLinkData {linkConnReq = mainCReq@(CRContactUri crData), linkEntityId, rootKey}, ContactLinkData _ UserContactData {owners, relays}) <- getShortLinkConnReq nm user sLnk - -- Set group link info and incognito profile once before connecting to relays + -- Prepare group record once before connecting to relays (updatePreparedRelayedGroup): + -- set group link info and incognito profile, generate and store membership keys incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing let cReqHash = contactCReqHash $ CRContactUri crData {crScheme = SSSimplex} - gInfo' <- withFastStore $ \db -> setPreparedGroupLinkInfo db vr user gInfo mainCReq cReqHash incognitoProfile - forM_ linkEntityId $ \sharedGroupId -> do - gVar <- asks random - (_, memberPrivKey) <- liftIO $ atomically $ C.generateKeyPair gVar - withFastStore' $ \db -> updateGroupMemberKeys db groupId sharedGroupId rootKey memberPrivKey (groupMemberId' $ membership gInfo') - -- Pre-emptively create owner member with trusted key from link data - forM_ owners $ \OwnerAuth {ownerId, ownerKey} -> - withFastStore $ \db -> createLinkOwnerMember db vr user gInfo' (MemberId ownerId) ownerKey + gVar <- asks random + (_, memberPrivKey) <- liftIO $ atomically $ C.generateKeyPair gVar + gInfo' <- withFastStore $ \db -> do + gInfo' <- updatePreparedRelayedGroup db vr user gInfo mainCReq cReqHash incognitoProfile linkEntityId rootKey memberPrivKey + -- Pre-emptively create owner members with trusted keys from link data + forM_ owners $ \OwnerAuth {ownerId, ownerKey} -> + void $ createLinkOwnerMember db vr user gInfo' (MemberId ownerId) ownerKey + pure gInfo' rs <- mapConcurrently (connectToRelay gInfo') relays let relayFailed = \case (_, _, Left _) -> True; _ -> False (failed, succeeded) = partition relayFailed rs @@ -2576,7 +2577,7 @@ processChatCommand vr nm = \case Just memsToChange' -> do let events = L.map (\GroupMember {memberId} -> XGrpMemRole memberId newRole) memsToChange' recipients = filter memberCurrent members - (msgs_, _gsr) <- sendGroupMessages user gInfo Nothing recipients events + (msgs_, _gsr) <- sendGroupMessages user gInfo Nothing False recipients events let signed = any (either (const False) (isJust . signedMsg_)) msgs_ itemsData = zipWith (fmap . sndItemData) memsToChange (L.toList msgs_) cis_ <- saveSndChatItems user (CDGroupSnd gInfo Nothing) False itemsData Nothing False @@ -2705,7 +2706,7 @@ processChatCommand vr nm = \case Just memsToDelete' -> do let chatScope = toChatScope <$> chatScopeInfo events = L.map (\GroupMember {memberId} -> XGrpMemDel memberId withMessages) memsToDelete' - (msgs_, _gsr) <- sendGroupMessages user gInfo chatScope recipients events + (msgs_, _gsr) <- sendGroupMessages user gInfo chatScope False recipients events let signed = any (either (const False) (isJust . signedMsg_)) msgs_ itemsData_ = zipWith (fmap . sndItemData) memsToDelete (L.toList msgs_) skipUnwantedItem = \case @@ -3423,8 +3424,9 @@ processChatCommand vr nm = \case chatEvent <- case gInfo_ of Just (Just gInfo) | useRelays' gInfo -> do let GroupInfo {membership = GroupMember {memberId}} = gInfo - (memberPubKey, _memberPrivKey) <- atomically $ C.generateKeyPair g - -- TODO [member keys] store memberPrivKey in groups.member_priv_key, memberPubKey in group_members.member_pub_key + memberPubKey <- case groupKeys gInfo of + Just GroupKeys {memberPrivKey} -> pure $ C.publicKey memberPrivKey + Nothing -> throwChatError $ CEInternalError "no group keys for channel membership" pure $ XMember profileToSend memberId (MemberKey memberPubKey) _ -> pure $ XContact profileToSend (Just xContactId) welcomeSharedMsgId msg_ dm <- encodeConnInfoPQ pqSup chatV chatEvent @@ -4095,7 +4097,7 @@ processChatCommand vr nm = \case (fInvs_, ciFiles_) <- L.unzip <$> setupSndFileTransfers (length recipients) timed_ <- sndGroupCITimed live gInfo itemTTL (chatMsgEvents, quotedItems_) <- L.unzip <$> prepareMsgs (L.zip cmrs fInvs_) timed_ - (msgs_, gsr) <- sendGroupMessages user gInfo Nothing recipients chatMsgEvents + (msgs_, gsr) <- sendGroupMessages user gInfo Nothing showGroupAsSender recipients chatMsgEvents let itemsData = prepareSndItemsData (L.toList cmrs) (L.toList ciFiles_) (L.toList quotedItems_) (L.toList msgs_) cis_ <- saveSndChatItems user (CDGroupSnd gInfo chatScopeInfo) showGroupAsSender itemsData timed_ live when (length cis_ /= length cmrs) $ logError "sendGroupContentMessages: cmrs and cis_ length mismatch" diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index c3a28efe68..9c99b1d814 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -923,7 +923,7 @@ acceptContactRequestAsync liftIO $ setCommandConnId db user cmdId connId getContact db vr user contactId -acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember +acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> Maybe MemberKey -> CM GroupMember acceptGroupJoinRequestAsync user uclId @@ -936,11 +936,12 @@ acceptGroupJoinRequestAsync welcomeMsgId_ gAccepted gLinkMemRole - incognitoProfile = do + incognitoProfile + memberKey_ = do gVar <- asks random let initialStatus = acceptanceToStatus (memberAdmission groupProfile) gAccepted (groupMemberId, memberId) <- withStore $ \db -> - createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ cReqMemberId_ welcomeMsgId_ gLinkMemRole initialStatus + createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ cReqMemberId_ welcomeMsgId_ gLinkMemRole initialStatus memberKey_ let currentMemCount = fromIntegral $ currentMembers $ groupSummary gInfo let Profile {displayName} = userProfileInGroup user gInfo (fromIncognitoProfile <$> incognitoProfile) GroupMember {memberRole = userRole, memberId = userMemberId} = membership @@ -975,7 +976,7 @@ acceptGroupJoinSendRejectAsync rejectionReason = do gVar <- asks random (groupMemberId, memberId) <- withStore $ \db -> - createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ Nothing Nothing GRObserver GSMemRejected + createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ Nothing Nothing GRObserver GSMemRejected Nothing let GroupMember {memberRole = userRole, memberId = userMemberId} = membership msg = XGrpLinkReject $ @@ -1133,19 +1134,17 @@ memberIntroEvt gInfo reMember = mRestrictions = memberRestrictions reMember in XGrpMemIntro mInfo mRestrictions --- Used in groups with relays to introduce moderators and above to a new member. --- Member is not introduced to anybody: --- - in channels member will be prohibited to send, so it doesn't matter; --- - if member does send, recipients will create unknown member record; --- - later - to do member profile request protocol. +-- Used in groups with relays to introduce moderators and above to a new member, +-- and to announce the new member to moderators and above. -- This doesn't create introduction records in db, compared to above methods. -introduceModerators :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM () -introduceModerators _ _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active" -introduceModerators vr user gInfo GroupMember {activeConn = Just conn} = do +introduceInChannel :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM () +introduceInChannel _ _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active" +introduceInChannel vr user gInfo subscriber@GroupMember {activeConn = Just conn} = do modMs <- withStore' $ \db -> getGroupModerators db vr user gInfo - let events = map (memberIntroEvt gInfo) modMs - forM_ (L.nonEmpty events) $ \events' -> - sendGroupMemberMessages user gInfo conn events' + void $ sendGroupMessage' user gInfo modMs $ XGrpMemNew (memberInfo gInfo subscriber) Nothing + let introEvts = map (memberIntroEvt gInfo) modMs + forM_ (L.nonEmpty introEvts) $ \introEvts' -> + sendGroupMemberMessages user gInfo conn introEvts' userProfileInGroup :: User -> GroupInfo -> Maybe Profile -> Profile userProfileInGroup user = userProfileInGroup' user . groupFeatureUserAllowed SGFSimplexLinks @@ -1996,7 +1995,7 @@ deliverMessagesB msgReqs = do sendGroupMessage :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> [GroupMember] -> ChatMsgEvent e -> CM SndMessage sendGroupMessage user gInfo gcScope members chatMsgEvent = do - sendGroupMessages user gInfo gcScope members (chatMsgEvent :| []) >>= \case + sendGroupMessages user gInfo gcScope False members (chatMsgEvent :| []) >>= \case ((Right msg) :| [], _) -> pure msg _ -> throwChatError $ CEInternalError "sendGroupMessage: expected 1 message" @@ -2006,8 +2005,8 @@ sendGroupMessage' user gInfo members chatMsgEvent = ((Right msg) :| [], _) -> pure msg _ -> throwChatError $ CEInternalError "sendGroupMessage': expected 1 message" -sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult) -sendGroupMessages user gInfo scope members events = do +sendGroupMessages :: MsgEncodingI e => User -> GroupInfo -> Maybe GroupChatScope -> ShowGroupAsSender -> [GroupMember] -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult) +sendGroupMessages user gInfo scope asGroup members events = do -- TODO [knocking] send current profile to pending member after approval? when shouldSendProfileUpdate $ sendProfileUpdate `catchAllErrors` eToView @@ -2016,6 +2015,7 @@ sendGroupMessages user gInfo scope members events = do User {profile = p, userMemberProfileUpdatedAt} = user GroupInfo {userMemberProfileSentAt} = gInfo shouldSendProfileUpdate + | asGroup = False | isJust scope = False -- why not sending profile updates to scopes? | incognitoMembership gInfo = False | otherwise = diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 3a8fd2f5c6..28e00fea8f 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -853,7 +853,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = when (connChatVersion < batchSend2Version) $ getAutoReplyMsg >>= mapM_ (\mc -> sendGroupAutoReply mc Nothing) if useRelays' gInfo'' then do - introduceModerators vr user gInfo'' m' + introduceInChannel vr user gInfo'' m' when (groupFeatureAllowed SGFHistory gInfo'') $ sendHistory user gInfo'' m' else case mStatus of GSMemPendingApproval -> pure () @@ -941,8 +941,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = pure newDeliveryTasks processEvent :: forall e. MsgEncodingI e => GroupInfo -> GroupMember -> VerifiedMsg e -> CM (Maybe NewMessageDeliveryTask) processEvent gInfo' m' verifiedMsg = do - let chatMsg = verifiedChatMsg verifiedMsg - (m'', conn', msg@RcvMessage {msgId, msgSigned, chatMsgEvent = ACME _ event}) <- saveGroupRcvMsg user groupId m' conn msgMeta verifiedMsg + (m'', conn', msg@RcvMessage {msgId, chatMsgEvent = ACME _ event}) <- saveGroupRcvMsg user groupId m' conn msgMeta verifiedMsg let ctx js = DeliveryTaskContext js False checkSendAsGroup :: Maybe Bool -> CM (Maybe DeliveryTaskContext) -> CM (Maybe DeliveryTaskContext) checkSendAsGroup asGroup_ a @@ -968,7 +967,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = XFile fInv -> Nothing <$ processGroupFileInvitation' gInfo' m'' fInv msg brokerTs XFileCancel sharedMsgId -> xFileCancelGroup gInfo' (Just m'') sharedMsgId XFileAcptInv sharedMsgId fileConnReq_ fName -> Nothing <$ xFileAcptInvGroup gInfo' m'' sharedMsgId fileConnReq_ fName - XInfo p -> fmap ctx <$> xInfoMember gInfo' m'' p brokerTs + XInfo p -> fmap ctx <$> xInfoMember gInfo' m'' p msg brokerTs XGrpLinkMem p memberKey -> Nothing <$ xGrpLinkMem gInfo' m'' conn' p memberKey XGrpLinkAcpt acceptance role memberId -> Nothing <$ xGrpLinkAcpt gInfo' m'' acceptance role memberId msg brokerTs XGrpMemNew memInfo msgScope -> fmap ctx <$> xGrpMemNew gInfo' m'' memInfo msgScope msg brokerTs @@ -984,7 +983,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = XGrpLeave -> fmap ctx <$> xGrpLeave gInfo' m'' msg brokerTs XGrpDel -> Just (DeliveryTaskContext (DJSGroup {jobSpec = DJRelayRemoved}) False) <$ xGrpDel gInfo' m'' msg brokerTs XGrpInfo p' -> fmap ctx <$> xGrpInfo gInfo' m'' p' msg brokerTs - XGrpPrefs ps' -> fmap ctx <$> xGrpPrefs msgSigned gInfo' m'' ps' + XGrpPrefs ps' -> fmap ctx <$> xGrpPrefs gInfo' m'' ps' msg -- TODO [knocking] why don't we forward these messages? XGrpDirectInv connReq mContent_ msgScope -> memberCanSend (Just m'') msgScope $ Nothing <$ xGrpDirectInv gInfo' m'' conn' connReq mContent_ msg brokerTs XGrpMsgForward fwd msg' -> Nothing <$ xGrpMsgForward gInfo' Nothing m'' fwd (ParsedMsg Nothing Nothing msg') brokerTs @@ -1107,9 +1106,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = let GroupMember {memberId = membershipMemId} = membership incognitoProfile = fromLocalProfile <$> incognitoMembershipProfile gInfo profileToSend = userProfileInGroup user gInfo incognitoProfile - g <- asks random - (memberPubKey, _memberPrivKey) <- atomically $ C.generateKeyPair g - -- TODO [member keys] store memberPrivKey in groups.member_priv_key, memberPubKey in group_members.member_pub_key + memberPubKey <- case groupKeys gInfo of + Just GroupKeys {memberPrivKey} -> pure $ C.publicKey memberPrivKey + Nothing -> throwChatError $ CEInternalError "no group keys for channel membership" dm <- encodeConnInfo $ XMember profileToSend membershipMemId (MemberKey memberPubKey) subMode <- chatReadVar subscriptionMode void $ joinAgentConnectionAsync user (Just conn) True cReq dm subMode @@ -1418,7 +1417,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = messageError "processContactConnMessage: chat version range incompatible for accepting group join request" | otherwise -> do let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo - mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p xContactId_ Nothing welcomeMsgId_ acceptance useRole profileMode + mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p xContactId_ Nothing welcomeMsgId_ acceptance useRole profileMode Nothing (gInfo', mem', scopeInfo) <- mkGroupChatScope gInfo mem createInternalChatItem user (CDGroupRcv gInfo' scopeInfo mem') (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing toView $ CEvtAcceptingGroupJoinRequestMember user gInfo' mem' @@ -1435,18 +1434,22 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = -- TODO [relays] owner, relays: TBC how to communicate member rejection rules from owner to relays -- TODO [relays] relay: TBC communicate rejection when memberId already exists (currently checked in createJoiningMember) memberJoinRequestViaRelay :: InvitationId -> VersionRangeChat -> Profile -> MemberId -> MemberKey -> CM () - memberJoinRequestViaRelay invId chatVRange p joiningMemberId _joiningMemberKey = do -- TODO [member keys] store memberKey in group_members.member_pub_key + memberJoinRequestViaRelay invId chatVRange p joiningMemberId joiningMemberKey = do (_ucl, gLinkInfo_) <- withStore $ \db -> getUserContactLinkById db userId uclId case gLinkInfo_ of Just GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do gInfo <- withStore $ \db -> getGroupInfo db vr user groupId - mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p Nothing (Just joiningMemberId) Nothing GAAccepted gLinkMemRole Nothing + mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p Nothing (Just joiningMemberId) Nothing GAAccepted gLinkMemRole Nothing (Just joiningMemberKey) (gInfo', mem', scopeInfo) <- mkGroupChatScope gInfo mem createInternalChatItem user (CDGroupRcv gInfo' scopeInfo mem') (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing toView $ CEvtAcceptingGroupJoinRequestMember user gInfo' mem' Nothing -> messageError "memberJoinRequestViaRelay: no group link info for relay link" + muteEventInChannel :: GroupInfo -> GroupMember -> Bool + muteEventInChannel gInfo@GroupInfo {membership} m = + useRelays' gInfo && memberRole' membership < GRModerator && not (isRelay membership) && memberRole' m < GRModerator + memberCanSend :: Maybe GroupMember -> Maybe MsgScope -> CM (Maybe DeliveryTaskContext) -> CM (Maybe DeliveryTaskContext) memberCanSend Nothing _ a = a -- channel message - was previously checked and allowed by relay memberCanSend (Just m@GroupMember {memberRole}) msgScope a = case msgScope of @@ -2394,9 +2397,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Profile {displayName = n, fullName = fn, shortDescr = sd, image = i, contactLink = cl} = p Profile {displayName = n', fullName = fn', shortDescr = sd', image = i', contactLink = cl'} = p' - xInfoMember :: GroupInfo -> GroupMember -> Profile -> UTCTime -> CM (Maybe DeliveryJobScope) - xInfoMember gInfo m p' brokerTs = do - void $ processMemberProfileUpdate gInfo m p' True (Just brokerTs) + xInfoMember :: GroupInfo -> GroupMember -> Profile -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope) + xInfoMember gInfo m p' msg brokerTs = do + void $ processMemberProfileUpdate gInfo m p' (Just (msg, brokerTs)) pure $ memberEventDeliveryScope m xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> Maybe MemberKey -> CM () @@ -2404,7 +2407,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = xGrpLinkMemReceived <- withStore $ \db -> getXGrpLinkMemReceived db groupMemberId if (viaGroupLink || isJust businessChat) && isNothing (memberContactId m) && memberCategory == GCHostMember && not xGrpLinkMemReceived then do - m' <- processMemberProfileUpdate gInfo m p' False Nothing + m' <- processMemberProfileUpdate gInfo m p' Nothing withStore' $ \db -> setXGrpLinkMemReceived db groupMemberId True memberKey_ let connectedIncognito = memberIncognito membership probeMatchingMemberContact m' connectedIncognito @@ -2468,24 +2471,26 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = where expectHistory = groupFeatureAllowed SGFHistory gInfo && m `supportsVersion` groupHistoryIncludeWelcomeVersion - processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Bool -> Maybe UTCTime -> CM GroupMember - processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' createItems itemTs_ + processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Maybe (RcvMessage, UTCTime) -> CM GroupMember + processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' msgTs_ | redactedMemberProfile allowSimplexLinks (fromLocalProfile p) /= redactedMemberProfile allowSimplexLinks p' = do updateBusinessChatProfile gInfo case memberContactId of Nothing -> do m' <- withStore $ \db -> updateMemberProfile db user m p' - createProfileUpdatedItem m' - toView $ CEvtGroupMemberUpdated user gInfo m m' + unless (muteEventInChannel gInfo m') $ do + forM_ msgTs_ $ createProfileUpdatedItem m' + toView $ CEvtGroupMemberUpdated user gInfo m m' pure m' Just mContactId -> do mCt <- withStore $ \db -> getContact db vr user mContactId if canUpdateProfile mCt then do (m', ct') <- withStore $ \db -> updateContactMemberProfile db user m mCt p' - createProfileUpdatedItem m' - toView $ CEvtGroupMemberUpdated user gInfo m m' - toView $ CEvtContactUpdated user mCt ct' + unless (muteEventInChannel gInfo m') $ do + forM_ msgTs_ $ createProfileUpdatedItem m' + toView $ CEvtGroupMemberUpdated user gInfo m m' + toView $ CEvtContactUpdated user mCt ct' pure m' else pure m where @@ -2506,11 +2511,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = isMainBusinessMember BusinessChatInfo {chatType, businessId, customerId} GroupMember {memberId} = case chatType of BCBusiness -> businessId == memberId BCCustomer -> customerId == memberId - createProfileUpdatedItem m' = - when createItems $ do - (gInfo', m'', scopeInfo) <- mkGroupChatScope gInfo m' - let ciContent = CIRcvGroupEvent $ RGEMemberProfileUpdated (fromLocalProfile p) p' - createInternalChatItem user (CDGroupRcv gInfo' scopeInfo m'') ciContent itemTs_ + createProfileUpdatedItem m' (msg, brokerTs) = do + (gInfo', m'', scopeInfo) <- mkGroupChatScope gInfo m' + let ciContent = CIRcvGroupEvent $ RGEMemberProfileUpdated (fromLocalProfile p) p' + cd = CDGroupRcv gInfo' scopeInfo m'' + (ci, cInfo) <- saveRcvChatItemNoParse user cd msg brokerTs ciContent + groupMsgToView cInfo ci xInfoProbe :: ContactOrMember -> Probe -> CM () xInfoProbe cgm2 probe = do @@ -2746,7 +2752,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = xGrpMemNew :: GroupInfo -> GroupMember -> MemberInfo -> Maybe MsgScope -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope) xGrpMemNew gInfo m memInfo@(MemberInfo memId memRole _ _ _) msgScope_ msg brokerTs = do - checkHostRole m memRole + unless (useRelays' gInfo && isRelay m) $ checkHostRole m memRole if sameMemberId memId (membership gInfo) then pure Nothing else do @@ -2762,7 +2768,9 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = toView $ CEvtUnknownMemberAnnounced user gInfo' m unknownMember updatedMember memberAnnouncedToView updatedMember gInfo' pure $ deliveryJobScope updatedMember - Right _ -> messageError "x.grp.mem.new error: member already exists" $> Nothing + Right _ + | useRelays' gInfo -> logInfo "x.grp.mem.new: member already created via another relay" $> Nothing + | otherwise -> messageError "x.grp.mem.new error: member already exists" $> Nothing Left _ -> do (newMember, gInfo') <- withStore $ \db -> do newMember <- createNewGroupMember db user gInfo m memInfo GCPostMember initialStatus @@ -2804,7 +2812,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case Right existingMember | useRelays' gInfo -> - void $ withStore $ \db -> updateIntroducedMember db vr user existingMember memInfo + void $ withStore $ \db -> updatePreparedChannelMember db vr user existingMember memInfo | otherwise -> messageError "x.grp.mem.intro ignored: member already exists" Left _ @@ -2914,22 +2922,24 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = | membershipMemId == memId = pure Nothing -- ignore - XGrpMemRestrict can be sent to restricted member for efficiency | otherwise = do unknownRole <- unknownMemberRole gInfo - (bm, unknown) <- withStore $ \db -> getCreateUnknownGMByMemberId db vr user gInfo memId "" unknownRole - let GroupMember {groupMemberId = bmId, memberRole, blockedByAdmin, memberProfile = bmp} = bm - if - | blockedByAdmin == mrsBlocked restriction -> pure Nothing - | senderRole < GRModerator || senderRole < memberRole -> - messageError "x.grp.mem.restrict with insufficient member permissions" $> Nothing - | otherwise -> do - bm' <- setMemberBlocked bm - toggleNtf bm' (not blocked) - let ciContent = CIRcvGroupEvent $ RGEMemberBlocked bmId (fromLocalProfile bmp) blocked - (gInfo', m', scopeInfo) <- mkGroupChatScope gInfo m - (ci, cInfo) <- saveRcvChatItemNoParse user (CDGroupRcv gInfo' scopeInfo m') msg brokerTs ciContent - when unknown $ toView $ CEvtUnknownMemberBlocked user gInfo m bm' - groupMsgToView cInfo ci - toView CEvtMemberBlockedForAll {user, groupInfo = gInfo', byMember = m', member = bm', blocked, msgSigned} - pure $ memberEventDeliveryScope bm + withStore (\db -> getCreateUnknownGMByMemberId db vr user gInfo memId "" unknownRole True) >>= \case + Nothing -> messageError "x.grp.mem.restrict: no member" $> Nothing -- shouldn't happen + Just (bm, unknown) -> do + let GroupMember {groupMemberId = bmId, memberRole, blockedByAdmin, memberProfile = bmp} = bm + if + | blockedByAdmin == mrsBlocked restriction -> pure Nothing + | senderRole < GRModerator || senderRole < memberRole -> + messageError "x.grp.mem.restrict with insufficient member permissions" $> Nothing + | otherwise -> do + bm' <- setMemberBlocked bm + toggleNtf bm' (not blocked) + let ciContent = CIRcvGroupEvent $ RGEMemberBlocked bmId (fromLocalProfile bmp) blocked + (gInfo', m', scopeInfo) <- mkGroupChatScope gInfo m + (ci, cInfo) <- saveRcvChatItemNoParse user (CDGroupRcv gInfo' scopeInfo m') msg brokerTs ciContent + when unknown $ toView $ CEvtUnknownMemberBlocked user gInfo m bm' + groupMsgToView cInfo ci + toView CEvtMemberBlockedForAll {user, groupInfo = gInfo', byMember = m', member = bm', blocked, msgSigned} + pure $ memberEventDeliveryScope bm where setMemberBlocked bm = withStore' $ \db -> updateGroupMemberBlocked db user gInfo restriction bm blocked = mrsBlocked restriction @@ -3016,14 +3026,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = | otherwise = pure GRAuthor xGrpLeave :: GroupInfo -> GroupMember -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope) - xGrpLeave gInfo m msg brokerTs = do + xGrpLeave gInfo m msg@RcvMessage {msgSigned} brokerTs = do deleteMemberConnection m -- member record is not deleted to allow creation of "member left" chat item gInfo' <- updateMemberRecordDeleted user gInfo m GSMemLeft - (gInfo'', m', scopeInfo) <- mkGroupChatScope gInfo' m - (ci, cInfo) <- saveRcvChatItemNoParse user (CDGroupRcv gInfo'' scopeInfo m') msg brokerTs (CIRcvGroupEvent RGEMemberLeft) - groupMsgToView cInfo ci - toView $ CEvtLeftMember user gInfo'' m' {memberStatus = GSMemLeft} + unless (muteEventInChannel gInfo' m) $ do + (gInfo'', m', scopeInfo) <- mkGroupChatScope gInfo' m + (ci, cInfo) <- saveRcvChatItemNoParse user (CDGroupRcv gInfo'' scopeInfo m') msg brokerTs (CIRcvGroupEvent RGEMemberLeft) + groupMsgToView cInfo ci + toView $ CEvtLeftMember user gInfo'' m' {memberStatus = GSMemLeft} msgSigned pure $ memberEventDeliveryScope m xGrpDel :: GroupInfo -> GroupMember -> RcvMessage -> UTCTime -> CM () @@ -3056,8 +3067,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Just _ -> updateGroupPrefs_ msgSigned g m $ fromMaybe defaultBusinessGroupPrefs $ groupPreferences p' pure $ Just DJSGroup {jobSpec = DJDeliveryJob {includePending = True}} - xGrpPrefs :: Bool -> GroupInfo -> GroupMember -> GroupPreferences -> CM (Maybe DeliveryJobScope) - xGrpPrefs msgSigned g m@GroupMember {memberRole} ps' + xGrpPrefs :: GroupInfo -> GroupMember -> GroupPreferences -> RcvMessage -> CM (Maybe DeliveryJobScope) + xGrpPrefs g m@GroupMember {memberRole} ps' RcvMessage {msgSigned} | memberRole < GROwner = messageError "x.grp.prefs with insufficient member permissions" $> Nothing | otherwise = updateGroupPrefs_ msgSigned g m ps' $> Just DJSGroup {jobSpec = DJDeliveryJob {includePending = True}} @@ -3165,17 +3176,20 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case fwdSender of FwdMember memberId memberName -> do unknownRole <- unknownMemberRole gInfo - (author, unknown) <- withStore $ \db -> getCreateUnknownGMByMemberId db vr user gInfo memberId memberName unknownRole - when unknown $ toView $ CEvtUnknownMemberCreated user gInfo m author - void $ withVerifiedMsg gInfo scopeInfo author parsedMsg msgTs $ - (`processForwardedMsg` Just author) + let allowCreate = toCMEventTag chatMsgEvent /= XGrpLeave_ + withStore (\db -> getCreateUnknownGMByMemberId db vr user gInfo memberId memberName unknownRole allowCreate) >>= \case + Just (author, unknown) -> do + when unknown $ toView $ CEvtUnknownMemberCreated user gInfo m author + void $ withVerifiedMsg gInfo scopeInfo author parsedMsg msgTs $ + (`processForwardedMsg` Just author) + Nothing -> pure () FwdChannel -> processForwardedMsg (VMUnsigned chatMsg) Nothing where -- ! see isForwardedGroupMsg: forwarded group events should include msgId to be deduplicated processForwardedMsg :: VerifiedMsg 'Json -> Maybe GroupMember -> CM () processForwardedMsg verifiedMsg author_ = do rcvMsg_ <- saveGroupFwdRcvMsg user gInfo m author_ verifiedMsg brokerTs - forM_ rcvMsg_ $ \rcvMsg@RcvMessage {msgSigned, chatMsgEvent = ACME _ event} -> case event of + forM_ rcvMsg_ $ \rcvMsg@RcvMessage {chatMsgEvent = ACME _ event} -> case event of XMsgNew mc -> void $ memberCanSend author_ scope $ newGroupContentMessage gInfo author_ mc rcvMsg msgTs True where @@ -3187,14 +3201,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = XMsgDel sharedMsgId memId scope_ -> void $ groupMessageDelete gInfo author_ sharedMsgId memId scope_ rcvMsg msgTs XMsgReact sharedMsgId memId scope_ reaction add -> withAuthor XMsgReact_ $ \author -> void $ groupMsgReaction gInfo author sharedMsgId memId scope_ reaction add rcvMsg msgTs XFileCancel sharedMsgId -> void $ xFileCancelGroup gInfo author_ sharedMsgId - XInfo p -> withAuthor XInfo_ $ \author -> void $ xInfoMember gInfo author p msgTs + XInfo p -> withAuthor XInfo_ $ \author -> void $ xInfoMember gInfo author p rcvMsg msgTs XGrpMemNew memInfo msgScope -> withAuthor XGrpMemNew_ $ \author -> void $ xGrpMemNew gInfo author memInfo msgScope rcvMsg msgTs XGrpMemRole memId memRole -> withAuthor XGrpMemRole_ $ \author -> void $ xGrpMemRole gInfo author memId memRole rcvMsg msgTs + XGrpMemRestrict memId memRestrictions -> withAuthor XGrpMemRestrict_ $ \author -> void $ xGrpMemRestrict gInfo author memId memRestrictions rcvMsg msgTs XGrpMemDel memId withMessages -> withAuthor XGrpMemDel_ $ \author -> void $ xGrpMemDel gInfo author memId withMessages verifiedMsg rcvMsg msgTs True XGrpLeave -> withAuthor XGrpLeave_ $ \author -> void $ xGrpLeave gInfo author rcvMsg msgTs XGrpDel -> withAuthor XGrpDel_ $ \author -> void $ xGrpDel gInfo author rcvMsg msgTs XGrpInfo p' -> withAuthor XGrpInfo_ $ \author -> void $ xGrpInfo gInfo author p' rcvMsg msgTs - XGrpPrefs ps' -> withAuthor XGrpPrefs_ $ \author -> void $ xGrpPrefs msgSigned gInfo author ps' + XGrpPrefs ps' -> withAuthor XGrpPrefs_ $ \author -> void $ xGrpPrefs gInfo author ps' rcvMsg _ -> messageError $ "x.grp.msg.forward: unsupported forwarded event " <> T.pack (show $ toCMEventTag event) where withAuthor :: CMEventTag e -> (GroupMember -> CM ()) -> CM () @@ -3203,7 +3218,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = Nothing -> messageError $ "x.grp.msg.forward: event " <> tshow tag <> " requires author" withVerifiedMsg :: MsgEncodingI e => GroupInfo -> Maybe GroupChatScopeInfo -> GroupMember -> ParsedMsg e -> UTCTime -> (VerifiedMsg e -> CM a) -> CM (Maybe a) - withVerifiedMsg gInfo scopeInfo member (ParsedMsg _ signedMsg_ chatMsg@ChatMessage {chatMsgEvent}) ts action + withVerifiedMsg gInfo@GroupInfo {membership} scopeInfo member (ParsedMsg _ signedMsg_ chatMsg@ChatMessage {chatMsgEvent}) ts action | verified = Just <$> action verifiedMsg | otherwise = do createInternalChatItem user (CDGroupRcv gInfo scopeInfo member) (CIRcvGroupEvent RGEMsgBadSignature) (Just ts) @@ -3219,10 +3234,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = CBGroup | Just GroupKeys {groupRootKey} <- groupKeys gInfo -> let prefix = smpEncode chatBinding <> smpEncode (groupRootPubKey groupRootKey, memberId) in all (\(MsgSignature KRMember sig) -> C.verify (C.APublicVerifyKey C.SEd25519 pubKey) sig (prefix <> signedBody)) signatures - _ -> False - | otherwise -> signatureOptional + _ -> signatureOptional + | otherwise -> signatureOptional || unverifiedAllowed membership member tag Nothing -> signatureOptional - signatureOptional = not (useRelays' gInfo && requiresSignature (toCMEventTag chatMsgEvent)) + where + tag = toCMEventTag chatMsgEvent + signatureOptional = not (useRelays' gInfo) || not (requiresSignature tag) directMsgReceived :: Contact -> Connection -> MsgMeta -> NonEmpty MsgReceipt -> CM () directMsgReceived ct conn@Connection {connId} msgMeta msgRcpts = do diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index a74dde3f06..f1b5aceeec 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -38,7 +38,7 @@ import Data.Either (fromRight) import qualified Data.List.NonEmpty as L import Data.Map.Strict (Map) import qualified Data.Map.Strict as M -import Data.Maybe (fromMaybe, isJust) +import Data.Maybe (fromMaybe, isJust, isNothing) import Data.String import Data.Text (Text) import qualified Data.Text as T @@ -1191,7 +1191,7 @@ hasDeliveryReceipt = \case XCallInv_ -> True _ -> False --- | Admin events that must have a valid signature in relay groups. +-- | Events that must have a valid signature in relay groups. requiresSignature :: CMEventTag e -> Bool requiresSignature = \case XGrpDel_ -> True @@ -1200,8 +1200,28 @@ requiresSignature = \case XGrpMemDel_ -> True XGrpMemRole_ -> True XGrpMemRestrict_ -> True + XGrpLeave_ -> True + XInfo_ -> True _ -> False +-- TODO [relays] relay: vectors tracking which members received which other member profiles/keys. +-- TODO - don't forward XGrpLeave/XInfo to members who haven't seen sender's profile/key. +-- TODO - unverifiedAllowed is a temporary workaround postponing targeted event forwarding. + +-- Allow signed but unverified XGrpLeave/XInfo between subscribers when sender's key is unknown. +-- Owner keys are always known, so subscribers are required to verify from owners. +-- Likewise, subscriber keys are always known to owners, so owners are required to verify from subscribers. +unverifiedAllowed :: GroupMember -> GroupMember -> CMEventTag e -> Bool +unverifiedAllowed membership member = \case + XGrpLeave_ -> membersNoKey + XInfo_ -> membersNoKey + _ -> False + where + membersNoKey = + memberRole' membership < GRModerator + && memberRole' member < GRModerator + && isNothing (memberPubKey member) + appBinaryToCM :: AppMessageBinary -> Either String (ChatMessage 'Binary) appBinaryToCM AppMessageBinary {msgId, tag, body} = do eventTag <- strDecode $ B.singleton tag diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 3254ae817a..991e2eaac1 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -179,7 +179,7 @@ createConnReqConnection db userId acId preparedEntity_ cReq cReqHash sLnk xConta ) connId <- insertedRowId db case preparedEntity_ of - -- For relay groups, setPreparedGroupLinkInfo is called before the relay loop + -- For relay groups, setPreparedGroupLinkInfo_ is called via updatePreparedRelayedGroup before the relay loop Just (PCEGroup gInfo _) | not (useRelays' gInfo) -> setPreparedGroupLinkInfo_ db gInfo cReq cReqHash customUserProfileId currentTs _ -> pure () diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 323b23449e..8d53bbcbf9 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -100,6 +100,7 @@ module Simplex.Chat.Store.Groups getMemberInvitation, createMemberConnection, createMemberConnectionAsync, + updatePreparedRelayedGroup, updateGroupMemberKeys, updateRelayGroupKeys, updateGroupMemberStatus, @@ -151,7 +152,7 @@ module Simplex.Chat.Store.Groups setXGrpLinkMemReceived, createNewUnknownGroupMember, createLinkOwnerMember, - updateIntroducedMember, + updatePreparedChannelMember, updateUnknownMemberAnnounced, updateUserMemberProfileSentAt, setGroupCustomData, @@ -1090,14 +1091,16 @@ getGroupMemberByMemberId db vr user GroupInfo {groupId} memberId = (groupMemberQuery <> " WHERE m.group_id = ? AND m.member_id = ?") (groupId, memberId) -getCreateUnknownGMByMemberId :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> ContactName -> GroupMemberRole -> ExceptT StoreError IO (GroupMember, Bool) -getCreateUnknownGMByMemberId db vr user gInfo memberId memberName unknownMemberRole = do +getCreateUnknownGMByMemberId :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> ContactName -> GroupMemberRole -> Bool -> ExceptT StoreError IO (Maybe (GroupMember, Bool)) +getCreateUnknownGMByMemberId db vr user gInfo memberId memberName unknownMemberRole allowCreate = do liftIO (runExceptT $ getGroupMemberByMemberId db vr user gInfo memberId) >>= \case - Right m -> pure (m, False) - Left (SEGroupMemberNotFoundByMemberId _) -> do - let name = if T.null memberName then nameFromMemberId memberId else memberName - m <- createNewUnknownGroupMember db vr user gInfo memberId name unknownMemberRole - pure (m, True) + Right m -> pure $ Just (m, False) + Left (SEGroupMemberNotFoundByMemberId _) + | allowCreate -> do + let name = if T.null memberName then nameFromMemberId memberId else memberName + m <- createNewUnknownGroupMember db vr user gInfo memberId name unknownMemberRole + pure $ Just (m, True) + | otherwise -> pure Nothing Left e -> throwError e getScopeMemberIdViaMemberId :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberId -> ExceptT StoreError IO GroupMemberId @@ -1522,7 +1525,7 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo :. (minV, maxV) ) -createJoiningMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupMemberRole -> GroupMemberStatus -> ExceptT StoreError IO (GroupMemberId, MemberId) +createJoiningMember :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupMemberRole -> GroupMemberStatus -> Maybe MemberKey -> ExceptT StoreError IO (GroupMemberId, MemberId) createJoiningMember db gVar @@ -1534,7 +1537,8 @@ createJoiningMember cReqMemberId_ welcomeMsgId_ memberRole - memberStatus = do + memberStatus + memberKey_ = do currentTs <- liftIO getCurrentTime ExceptT . withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do liftIO $ @@ -1561,6 +1565,7 @@ createJoiningMember checkMemberNotExists memberId = do exists <- liftIO $ fromOnly . head <$> DB.query db "SELECT EXISTS (SELECT 1 FROM group_members WHERE group_id = ? AND member_id = ?)" (groupId, memberId) when exists $ throwError SEDuplicateMemberId + memberPubKey_ = (\(MemberKey k) -> k) <$> memberKey_ insertMember_ ldn profileId memberId currentTs = do indexInGroup <- getUpdateNextIndexInGroup_ db groupId liftIO $ @@ -1569,12 +1574,12 @@ createJoiningMember [sql| INSERT INTO group_members ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id, - user_id, local_display_name, contact_id, contact_profile_id, member_xcontact_id, member_welcome_shared_msg_id, created_at, updated_at, + user_id, local_display_name, contact_id, contact_profile_id, member_pub_key, member_xcontact_id, member_welcome_shared_msg_id, created_at, updated_at, peer_chat_min_version, peer_chat_max_version) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] ( (groupId, indexInGroup, memberId, memberRole, GCInviteeMember, memberStatus, Binary B.empty, fromInvitedBy userContactId IBUser, groupMemberId' membership) - :. (userId, ldn, Nothing :: (Maybe Int64), profileId, cReqXContactId_, welcomeMsgId_, currentTs, currentTs) + :. (userId, ldn, Nothing :: (Maybe Int64), profileId, memberPubKey_, cReqXContactId_, welcomeMsgId_, currentTs, currentTs) :. (minV, maxV) ) @@ -1698,13 +1703,27 @@ createMemberConnectionAsync db user@User {userId} groupMemberId (cmdId, agentCon Connection {connId} <- createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange Nothing 0 currentTs subMode setCommandConnId db user cmdId connId -updateGroupMemberKeys :: DB.Connection -> GroupId -> ByteString -> C.PublicKeyEd25519 -> C.PrivateKeyEd25519 -> GroupMemberId -> IO () -updateGroupMemberKeys db groupId sharedGroupId rootPubKey memberPrivKey membershipGMId = do +-- Set group link info, incognito profile, membership keys before connecting to relays. +-- This is called once before connecting to relays, unlike createConnReqConnection -> setPreparedGroupLinkInfo_, +-- which is used in single-connection flows. +updatePreparedRelayedGroup :: + DB.Connection -> VersionRangeChat -> User -> GroupInfo -> ConnReqContact -> ConnReqUriHash -> Maybe Profile -> + Maybe ByteString -> C.PublicKeyEd25519 -> C.PrivateKeyEd25519 -> + ExceptT StoreError IO GroupInfo +updatePreparedRelayedGroup db vr user@User {userId} gInfo cReq cReqHash incognitoProfile linkEntityId rootPubKey memberPrivKey = do + currentTs <- liftIO getCurrentTime + customUserProfileId <- liftIO $ mapM (createIncognitoProfile_ db userId currentTs) incognitoProfile + liftIO $ setPreparedGroupLinkInfo_ db gInfo cReq cReqHash customUserProfileId currentTs + liftIO $ updateGroupMemberKeys db (groupId' gInfo) linkEntityId rootPubKey memberPrivKey (groupMemberId' $ membership gInfo) + getGroupInfo db vr user (groupId' gInfo) + +updateGroupMemberKeys :: DB.Connection -> GroupId -> Maybe ByteString -> C.PublicKeyEd25519 -> C.PrivateKeyEd25519 -> GroupMemberId -> IO () +updateGroupMemberKeys db groupId linkEntityId rootPubKey memberPrivKey membershipGMId = do currentTs <- getCurrentTime DB.execute db "UPDATE groups SET shared_group_id = ?, root_pub_key = ?, member_priv_key = ?, updated_at = ? WHERE group_id = ?" - (Binary sharedGroupId, rootPubKey, memberPrivKey, currentTs, groupId) + (Binary <$> linkEntityId, rootPubKey, memberPrivKey, currentTs, groupId) DB.execute db "UPDATE group_members SET member_pub_key = ?, updated_at = ? WHERE group_member_id = ?" @@ -2851,8 +2870,11 @@ createLinkOwnerMember db vr user@User {userId, userContactId} GroupInfo {groupId where VersionRange minV maxV = vr -updateIntroducedMember :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember -updateIntroducedMember db vr user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile} = do +-- member_pub_key is not updated here — introduced members are owners +-- whose keys are loaded from link data (trusted out-of-band). +-- Updating from an in-band message would allow a compromised relay to substitute keys. +updatePreparedChannelMember :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember +updatePreparedChannelMember db vr user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile} = do _ <- updateMemberProfile db user member profile currentTs <- liftIO getCurrentTime liftIO $ @@ -2873,7 +2895,7 @@ updateIntroducedMember db vr user@User {userId} member@GroupMember {groupMemberI VersionRange minV maxV = maybe memberChatVRange fromChatVRange v updateUnknownMemberAnnounced :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember -updateUnknownMemberAnnounced db vr user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile} status = do +updateUnknownMemberAnnounced db vr user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile, memberKey} status = do _ <- updateMemberProfile db user unknownMember profile currentTs <- liftIO getCurrentTime liftIO $ @@ -2887,15 +2909,17 @@ updateUnknownMemberAnnounced db vr user@User {userId} invitingMember unknownMemb invited_by_group_member_id = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, + member_pub_key = ?, updated_at = ? WHERE user_id = ? AND group_member_id = ? |] ( (memberRole, GCPostMember, status, groupMemberId' invitingMember) - :. (minV, maxV, currentTs, userId, groupMemberId) + :. (minV, maxV, memberPubKey_, currentTs, userId, groupMemberId) ) getGroupMemberById db vr user groupMemberId where VersionRange minV maxV = maybe memberChatVRange fromChatVRange v + memberPubKey_ = (\(MemberKey k) -> k) <$> memberKey updateUserMemberProfileSentAt :: DB.Connection -> User -> GroupInfo -> UTCTime -> IO () updateUserMemberProfileSentAt db User {userId} GroupInfo {groupId} sentTs = diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/agent_query_plans.txt b/src/Simplex/Chat/Store/SQLite/Migrations/agent_query_plans.txt index b722158ef9..1b881bd446 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/agent_query_plans.txt +++ b/src/Simplex/Chat/Store/SQLite/Migrations/agent_query_plans.txt @@ -273,16 +273,6 @@ Query: Plan: SEARCH connections USING PRIMARY KEY (conn_id=?) -Query: - SELECT user_id FROM users u - WHERE u.deleted = ? - AND NOT EXISTS (SELECT c.conn_id FROM connections c WHERE c.user_id = u.user_id) - -Plan: -SCAN u -CORRELATED SCALAR SUBQUERY 1 -SEARCH c USING COVERING INDEX idx_connections_user (user_id=?) - Query: SELECT user_id FROM users u WHERE u.user_id = ? @@ -535,54 +525,6 @@ Query: Plan: SEARCH conn_confirmations USING COVERING INDEX idx_conn_confirmations_conn_id (conn_id=?) -Query: - DELETE FROM encrypted_rcv_message_hashes - WHERE encrypted_rcv_message_hash_id IN ( - SELECT encrypted_rcv_message_hash_id - FROM encrypted_rcv_message_hashes - WHERE created_at < ? - ORDER BY created_at ASC - LIMIT ? - ) - -Plan: -SEARCH encrypted_rcv_message_hashes USING INTEGER PRIMARY KEY (rowid=?) -LIST SUBQUERY 1 -SEARCH encrypted_rcv_message_hashes USING COVERING INDEX idx_encrypted_rcv_message_hashes_created_at (created_at " WHERE g.group_id = ? AND g.user_id = ? AND mu.contact_id = ?") (groupId, userId, userContactId) --- Set group link info and optionally incognito profile before connecting to relays. --- This is called once before connecting to relays, unlike createConnReqConnection -> setPreparedGroupLinkInfo_, --- which is used in single-connection flows. -setPreparedGroupLinkInfo :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> ConnReqContact -> ConnReqUriHash -> Maybe Profile -> ExceptT StoreError IO GroupInfo -setPreparedGroupLinkInfo db vr user@User {userId} gInfo@GroupInfo {groupId} cReq cReqHash incognitoProfile = do - currentTs <- liftIO getCurrentTime - customUserProfileId <- liftIO $ mapM (createIncognitoProfile_ db userId currentTs) incognitoProfile - liftIO $ setPreparedGroupLinkInfo_ db gInfo cReq cReqHash customUserProfileId currentTs - getGroupInfo db vr user groupId - setPreparedGroupLinkInfo_ :: DB.Connection -> GroupInfo -> ConnReqContact -> ConnReqUriHash -> Maybe Int64 -> UTCTime -> IO () setPreparedGroupLinkInfo_ db GroupInfo {groupId, membership} cReq cReqHash customUserProfileId currentTs = do DB.execute diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 3ba424325f..da698bf4e0 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -476,7 +476,7 @@ chatEventToView hu ChatConfig {logLevel, showReactions, showReceipts, testView} CEvtMemberBlockedForAll u g by m blocked signed -> ttyUser u $ viewMemberBlockedForAll g by m blocked signed CEvtDeletedMemberUser u g by wm signed -> ttyUser u $ [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group" <> withMessages wm <> signedStr signed] <> groupPreserved g CEvtDeletedMember u g by m wm signed -> ttyUser u [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group" <> withMessages wm <> signedStr signed] - CEvtLeftMember u g m -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group"] + CEvtLeftMember u g m signed -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " left the group" <> signedStr signed] CEvtGroupDeleted u g m signed -> ttyUser u [ttyGroup' g <> ": " <> ttyMember m <> " deleted the group" <> signedStr signed, "use " <> highlight ("/d #" <> viewGroupName g) <> " to delete the local copy of the group"] CEvtGroupUpdated u g g' m signed -> ttyUser u $ viewGroupUpdated g g' m signed CEvtAcceptingGroupJoinRequestMember _ g m -> [ttyFullMember m <> ": accepting request to join group " <> ttyGroup' g <> "..."] @@ -1276,7 +1276,8 @@ viewJoinedGroupMemberConnecting g@GroupInfo {groupId} host m@GroupMember {groupM [ (ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting and pending review...), ") <> ("use " <> highlight ("/_accept member #" <> show groupId <> " " <> show groupMemberId <> " ") <> " to accept member") ] - _ -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"] + _ | useRelays' g -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group"] + | otherwise -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"] viewConnectedToGroupMember :: GroupInfo -> GroupMember -> [StyledString] viewConnectedToGroupMember g@GroupInfo {groupId} m@GroupMember {groupMemberId, memberStatus} = case memberStatus of diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index e5f4d7bbe8..a1674597d5 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -18,7 +18,7 @@ import Control.Concurrent (threadDelay) import Control.Concurrent.Async (concurrently_) import Control.Monad (forM_, void, when) import Data.Bifunctor (second) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, maybeToList) import qualified Data.ByteString.Char8 as B import Data.Int (Int64) import Data.List (intercalate, isInfixOf) @@ -253,9 +253,14 @@ chatGroupTests = do it "should update channel profile (signed)" testChannelUpdateProfileSigned it "should update channel preferences (signed)" testChannelUpdatePrefsSigned it "should change member role (signed)" testChannelChangeRoleSigned + it "should block member for all (signed)" testChannelBlockMemberSigned it "should remove member (signed)" testChannelRemoveMemberSigned it "should delete channel (signed)" testChannelDeleteGroupSigned it "should delete channel and clean up relay connections" testChannelDeleteGroupCleanup + it "owner should leave channel (signed)" testChannelOwnerLeave + it "subscriber should leave channel (signed)" testChannelSubscriberLeave + it "owner should update profile in channel (signed)" testChannelOwnerProfileUpdate + it "subscriber should update profile in channel (signed)" testChannelSubscriberProfileUpdate describe "channel message operations" $ do it "should update channel message" testChannelMessageUpdate it "should delete channel message" testChannelMessageDelete @@ -8406,7 +8411,7 @@ testChannels1RelayDeliver ps = cath <## "added 👍" bob <# "#team cath> > hi" bob <## " + 👍" - alice <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" + -- alice knows cath via XGrpMemNew announcement from relay alice <# "#team cath> > hi" alice <## " + 👍" dan <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" @@ -8420,7 +8425,7 @@ createChannel1Relay :: String -> TestCC -> TestCC -> TestCC -> TestCC -> TestCC createChannel1Relay gName owner relay cath dan eve = do (shortLink, fullLink) <- prepareChannel1Relay gName owner relay forM_ [cath, dan, eve] $ \member -> - memberJoinChannel gName [relay] shortLink fullLink member + memberJoinChannel gName [relay] [owner] shortLink fullLink member prepareChannel1Relay :: String -> TestCC -> TestCC -> IO (String, String) prepareChannel1Relay gName owner relay = do @@ -8453,7 +8458,7 @@ createChannel2Relays :: String -> TestCC -> TestCC -> TestCC -> TestCC -> TestCC createChannel2Relays gName owner relay1 relay2 dan eve frank = do (shortLink, fullLink) <- prepareChannel2Relays gName owner relay1 relay2 forM_ [dan, eve, frank] $ \member -> - memberJoinChannel gName [relay1, relay2] shortLink fullLink member + memberJoinChannel gName [relay1, relay2] [owner] shortLink fullLink member prepareChannel2Relays :: String -> TestCC -> TestCC -> TestCC -> IO (String, String) prepareChannel2Relays gName owner relay1 relay2 = do @@ -8494,8 +8499,8 @@ prepareChannel2Relays gName owner relay1 relay2 = do owner ##> ("/show link #" <> gName) getGroupLinks owner gName GRMember False -memberJoinChannel :: String -> [TestCC] -> String -> String -> TestCC -> IO () -memberJoinChannel gName relays shortLink fullLink member = do +memberJoinChannel :: String -> [TestCC] -> [TestCC] -> String -> String -> TestCC -> IO () +memberJoinChannel gName relays owners shortLink fullLink member = do mName <- userName member mFullName <- showName member relayNames <- mapM userName relays @@ -8523,9 +8528,12 @@ memberJoinChannel gName relays shortLink fullLink member = do relay <## ("#" <> gName <> ": " <> mName <> " joined the group") | relay <- relays ] + <> [ owner <### [EndsWith ("added " <> mFullName <> " to the group")] + | owner <- owners + ] -memberJoinChannelIncognito :: String -> [TestCC] -> String -> String -> TestCC -> IO String -memberJoinChannelIncognito gName relays shortLink fullLink member = do +memberJoinChannelIncognito :: String -> [TestCC] -> [TestCC] -> String -> String -> TestCC -> IO String +memberJoinChannelIncognito gName relays owners shortLink fullLink member = do relayNames <- mapM userName relays member ##> ("/_connect plan 1 " <> shortLink) @@ -8552,6 +8560,9 @@ memberJoinChannelIncognito gName relays shortLink fullLink member = do relay <## ("#" <> gName <> ": " <> memIncognito <> " joined the group") | relay <- relays ] + <> [ owner <### [EndsWith ("added " <> memIncognito <> " to the group")] + | owner <- owners + ] pure memIncognito testChannels1RelayDeliverLoop :: HasCallStack => Int -> TestParams -> IO () @@ -8571,7 +8582,6 @@ testChannels1RelayDeliverLoop deliveryBucketSize ps = cath <## "added 👍" bob <# "#team cath> > hi" bob <## " + 👍" - alice <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" alice <# "#team cath> > hi" alice <## " + 👍" dan <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" @@ -8611,9 +8621,7 @@ testChannelsSenderDeduplicateOwn ps = do WithTime "#team dan> 6" ] alice - <### [ "#team: bob forwarded a message from an unknown member, creating unknown member record cath", - "#team: bob forwarded a message from an unknown member, creating unknown member record dan", - WithTime "#team cath> 4 [>>]", + <### [ WithTime "#team cath> 4 [>>]", WithTime "#team cath> 5 [>>]", WithTime "#team dan> 6 [>>]" ] @@ -8665,7 +8673,6 @@ testChannels2RelaysDeliver ps = bob <## " + 👍" cath <# "#team dan> > hi" cath <## " + 👍" - alice .<## " forwarded a message from an unknown member, creating unknown member record dan" alice <# "#team dan> > hi" alice <## " + 👍" eve .<## " forwarded a message from an unknown member, creating unknown member record dan" @@ -8689,9 +8696,9 @@ testChannels2RelaysIncognito ps = withNewTestChat ps "eve" eveProfile $ \eve -> do withNewTestChat ps "frank" frankProfile $ \frank -> do (shortLink, fullLink) <- prepareChannel2Relays "team" alice bob cath - danIncognito <- memberJoinChannelIncognito "team" [bob, cath] shortLink fullLink dan + danIncognito <- memberJoinChannelIncognito "team" [bob, cath] [alice] shortLink fullLink dan forM_ [eve, frank] $ \member -> - memberJoinChannel "team" [bob, cath] shortLink fullLink member + memberJoinChannel "team" [bob, cath] [alice] shortLink fullLink member alice #> "#team hi" [bob, cath] *<# "#team> hi" @@ -8704,7 +8711,6 @@ testChannels2RelaysIncognito ps = bob <## " + 👍" cath <# ("#team " <> danIncognito <> "> > hi") cath <## " + 👍" - alice .<## (" forwarded a message from an unknown member, creating unknown member record " <> danIncognito) alice <# ("#team " <> danIncognito <> "> > hi") alice <## " + 👍" eve .<## (" forwarded a message from an unknown member, creating unknown member record " <> danIncognito) @@ -8791,13 +8797,11 @@ testChannelChangeRoleSigned ps = withNewTestChat ps "eve" eveProfile $ \eve -> do createChannel1Relay "team" alice bob cath dan eve - -- discover cath so alice can change her role + -- other members discover cath cath #> "#team hello from cath" bob <# "#team cath> hello from cath" concurrentlyN_ - [ do - alice <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" - alice <# "#team cath> hello from cath [>>]", + [ alice <# "#team cath> hello from cath [>>]", do dan <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" dan <# "#team cath> hello from cath [>>]", @@ -8806,16 +8810,101 @@ testChannelChangeRoleSigned ps = eve <# "#team cath> hello from cath [>>]" ] - -- change member role (XGrpMemRole) - signed + -- change member role (XGrpMemRole) - signed (other members can verify) + threadDelay 1000000 alice ##> "/mr #team cath admin" alice <## "#team: you changed the role of cath to admin (signed)" + bob <## "#team: alice changed the role of cath from member to admin (signed)" concurrentlyN_ - [ bob <## "#team: alice changed the role of cath from member to admin (signed)", - cath <## "#team: alice changed your role from member to admin (signed)", + [ cath <## "#team: alice changed your role from member to admin (signed)", dan <## "#team: alice changed the role of cath from member to admin (signed)", eve <## "#team: alice changed the role of cath from member to admin (signed)" ] alice #$> ("/_get chat #1 count=1", chat, [(1, "changed role of cath to admin (signed)")]) + bob #$> ("/_get chat #1 count=1", chat, [(0, "changed role of cath to admin (signed)")]) + cath #$> ("/_get chat #1 count=1", chat, [(0, "changed your role to admin (signed)")]) + dan #$> ("/_get chat #1 count=1", chat, [(0, "changed role of cath to admin (signed)")]) + eve #$> ("/_get chat #1 count=1", chat, [(0, "changed role of cath to admin (signed)")]) + + -- change role of silent member (other members don't know about member) + threadDelay 1000000 + alice ##> "/mr #team dan admin" + alice <## "#team: you changed the role of dan to admin (signed)" + bob <## "#team: alice changed the role of dan from member to admin (signed)" + concurrentlyN_ + [ dan <## "#team: alice changed your role from member to admin (signed)", + cath <## "error: x.grp.mem.role with unknown member ID", + eve <## "error: x.grp.mem.role with unknown member ID" + ] + alice #$> ("/_get chat #1 count=1", chat, [(1, "changed role of dan to admin (signed)")]) + bob #$> ("/_get chat #1 count=1", chat, [(0, "changed role of dan to admin (signed)")]) + cath #$> ("/_get chat #1 count=1", chat, [(0, "changed your role to admin (signed)")]) -- now new chat item + dan #$> ("/_get chat #1 count=1", chat, [(0, "changed your role to admin (signed)")]) + eve #$> ("/_get chat #1 count=1", chat, [(0, "changed role of cath to admin (signed)")]) -- now new chat item + +testChannelBlockMemberSigned :: HasCallStack => TestParams -> IO () +testChannelBlockMemberSigned ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> + withNewTestChat ps "dan" danProfile $ \dan -> + withNewTestChat ps "eve" eveProfile $ \eve -> do + createChannel1Relay "team" alice bob cath dan eve + + -- other members discover cath + threadDelay 1000000 + cath #> "#team hello from cath" + bob <# "#team cath> hello from cath" + concurrentlyN_ + [ alice <# "#team cath> hello from cath [>>]", + do + dan <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" + dan <# "#team cath> hello from cath [>>]", + do + eve <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" + eve <# "#team cath> hello from cath [>>]" + ] + + -- block member (XGrpMemRestrict) - signed (other members can verify) + threadDelay 1000000 + alice ##> "/block for all #team cath" + alice <## "#team: you blocked cath (signed)" + bob <## "#team: alice blocked cath (signed)" + concurrentlyN_ + [ dan <## "#team: alice blocked cath (signed)", + eve <## "#team: alice blocked cath (signed)" + ] + alice #$> ("/_get chat #1 count=1", chat, [(1, "blocked cath (signed)")]) + bob #$> ("/_get chat #1 count=1", chat, [(0, "blocked cath (signed)")]) + cath #$> ("/_get chat #1 count=1", chat, [(1, "hello from cath")]) -- was blocked - no "blocked" chat item + dan #$> ("/_get chat #1 count=1", chat, [(0, "blocked cath (signed)")]) + eve #$> ("/_get chat #1 count=1", chat, [(0, "blocked cath (signed)")]) + + -- TODO [relays] member: in channels - don't create unknown member record and chat item? (just ignore) + -- block silent member (other members create unknown member record and can verify) + threadDelay 1000000 + alice ##> "/block for all #team dan" + alice <## "#team: you blocked dan (signed)" + bob <## "#team: alice blocked dan (signed)" + concurrentlyN_ + [ do + cath <##. "#team: alice blocked an unknown member, creating unknown member record" + cath .<##. ("#team: alice blocked", "(signed)"), + do + eve <##. "#team: alice blocked an unknown member, creating unknown member record" + eve .<##. ("#team: alice blocked", "(signed)") + ] + alice #$> ("/_get chat #1 count=1", chat, [(1, "blocked dan (signed)")]) + bob #$> ("/_get chat #1 count=1", chat, [(0, "blocked dan (signed)")]) + cath ##> "/_get chat #1 count=1" + [(0, r1)] <- chat <$> getTermLine cath + r1 `shouldStartWith` "blocked" + r1 `shouldEndWith` "(signed)" + dan #$> ("/_get chat #1 count=1", chat, [(0, "blocked cath (signed)")]) -- was blocked - no new chat item + eve ##> "/_get chat #1 count=1" + [(0, r2)] <- chat <$> getTermLine eve + r2 `shouldStartWith` "blocked" + r2 `shouldEndWith` "(signed)" testChannelRemoveMemberSigned :: HasCallStack => TestParams -> IO () testChannelRemoveMemberSigned ps = @@ -8826,13 +8915,11 @@ testChannelRemoveMemberSigned ps = withNewTestChat ps "eve" eveProfile $ \eve -> do createChannel1Relay "team" alice bob cath dan eve - -- discover eve so alice can remove her + -- other members discover eve eve #> "#team hello from eve" bob <# "#team eve> hello from eve" concurrentlyN_ - [ do - alice <## "#team: bob forwarded a message from an unknown member, creating unknown member record eve" - alice <# "#team eve> hello from eve [>>]", + [ alice <# "#team eve> hello from eve [>>]", do dan <## "#team: bob forwarded a message from an unknown member, creating unknown member record eve" dan <# "#team eve> hello from eve [>>]", @@ -8841,13 +8928,13 @@ testChannelRemoveMemberSigned ps = cath <# "#team eve> hello from eve [>>]" ] - -- remove member (XGrpMemDel) - signed + -- remove member (XGrpMemDel) - signed (other members can verify) threadDelay 1000000 alice ##> "/rm #team eve" alice <## "#team: you removed eve from the group (signed)" + bob <## "#team: alice removed eve from the group (signed)" concurrentlyN_ - [ bob <## "#team: alice removed eve from the group (signed)", - cath <## "#team: alice removed eve from the group (signed)", + [ cath <## "#team: alice removed eve from the group (signed)", dan <## "#team: alice removed eve from the group (signed)", do eve <## "#team: alice removed you from the group (signed)" @@ -8855,6 +8942,26 @@ testChannelRemoveMemberSigned ps = ] alice #$> ("/_get chat #1 count=1", chat, [(1, "removed eve (signed)")]) bob #$> ("/_get chat #1 count=1", chat, [(0, "removed eve (signed)")]) + cath #$> ("/_get chat #1 count=1", chat, [(0, "removed eve (signed)")]) + dan #$> ("/_get chat #1 count=1", chat, [(0, "removed eve (signed)")]) + eve #$> ("/_get chat #1 count=1", chat, [(0, "removed you (signed)")]) + + -- remove silent member (other members don't know about member) + threadDelay 1000000 + alice ##> "/rm #team dan" + alice <## "#team: you removed dan from the group (signed)" + bob <## "#team: alice removed dan from the group (signed)" + concurrentlyN_ + [ cath <## "error: x.grp.mem.del with unknown member ID", + do + dan <## "#team: alice removed you from the group (signed)" + dan <## "use /d #team to delete the group" + ] + alice #$> ("/_get chat #1 count=1", chat, [(1, "removed dan (signed)")]) + bob #$> ("/_get chat #1 count=1", chat, [(0, "removed dan (signed)")]) + cath #$> ("/_get chat #1 count=1", chat, [(0, "removed eve (signed)")]) -- no new chat item + dan #$> ("/_get chat #1 count=1", chat, [(0, "removed you (signed)")]) + eve #$> ("/_get chat #1 count=1", chat, [(0, "removed you (signed)")]) -- no new chat item testChannelDeleteGroupSigned :: HasCallStack => TestParams -> IO () testChannelDeleteGroupSigned ps = @@ -8888,7 +8995,7 @@ testChannelDeleteGroupCleanup ps = withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> do withNewTestChat ps "cath" cathProfile $ \cath -> do (shortLink, fullLink) <- prepareChannel1Relay "team" alice bob - memberJoinChannel "team" [bob] shortLink fullLink cath + memberJoinChannel "team" [bob] [alice] shortLink fullLink cath -- verify message delivery works alice #> "#team hi" @@ -8913,6 +9020,240 @@ testChannelDeleteGroupCleanup ps = bob ##> "/groups" bob <## "#team (group deleted, delete local copy: /d #team)" +testChannelOwnerLeave :: HasCallStack => TestParams -> IO () +testChannelOwnerLeave ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> + withNewTestChat ps "dan" danProfile $ \dan -> + withNewTestChat ps "eve" eveProfile $ \eve -> do + createChannel1Relay "team" alice bob cath dan eve + + -- owner leaves channel (XGrpLeave is signed) + threadDelay 1000000 + alice ##> "/leave #team" + alice <## "#team: you left the group" + alice <## "use /d #team to delete the group" + bob <## "#team: alice left the group (signed)" + concurrentlyN_ + [ cath <## "#team: alice left the group (signed)", + dan <## "#team: alice left the group (signed)", + eve <## "#team: alice left the group (signed)" + ] + alice #$> ("/_get chat #1 count=1", chat, [(1, "left (signed)")]) + bob #$> ("/_get chat #1 count=1", chat, [(0, "left (signed)")]) + cath #$> ("/_get chat #1 count=1", chat, [(0, "left (signed)")]) + dan #$> ("/_get chat #1 count=1", chat, [(0, "left (signed)")]) + eve #$> ("/_get chat #1 count=1", chat, [(0, "left (signed)")]) + +testChannelSubscriberLeave :: HasCallStack => TestParams -> IO () +testChannelSubscriberLeave ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> + withNewTestChat ps "dan" danProfile $ \dan -> + withNewTestChat ps "eve" eveProfile $ \eve -> do + createChannel1Relay "team" alice bob cath dan eve + + -- other members discover cath + threadDelay 1000000 + cath #> "#team hello from cath" + bob <# "#team cath> hello from cath" + concurrentlyN_ + [ alice <# "#team cath> hello from cath [>>]", + do + dan <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" + dan <# "#team cath> hello from cath [>>]", + do + eve <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" + eve <# "#team cath> hello from cath [>>]" + ] + + -- known member leaves (XGrpLeave signed) - owner and relay see items + threadDelay 1000000 + cath ##> "/leave #team" + cath <## "#team: you left the group" + cath <## "use /d #team to delete the group" + bob <## "#team: cath left the group (signed)" + alice <## "#team: cath left the group (signed)" + -- other subscribers: cath is known, but items are muted (muteEventInChannel) + -- member status is still updated to left in DB + alice #$> ("/_get chat #1 count=1", chat, [(0, "left (signed)")]) + bob #$> ("/_get chat #1 count=1", chat, [(0, "left (signed)")]) + cath #$> ("/_get chat #1 count=1", chat, [(1, "left (signed)")]) + dan #$> ("/_get chat #1 count=1", chat, [(0, "hello from cath")]) -- no leave item + eve #$> ("/_get chat #1 count=1", chat, [(0, "hello from cath")]) -- no leave item + + -- verify cath's member status is "left" on all clients + checkMemberStatus alice "cath" (Just "left") + checkMemberStatus bob "cath" (Just "left") + checkMemberStatus cath "cath" (Just "left") + checkMemberStatus dan "cath" (Just "left") + checkMemberStatus eve "cath" (Just "left") + + -- silent subscriber leaves (unknown to other subscribers) + threadDelay 1000000 + dan ##> "/leave #team" + dan <## "#team: you left the group" + dan <## "use /d #team to delete the group" + bob <## "#team: dan left the group (signed)" + alice <## "#team: dan left the group (signed)" + -- eve doesn't know dan - no unknown member record created (skipped for XGrpLeave) + alice #$> ("/_get chat #1 count=1", chat, [(0, "left (signed)")]) + bob #$> ("/_get chat #1 count=1", chat, [(0, "left (signed)")]) + dan #$> ("/_get chat #1 count=1", chat, [(1, "left (signed)")]) + eve #$> ("/_get chat #1 count=1", chat, [(0, "hello from cath")]) -- no new item + + -- verify dan's member status is "left" on nodes that know dan + checkMemberStatus alice "dan" (Just "left") + checkMemberStatus bob "dan" (Just "left") + checkMemberStatus dan "dan" (Just "left") + -- eve doesn't know dan - no member record (XGrpLeave skips unknown member creation) + checkMemberStatus eve "dan" Nothing + checkMemberStatus cath "dan" Nothing + where + checkMemberStatus :: HasCallStack => TestCC -> T.Text -> Maybe T.Text -> IO () + checkMemberStatus cc name expected = do + statuses <- withCCTransaction cc $ \db -> + DB.query db "SELECT member_status FROM group_members WHERE local_display_name = ?" (Only name) :: IO [Only T.Text] + map (\(Only s) -> s) statuses `shouldBe` maybeToList expected + +testChannelOwnerProfileUpdate :: HasCallStack => TestParams -> IO () +testChannelOwnerProfileUpdate ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> + withNewTestChat ps "dan" danProfile $ \dan -> + withNewTestChat ps "eve" eveProfile $ \eve -> do + createChannel1Relay "team" alice bob cath dan eve + + -- owner updates profile (XInfo is signed) + -- profile update to group is sent lazily with next message + threadDelay 1000000 + alice ##> "/_profile 1 {\"displayName\": \"alisa\", \"fullName\": \"\"}" + alice <## "user profile is changed to alisa (your 0 contacts are notified)" + + -- sending as channel does NOT trigger profile update + threadDelay 1000000 + alice #> "#team hello from channel" + bob <# "#team> hello from channel" + concurrentlyN_ + [ cath <# "#team> hello from channel [>>]", + dan <# "#team> hello from channel [>>]", + eve <# "#team> hello from channel [>>]" + ] + -- no profile update items on any participant + alice #$> ("/_get chat #1 count=1", chat, [(1, "hello from channel")]) + bob #$> ("/_get chat #1 count=2", chat, [(0, "connected"), (0, "hello from channel")]) + cath #$> ("/_get chat #1 count=2", chat, [(0, "connected"), (0, "hello from channel")]) + dan #$> ("/_get chat #1 count=2", chat, [(0, "connected"), (0, "hello from channel")]) + eve #$> ("/_get chat #1 count=2", chat, [(0, "connected"), (0, "hello from channel")]) + -- verify profiles are updated correctly + alice `hasContactProfiles` ["alisa", "bob", "cath", "dan", "eve"] + bob `hasContactProfiles` ["alice", "bob", "cath", "dan", "eve"] + cath `hasContactProfiles` ["alice", "bob", "cath"] + dan `hasContactProfiles` ["alice", "bob", "dan"] + eve `hasContactProfiles` ["alice", "bob", "eve"] + + -- sending as member (as_group=off) triggers profile update + threadDelay 1000000 + alice ##> "/_send #1(as_group=off) text hello from alisa" + alice <# "#team hello from alisa" + bob <# "#team alisa> hello from alisa" + concurrentlyN_ + [ cath <# "#team alisa> hello from alisa [>>]", + dan <# "#team alisa> hello from alisa [>>]", + eve <# "#team alisa> hello from alisa [>>]" + ] + -- profile update items on all receivers (signed), not on alice who sent it + alice #$> ("/_get chat #1 count=2", chat, [(1, "hello from channel"), (1, "hello from alisa")]) + bob #$> ("/_get chat #1 count=2", chat, [(0, "updated profile (signed)"), (0, "hello from alisa")]) + cath #$> ("/_get chat #1 count=2", chat, [(0, "updated profile (signed)"), (0, "hello from alisa")]) + dan #$> ("/_get chat #1 count=2", chat, [(0, "updated profile (signed)"), (0, "hello from alisa")]) + eve #$> ("/_get chat #1 count=2", chat, [(0, "updated profile (signed)"), (0, "hello from alisa")]) + -- verify profiles are updated correctly + forM_ [alice, bob] $ \cc -> cc `hasContactProfiles` ["alisa", "bob", "cath", "dan", "eve"] + cath `hasContactProfiles` ["alisa", "bob", "cath"] + dan `hasContactProfiles` ["alisa", "bob", "dan"] + eve `hasContactProfiles` ["alisa", "bob", "eve"] + +testChannelSubscriberProfileUpdate :: HasCallStack => TestParams -> IO () +testChannelSubscriberProfileUpdate ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> + withNewTestChat ps "dan" danProfile $ \dan -> + withNewTestChat ps "eve" eveProfile $ \eve -> do + createChannel1Relay "team" alice bob cath dan eve + + -- other members discover cath + threadDelay 1000000 + cath #> "#team hello from cath" + bob <# "#team cath> hello from cath" + concurrentlyN_ + [ alice <# "#team cath> hello from cath [>>]", + do + dan <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" + dan <# "#team cath> hello from cath [>>]", + do + eve <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" + eve <# "#team cath> hello from cath [>>]" + ] + + -- known subscriber updates profile (XInfo signed) + threadDelay 1000000 + cath ##> "/_profile 1 {\"displayName\": \"kate\", \"fullName\": \"\"}" + cath <## "user profile is changed to kate (your 0 contacts are notified)" + cath #> "#team hello from kate" + bob <# "#team kate> hello from kate" + concurrentlyN_ + [ alice <# "#team kate> hello from kate [>>]", + dan <# "#team kate> hello from kate [>>]", + eve <# "#team kate> hello from kate [>>]" + ] + -- profile update items on alice and bob (owner/relay, signed) + alice #$> ("/_get chat #1 count=2", chat, [(0, "updated profile (signed)"), (0, "hello from kate")]) + bob #$> ("/_get chat #1 count=2", chat, [(0, "updated profile (signed)"), (0, "hello from kate")]) + -- no profile update items on dan and eve (subscriber-to-subscriber muted) + dan #$> ("/_get chat #1 count=2", chat, [(0, "hello from cath"), (0, "hello from kate")]) + eve #$> ("/_get chat #1 count=2", chat, [(0, "hello from cath"), (0, "hello from kate")]) + -- cath doesn't see her own profile update + cath #$> ("/_get chat #1 count=2", chat, [(1, "hello from cath"), (1, "hello from kate")]) + -- verify profiles are updated correctly + forM_ [alice, bob] $ \cc -> cc `hasContactProfiles` ["alice", "bob", "kate", "dan", "eve"] + cath `hasContactProfiles` ["alice", "bob", "kate"] + dan `hasContactProfiles` ["alice", "bob", "kate", "dan"] + eve `hasContactProfiles` ["alice", "bob", "kate", "eve"] + + -- previously silent subscriber updates profile + threadDelay 1000000 + dan ##> "/_profile 1 {\"displayName\": \"dave\", \"fullName\": \"\"}" + dan <## "user profile is changed to dave (your 0 contacts are notified)" + dan #> "#team hello from dave" + bob <# "#team dave> hello from dave" + concurrentlyN_ + [ alice <# "#team dave> hello from dave [>>]", + do + eve <## "#team: bob forwarded a message from an unknown member, creating unknown member record dave" + eve <# "#team dave> hello from dave [>>]", + do + cath <## "#team: bob forwarded a message from an unknown member, creating unknown member record dave" + cath <# "#team dave> hello from dave [>>]" + ] + -- profile update items on alice and bob (moderator+/relay, 2nd profile update signed) + alice #$> ("/_get chat #1 count=2", chat, [(0, "updated profile (signed)"), (0, "hello from dave")]) + bob #$> ("/_get chat #1 count=2", chat, [(0, "updated profile (signed)"), (0, "hello from dave")]) + -- no profile update items on cath and eve (subscriber-to-subscriber muted) + cath #$> ("/_get chat #1 count=2", chat, [(1, "hello from kate"), (0, "hello from dave")]) + eve #$> ("/_get chat #1 count=2", chat, [(0, "hello from kate"), (0, "hello from dave")]) + -- dan doesn't see his own profile update + dan #$> ("/_get chat #1 count=2", chat, [(0, "hello from kate"), (1, "hello from dave")]) + -- verify profiles are updated correctly + forM_ [alice, bob] $ \cc -> cc `hasContactProfiles` ["alice", "bob", "kate", "dave", "eve"] + cath `hasContactProfiles` ["alice", "bob", "kate", "dave"] + dan `hasContactProfiles` ["alice", "bob", "kate", "dave"] + eve `hasContactProfiles` ["alice", "bob", "kate", "dave", "eve"] + testChannelMessageUpdate :: HasCallStack => TestParams -> IO () testChannelMessageUpdate ps = withNewTestChat ps "alice" aliceProfile $ \alice -> @@ -9059,7 +9400,6 @@ testChannelMessageQuote ps = bob <## " replying to channel" concurrentlyN_ [ do - alice <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" alice <# "#team cath> > hello from channel [>>]" alice <## " replying to channel [>>]", do @@ -9422,8 +9762,7 @@ testChannelMemberMessageUpdate ps = cath #> "#team hello" bob <# "#team cath> hello" concurrentlyN_ - [ do alice <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" - alice <# "#team cath> hello [>>]", + [ alice <# "#team cath> hello [>>]", do dan <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" dan <# "#team cath> hello [>>]", do eve <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" @@ -9454,8 +9793,7 @@ testChannelMemberMessageDelete ps = cath #> "#team hello" bob <# "#team cath> hello" concurrentlyN_ - [ do alice <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" - alice <# "#team cath> hello [>>]", + [ alice <# "#team cath> hello [>>]", do dan <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" dan <# "#team cath> hello [>>]", do eve <## "#team: bob forwarded a message from an unknown member, creating unknown member record cath" diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index b60e954478..8acdb78b34 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -375,6 +375,16 @@ cc .<## line = do unless suffix $ print ("expected to end with: " <> line, ", got: " <> l) suffix `shouldBe` True +(.<##.) :: HasCallStack => TestCC -> (String, String) -> Expectation +cc .<##. (linePrefix, lineSuffix) = do + l <- getTermLine' (Just $ "prefix: " <> linePrefix <> "; suffix: " <> lineSuffix) cc + let prefix = linePrefix `isPrefixOf` l + unless prefix $ print ("expected to start from: " <> linePrefix, ", got: " <> l) + prefix `shouldBe` True + let suffix = lineSuffix `isSuffixOf` l + unless suffix $ print ("expected to end with: " <> lineSuffix, ", got: " <> l) + suffix `shouldBe` True + (<#.) :: HasCallStack => TestCC -> String -> Expectation cc <#. line = do l <- dropTime <$> getTermLine' (Just $ "prefix: " <> line) cc