diff --git a/docs/protocol/channels-overview.md b/docs/protocol/channels-overview.md index 9479a4c54b..e97e8b1a5c 100644 --- a/docs/protocol/channels-overview.md +++ b/docs/protocol/channels-overview.md @@ -237,6 +237,8 @@ This threat model assumes the [SimpleX network threat model](https://github.com/ - Ignore the "message from channel" directive, revealing which owner sent a message. Detectable out-of-band. - Fabricate or hide subscriber connections, inflating or deflating counts. Detectable if subscribers are connected to other relays. - Replay a previously valid roster - the owner-signed header plus its blob - to a *new* joiner, re-introducing a member who was later removed or demoted (the roster now carries plain members, not only moderators and admins). The owner signature binds the channel entity ID and the roster version, and the header's digest binds the blob to that header, so cross-channel and cross-version substitution remain blocked; but a same-group replay to a joiner that has not yet seen a newer version is not prevented. Existing members are protected by the monotonic roster version check - they reject any roster not strictly newer than the one already applied, so the replay reaches only a joiner with no prior roster state, and only until that joiner receives the current roster from another relay it connects to. +- Replay or reorder a genuine owner-signed role change (`x.grp.mem.role`). Role changes reach existing subscribers on this signed event - which carries the member's owner-pinned key and the roster version - rather than via a relay re-broadcast of the roster blob (the blob is served only to joiners and resumers; the relay no longer broadcasts it to subscribers on a change). The relay cannot forge the event, and the roster version carried on it - applied only if not lower than the subscriber's current version, then advanced - blocks re-elevating a **demoted** member, because the demotion event carried a strictly higher version. A dropped or reordered event is otherwise no worse than withholding it: resume-serve re-snapshots the subscriber from the owner-signed blob. +- Re-elevate a **removed** member, transiently. Removal (`x.grp.mem.del`) carries no roster version and does not advance the subscriber's version, so a subscriber sitting at the removed member's promotion version `Vn` would accept a replayed `x.grp.mem.role(... , Vn)` (`Vn >= Vn`) and re-show that member as privileged. This is a known, accepted limitation of dropping the broadcast (the old broadcast advanced the version on every change, including removals): it is bounded - the member holds no actual authority (they are removed at the owner and relays), it affects only the subscriber's local view, and resume-serve heals it by re-snapshotting from the current owner-signed blob. *cannot:* diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index b545e68d76..2dbcba4a4c 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -2024,9 +2024,9 @@ processChatCommand cxt nm = \case gVar <- asks random (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar cxt user groupProfile True ccLink welcomeSharedMsgId False GRMember Nothing hostMember <- maybe (throwCmdError "no host member") pure hostMember_ - void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart) + void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart) let cd = CDGroupRcv gInfo Nothing hostMember - createItem sharedMsgId content = createChatItem user cd True content sharedMsgId Nothing + createItem sharedMsgId content = createChatItem user cd True content sharedMsgId Nothing Nothing cInfo = GroupChat gInfo Nothing void $ createGroupFeatureItems_ user cd True CIRcvGroupFeature gInfo aci <- mapM (createItem welcomeSharedMsgId . CIRcvMsgContent) message @@ -2036,9 +2036,9 @@ processChatCommand cxt nm = \case pure $ CRNewPreparedChat user $ AChat SCTGroup chat ACCL _ (CCLink cReq _) -> do ct <- withStore $ \db -> createPreparedContact db cxt user profile accLink welcomeSharedMsgId - void $ createChatItem user (CDDirectSnd ct) False CIChatBanner Nothing (Just epochStart) + void $ createChatItem user (CDDirectSnd ct) False CIChatBanner Nothing Nothing (Just epochStart) let cd = CDDirectRcv ct - createItem sharedMsgId content = createChatItem user cd False content sharedMsgId Nothing + createItem sharedMsgId content = createChatItem user cd False content sharedMsgId Nothing Nothing cInfo = DirectChat ct void $ createItem Nothing $ CIRcvDirectE2EEInfo $ e2eInfoEncrypted $ connRequestPQEncryption cReq void $ createFeatureEnabledItems_ user ct @@ -2055,11 +2055,11 @@ processChatCommand cxt nm = \case subRole <- if useRelays then asks $ channelSubscriberRole . config else pure GRMember gVar <- asks random (gInfo, hostMember_) <- withStore $ \db -> createPreparedGroup db gVar cxt user gp False ccLink welcomeSharedMsgId useRelays subRole publicMemberCount_ - void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart) + void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart) let cd = maybe (CDChannelRcv gInfo Nothing) (CDGroupRcv gInfo Nothing) hostMember_ cInfo = GroupChat gInfo Nothing void $ createGroupFeatureItems_ user cd True CIRcvGroupFeature gInfo - aci <- forM description $ \descr -> createChatItem user cd True (CIRcvMsgContent $ MCText descr) welcomeSharedMsgId Nothing + aci <- forM description $ \descr -> createChatItem user cd True (CIRcvMsgContent $ MCText descr) welcomeSharedMsgId Nothing Nothing let chat = case aci of Just (AChatItem SCTGroup dir _ ci) -> Chat cInfo [CChatItem dir ci] emptyChatStats {unreadCount = 1, minUnreadItemId = chatItemId' ci} _ -> Chat cInfo [] emptyChatStats @@ -2127,7 +2127,7 @@ processChatCommand cxt nm = \case -- create changed feature items (connecting incognito sends default preferences, instead of user preferences) lift . when incognito $ createContactChangedFeatureItems user ct ct' forM_ msg_ $ \(sharedMsgId, mc) -> do - ci <- createChatItem user (CDDirectSnd ct') False (CISndMsgContent mc) (Just sharedMsgId) Nothing + ci <- createChatItem user (CDDirectSnd ct') False (CISndMsgContent mc) (Just sharedMsgId) Nothing Nothing toView $ CEvtNewChatItems user [ci] pure $ CRStartedConnectionToContact user ct' customUserProfile CVRConnectedContact ct' -> pure $ CRContactAlreadyExists user ct' @@ -2220,7 +2220,7 @@ processChatCommand cxt nm = \case liftIO $ setPreparedGroupStartedConnection db groupId getGroupInfo db cxt user groupId forM_ msg_ $ \(sharedMsgId, mc) -> do - ci <- createChatItem user (CDGroupSnd gInfo' Nothing) False (CISndMsgContent mc) (Just sharedMsgId) Nothing + ci <- createChatItem user (CDGroupSnd gInfo' Nothing) False (CISndMsgContent mc) (Just sharedMsgId) Nothing Nothing toView $ CEvtNewChatItems user [ci] pure $ CRStartedConnectionToGroup user gInfo' customUserProfile [] CVRConnectedContact _ct -> throwChatError $ CEException "contact already exists when connecting to group" @@ -2741,13 +2741,11 @@ processChatCommand cxt nm = \case when (useRelays' gInfo && isRosterRole newRole && finalPrivilegedCount > maxGroupRosterSize) $ throwCmdError $ "the number of members, moderators and admins would exceed the limit of " <> show maxGroupRosterSize (errs1, changed1) <- changeRoleInvitedMems user gInfo invitedMems - (errs2, changed2, acis, msgSigned) <- changeRoleCurrentMems user g currentMems + let doBumpRoster = useRelays' gInfo && memberRole' (membership gInfo) == GROwner && (isRosterRole newRole || anyPrivilegedTarget) + (errs2, changed2, acis, msgSigned) <- changeRoleCurrentMems user g doBumpRoster currentMems unless (null acis) $ toView $ CEvtNewChatItems user acis let errs = errs1 <> errs2 unless (null errs) $ toView $ CEvtChatErrors errs - let rosterSetChanged = not (null (changed1 <> changed2)) && (isRosterRole newRole || anyPrivilegedTarget) - when (useRelays' gInfo && memberRole' (membership gInfo) == GROwner && rosterSetChanged) $ - bumpAndBroadcastRoster user gInfo `catchAllErrors` eToView pure $ CRMembersRoleUser {user, groupInfo = gInfo, members = changed1 <> changed2, toRole = newRole, msgSigned} -- same order is not guaranteed where selfSelected GroupInfo {membership} = elem (groupMemberId' membership) memberIds @@ -2782,18 +2780,21 @@ processChatCommand cxt nm = \case withFastStore' $ \db -> updateGroupMemberRole db user m newRole pure (m :: GroupMember) {memberRole = newRole} _ -> throwChatError $ CEGroupCantResendInvitation gInfo cName - changeRoleCurrentMems :: User -> Group -> [GroupMember] -> CM ([ChatError], [GroupMember], [AChatItem], Bool) - changeRoleCurrentMems user (Group gInfo members) memsToChange = case L.nonEmpty memsToChange of + changeRoleCurrentMems :: User -> Group -> Bool -> [GroupMember] -> CM ([ChatError], [GroupMember], [AChatItem], Bool) + changeRoleCurrentMems user (Group gInfo members) doBumpRoster memsToChange = case L.nonEmpty memsToChange of Nothing -> pure ([], [], [], False) Just memsToChange' -> do - let events = L.map (\GroupMember {memberId} -> XGrpMemRole memberId newRole) memsToChange' + (errs, changed) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (updMember db) memsToChange) + eventRosterVer <- if doBumpRoster then Just <$> bumpAndBroadcastRoster user gInfo else pure Nothing + -- channels always carry the member's key; the receiver verifies it (re-key rejected) and creates only roster members + let eventKey m = if useRelays' gInfo then MemberKey <$> memberPubKey m else Nothing + events = L.map (\m@GroupMember {memberId} -> XGrpMemRole memberId newRole (eventKey m) eventRosterVer) memsToChange' recipients = filter memberCurrent members (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 when (length cis_ /= length memsToChange) $ logError "changeRoleCurrentMems: memsToChange and cis_ length mismatch" - (errs, changed) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (updMember db) memsToChange) let acis = map (AChatItem SCTGroup SMDSnd (GroupChat gInfo Nothing)) $ rights cis_ pure (errs, changed, acis, signed) where @@ -2888,7 +2889,7 @@ processChatCommand cxt nm = \case unless (null errs) $ toView $ CEvtChatErrors errs -- refresh the roster so the relay drops a removed privileged member for future joiners when (useRelays' gInfo && memberRole' (membership gInfo) == GROwner && anyPrivilegedRemoved) $ - bumpAndBroadcastRoster user gInfo `catchAllErrors` eToView + void (bumpAndBroadcastRoster user gInfo) `catchAllErrors` eToView pure $ CRUserDeletedMembers user gInfo' deleted withMessages msgSigned -- same order is not guaranteed where selectMembers :: S.Set GroupMemberId -> [GroupMember] -> (Int, [GroupMember], [GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool, Bool) @@ -3118,7 +3119,7 @@ processChatCommand cxt nm = \case (connId, CCLink cReq _) <- withAgent $ \a -> createConnection a nm (aUserId user) True False SCMInvitation Nothing Nothing IKPQOff subMode -- [incognito] reuse membership incognito profile ct <- withFastStore' $ \db -> createMemberContact db user connId cReq g m mConn subMode - void $ createChatItem user (CDDirectSnd ct) False CIChatBanner Nothing (Just epochStart) + void $ createChatItem user (CDDirectSnd ct) False CIChatBanner Nothing Nothing (Just epochStart) -- TODO not sure it is correct to set connections status here? pure $ CRNewMemberContact user ct g m _ -> throwChatError CEGroupMemberNotActive diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index eeaf03e22d..ff5c3bfe32 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -2206,7 +2206,7 @@ sendGroupMessage' user gInfo members chatMsgEvent = -- TODO [relays] improvement: publish roster_version in link data so the owner can recover the latest version -- TODO after restoring from a stale backup (relays accept only strictly-greater versions) -bumpAndBroadcastRoster :: User -> GroupInfo -> CM () +bumpAndBroadcastRoster :: User -> GroupInfo -> CM VersionRoster bumpAndBroadcastRoster user gInfo = do cxt <- chatStoreCxt let rosterVer = maybe (VersionRoster 0) (\(VersionRoster n) -> VersionRoster (n + 1)) (rosterVersion gInfo) @@ -2217,6 +2217,7 @@ bumpAndBroadcastRoster user gInfo = do pure (relays, mods) forM_ (L.nonEmpty relays) $ \relays' -> sendRoster user gInfo (L.toList relays') rosterVer (buildGroupRoster mods) + pure rosterVer -- Send the current roster (no version bump) to a newly added relay so it can serve joiners. sendGroupRosterToRelay :: User -> GroupInfo -> GroupMember -> CM () @@ -2618,11 +2619,11 @@ saveRcvChatItem' user cd msg@RcvMessage {chatMsgEvent, msgSigned, forwardedByMem _ -> Nothing -- TODO [mentions] optimize by avoiding unnecessary parsing -mkChatItem :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ShowGroupAsSender -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d -mkChatItem cd showGroupAsSender ciId content file quotedItem sharedMsgId itemForwarded itemTimed live userMention itemTs forwardedByMember currentTs = +mkChatItem :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ShowGroupAsSender -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> ChatItemTs -> Maybe GroupMemberId -> Maybe MsgSigStatus -> UTCTime -> ChatItem c d +mkChatItem cd showGroupAsSender ciId content file quotedItem sharedMsgId itemForwarded itemTimed live userMention itemTs forwardedByMember msgSigned currentTs = let ts@(_, ft_) = ciContentTexts content hasLink_ = ciContentHasLink content ft_ - in mkChatItem_ cd showGroupAsSender ciId content ts file quotedItem sharedMsgId itemForwarded itemTimed live userMention hasLink_ itemTs forwardedByMember Nothing currentTs + in mkChatItem_ cd showGroupAsSender ciId content ts file quotedItem sharedMsgId itemForwarded itemTimed live userMention hasLink_ itemTs forwardedByMember msgSigned currentTs mkChatItem_ :: (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ShowGroupAsSender -> ChatItemId -> CIContent d -> (Text, Maybe MarkdownList) -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CIForwardedFrom -> Maybe CITimed -> Bool -> Bool -> Bool -> ChatItemTs -> Maybe GroupMemberId -> Maybe MsgSigStatus -> UTCTime -> ChatItem c d mkChatItem_ cd showGroupAsSender ciId content (itemText, formattedText) file quotedItem sharedMsgId itemForwarded itemTimed live userMention hasLink_ itemTs forwardedByMember msgSigned currentTs = @@ -2784,7 +2785,7 @@ createFeatureEnabledItems_ :: User -> Contact -> CM [AChatItem] createFeatureEnabledItems_ user ct@Contact {mergedPreferences} = forM allChatFeatures $ \(ACF f) -> do let state = featureState $ getContactUserPreference f mergedPreferences - createChatItem user (CDDirectRcv ct) False (uncurry (CIRcvChatFeature $ chatFeature f) state) Nothing Nothing + createChatItem user (CDDirectRcv ct) False (uncurry (CIRcvChatFeature $ chatFeature f) state) Nothing Nothing Nothing createFeatureItems :: MsgDirectionI d => @@ -2814,15 +2815,15 @@ createContactsFeatureItems user cts chatDir ciFeature ciOffer getPref = do unless (null errs) $ toView' $ CEvtChatErrors errs toView' $ CEvtNewChatItems user acis where - contactChangedFeatures :: (Contact, Contact) -> (ChatDirection 'CTDirect d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId)]) + contactChangedFeatures :: (Contact, Contact) -> (ChatDirection 'CTDirect d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId, Maybe MsgSigStatus)]) contactChangedFeatures (Contact {mergedPreferences = cups}, ct'@Contact {mergedPreferences = cups'}) = do let contents = mapMaybe (\(ACF f) -> featureCIContent_ f) allChatFeatures (chatDir ct', False, contents) where - featureCIContent_ :: forall f. FeatureI f => SChatFeature f -> Maybe (CIContent d, Maybe SharedMsgId) + featureCIContent_ :: forall f. FeatureI f => SChatFeature f -> Maybe (CIContent d, Maybe SharedMsgId, Maybe MsgSigStatus) featureCIContent_ f - | state /= state' = Just (fContent ciFeature state', Nothing) - | prefState /= prefState' = Just (fContent ciOffer prefState', Nothing) + | state /= state' = Just (fContent ciFeature state', Nothing, Nothing) + | prefState /= prefState' = Just (fContent ciOffer prefState', Nothing, Nothing) | otherwise = Nothing where fContent :: FeatureContent a d -> (a, Maybe Int) -> CIContent d @@ -2855,16 +2856,16 @@ createGroupFeatureItems_ user cd showGroupAsSender ciContent GroupInfo {fullGrou forM allGroupFeatures $ \(AGF f) -> do let p = getGroupPreference f fullGroupPreferences (_, param, role) = groupFeatureState p - createChatItem user cd showGroupAsSender (ciContent (toGroupFeature f) (toGroupPreference p) param role) Nothing Nothing + createChatItem user cd showGroupAsSender (ciContent (toGroupFeature f) (toGroupPreference p) param role) Nothing Nothing Nothing createInternalChatItem :: (ChatTypeI c, MsgDirectionI d) => User -> ChatDirection c d -> CIContent d -> Maybe UTCTime -> CM () createInternalChatItem user cd content itemTs_ = do - ci <- createChatItem user cd False content Nothing itemTs_ + ci <- createChatItem user cd False content Nothing Nothing itemTs_ toView $ CEvtNewChatItems user [ci] -createChatItem :: (ChatTypeI c, MsgDirectionI d) => User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> Maybe SharedMsgId -> Maybe UTCTime -> CM AChatItem -createChatItem user cd showGroupAsSender content sharedMsgId itemTs_ = - lift (createChatItems user itemTs_ [(cd, showGroupAsSender, [(content, sharedMsgId)])]) >>= \case +createChatItem :: (ChatTypeI c, MsgDirectionI d) => User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> Maybe SharedMsgId -> Maybe MsgSigStatus -> Maybe UTCTime -> CM AChatItem +createChatItem user cd showGroupAsSender content sharedMsgId msgSigned itemTs_ = + lift (createChatItems user itemTs_ [(cd, showGroupAsSender, [(content, sharedMsgId, msgSigned)])]) >>= \case [Right ci] -> pure ci [Left e] -> throwError e rs -> throwChatError $ CEInternalError $ "createInternalChatItem: expected 1 result, got " <> show (length rs) @@ -2876,7 +2877,7 @@ createChatItems :: (ChatTypeI c, MsgDirectionI d) => User -> Maybe UTCTime -> - [(ChatDirection c d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId)])] -> + [(ChatDirection c d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId, Maybe MsgSigStatus)])] -> CM' [Either ChatError AChatItem] createChatItems user itemTs_ dirsCIContents = do createdAt <- liftIO getCurrentTime @@ -2885,24 +2886,24 @@ createChatItems user itemTs_ dirsCIContents = do void . withStoreBatch' $ \db -> map (updateChat db cxt createdAt) dirsCIContents withStoreBatch' $ \db -> concatMap (createACIs db itemTs createdAt) dirsCIContents where - updateChat :: DB.Connection -> StoreCxt -> UTCTime -> (ChatDirection c d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId)]) -> IO () + updateChat :: DB.Connection -> StoreCxt -> UTCTime -> (ChatDirection c d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId, Maybe MsgSigStatus)]) -> IO () updateChat db cxt createdAt (cd, _, contents) - | any (ciRequiresAttention . fst) contents || contactChatDeleted cd = void $ updateChatTsStats db cxt user cd createdAt memberChatStats + | any (\(content, _, _) -> ciRequiresAttention content) contents || contactChatDeleted cd = void $ updateChatTsStats db cxt user cd createdAt memberChatStats | otherwise = pure () where memberChatStats :: Maybe (Int, MemberAttention, Int) memberChatStats = case cd of CDGroupRcv _g (Just scope) m -> do - let unread = length $ filter (ciRequiresAttention . fst) contents + let unread = length $ filter (\(content, _, _) -> ciRequiresAttention content) contents in Just (unread, memberAttentionChange unread itemTs_ (Just m) scope, 0) _ -> Nothing - createACIs :: DB.Connection -> UTCTime -> UTCTime -> (ChatDirection c d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId)]) -> [IO AChatItem] + createACIs :: DB.Connection -> UTCTime -> UTCTime -> (ChatDirection c d, ShowGroupAsSender, [(CIContent d, Maybe SharedMsgId, Maybe MsgSigStatus)]) -> [IO AChatItem] createACIs db itemTs createdAt (cd, showGroupAsSender, contents) = map createACI contents where - createACI (content, sharedMsgId) = do + createACI (content, sharedMsgId, msgSigned) = do let hasLink_ = ciContentHasLink content Nothing - ciId <- createNewChatItemNoMsg db user cd showGroupAsSender content sharedMsgId hasLink_ itemTs createdAt - let ci = mkChatItem cd showGroupAsSender ciId content Nothing Nothing Nothing Nothing Nothing False False itemTs Nothing createdAt + ciId <- createNewChatItemNoMsg db user cd showGroupAsSender content sharedMsgId hasLink_ msgSigned itemTs createdAt + let ci = mkChatItem cd showGroupAsSender ciId content Nothing Nothing Nothing Nothing Nothing False False itemTs Nothing msgSigned createdAt pure $ AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci -- rcvMem_ Nothing means message from channel - treated same as message from moderator, diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index aefabd3c0c..88ffadc2f1 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -584,7 +584,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = (gInfo, host) <- withStore $ \db -> do liftIO $ deleteContactCardKeepConn db connId ct createGroupInvitedViaLink db cxt user conn'' glInv - void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart) + void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart) -- [incognito] send saved profile incognitoProfile <- forM customUserProfileId $ \pId -> withStore (\db -> getProfileById db userId pId) let profileToSend = userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile) @@ -1071,7 +1071,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = XGrpMemIntro memInfo memRestrictions_ -> Nothing <$ xGrpMemIntro gInfo' m'' memInfo memRestrictions_ XGrpMemInv memId introInv -> Nothing <$ xGrpMemInv gInfo' m'' memId introInv XGrpMemFwd memInfo introInv -> Nothing <$ xGrpMemFwd gInfo' m'' memInfo introInv - XGrpMemRole memId memRole -> fmap ctx <$> xGrpMemRole gInfo' m'' memId memRole msg brokerTs + XGrpMemRole memId memRole memberKey rosterVer -> fmap ctx <$> xGrpMemRole gInfo' m'' memId memRole memberKey rosterVer msg brokerTs XGrpMemRestrict memId memRestrictions -> fmap ctx <$> xGrpMemRestrict gInfo' m'' memId memRestrictions msg brokerTs XGrpMemCon memId -> Nothing <$ xGrpMemCon gInfo' m'' memId XGrpMemDel memId withMessages -> case encoding @e of @@ -1453,12 +1453,12 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = -- they will be updated after connection is accepted. upsertDirectRequestItem cd (requestMsg_, prevSharedMsgId_) Nothing -> do - void $ createChatItem user (CDDirectSnd ct) False CIChatBanner Nothing (Just epochStart) + void $ createChatItem user (CDDirectSnd ct) False CIChatBanner Nothing Nothing (Just epochStart) let e2eContent = CIRcvDirectE2EEInfo $ e2eInfoEncrypted $ Just $ CR.pqSupportToEnc $ reqPQSup - void $ createChatItem user cd False e2eContent Nothing Nothing + void $ createChatItem user cd False e2eContent Nothing Nothing Nothing void $ createFeatureEnabledItems_ user ct forM_ (autoReply addressSettings) $ \mc -> forM_ welcomeSharedMsgId $ \sharedMsgId -> - createChatItem user (CDDirectSnd ct) False (CISndMsgContent mc) (Just sharedMsgId) Nothing + createChatItem user (CDDirectSnd ct) False (CISndMsgContent mc) (Just sharedMsgId) Nothing Nothing mapM (createRequestItem cd) requestMsg_ case autoAccept of Nothing -> do @@ -1483,13 +1483,13 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = -- they will be updated after connection is accepted. upsertBusinessRequestItem cd (requestMsg_, prevSharedMsgId_) Nothing -> do - void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart) + void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart) -- TODO [short links] possibly, we can just keep them created where they are created on the business side due to auto-accept -- let e2eContent = CIRcvGroupE2EEInfo $ E2EInfo $ Just False -- no PQ encryption in groups - -- void $ createChatItem user cd False e2eContent Nothing Nothing + -- void $ createChatItem user cd False e2eContent Nothing Nothing Nothing -- void $ createFeatureEnabledItems_ user ct forM_ (autoReply addressSettings) $ \arMC -> forM_ welcomeSharedMsgId $ \sharedMsgId -> - createChatItem user (CDGroupSnd gInfo Nothing) False (CISndMsgContent arMC) (Just sharedMsgId) Nothing + createChatItem user (CDGroupSnd gInfo Nothing) False (CISndMsgContent arMC) (Just sharedMsgId) Nothing Nothing mapM (createRequestItem cd) requestMsg_ toView $ CEvtAcceptingBusinessRequest user gInfo where @@ -1553,7 +1553,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = upsertBusinessRequestItem (CDChannelRcv _ _) = const $ pure Nothing createRequestItem :: ChatTypeI c => ChatDirection c 'MDRcv -> (SharedMsgId, MsgContent) -> CM AChatItem createRequestItem cd (sharedMsgId, mc) = do - aci <- createChatItem user cd False (CIRcvMsgContent mc) (Just sharedMsgId) Nothing + aci <- createChatItem user cd False (CIRcvMsgContent mc) (Just sharedMsgId) Nothing Nothing toView $ CEvtNewChatItems user [aci] pure aci upsertRequestItem :: ChatTypeI c => ChatDirection c 'MDRcv -> ((SharedMsgId, MsgContent) -> CM (Maybe AChatItem)) -> (SharedMsgId -> CM ()) -> (Maybe (SharedMsgId, MsgContent), Maybe SharedMsgId) -> CM (Maybe AChatItem) @@ -2563,7 +2563,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = 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}, hostId) <- withStore $ \db -> createGroupInvitation db cxt user ct inv customUserProfileId - void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart) + void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing Nothing (Just epochStart) let GroupMember {groupMemberId, memberId = membershipMemId} = membership if sameGroupLinkId groupLinkId groupLinkId' then do @@ -3191,30 +3191,57 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = chatV = vr cxt `peerConnChatVersion` mcvr withStore' $ \db -> createIntroToMemberContact db user m toMember chatV mcvr groupConnIds directConnIds customUserProfileId subMode - xGrpMemRole :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope) - xGrpMemRole gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId memRole msg@RcvMessage {msgSigned} brokerTs - | membershipMemId == memId = - let gInfo' = gInfo {membership = membership {memberRole = memRole}} - in changeMemberRole gInfo' membership $ RGEUserRole memRole - | otherwise = - withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memId) >>= \case - Right member -> changeMemberRole gInfo member $ RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole - -- in relay groups the roster delivers the chat item for previously-unknown privileged members - Left _ - | useRelays' gInfo -> pure Nothing - | otherwise -> messageError "x.grp.mem.role with unknown member ID" $> Nothing + xGrpMemRole :: GroupInfo -> GroupMember -> MemberId -> GroupMemberRole -> Maybe MemberKey -> Maybe VersionRoster -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope) + xGrpMemRole gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId memRole memberKey_ rosterVer_ msg@RcvMessage {msgSigned} brokerTs + -- rollback defense: a relay can replay/reorder owner-signed role events, so in channels apply + -- only at a non-decreasing roster version (>= keeps a multi-member /mr that shares one version + -- idempotent), then advance it. A strictly lower version is a rollback attempt and is ignored. + | useRelays' gInfo && maybe False staleVersion rosterVer_ = + messageWarning "x.grp.mem.role: roster version not newer than current, ignoring" $> Nothing + | otherwise = do + r <- applyRole + when (useRelays' gInfo) $ forM_ rosterVer_ $ \v -> + withStore' $ \db -> setGroupRosterVersion db gInfo (maybe v (max v) (rosterVersion gInfo)) + pure r where GroupMember {memberId = membershipMemId} = membership - changeMemberRole gInfo' member@GroupMember {memberRole = fromRole} gEvent + staleVersion v = not $ maybe True (v >=) (rosterVersion gInfo) + applyRole + | membershipMemId == memId = + let gInfo' = gInfo {membership = membership {memberRole = memRole}} + in changeMemberRole gInfo' membership Nothing $ RGEUserRole memRole + | otherwise = do + defaultRole <- unknownMemberRole gInfo + -- an owner-signed event with a key TOFU-creates an unknown member only for a roster role; else a plain lookup + let allowCreate = useRelays' gInfo && senderRole == GROwner && isRosterRole memRole && isJust memberKey_ + withStore' (\db -> runExceptT $ getCreateUnknownGMByMemberId db cxt user gInfo memId (nameFromMemberId memId) defaultRole allowCreate) >>= \case + Right (Just (member, _)) -> changeMemberRole gInfo member memberKey_ $ RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole + -- unknown id we did not create (non-owner or keyless in channels; absent in normal groups) + _ | useRelays' gInfo -> pure Nothing + | otherwise -> messageError "x.grp.mem.role with unknown member ID" $> Nothing + changeMemberRole gInfo' member@GroupMember {memberRole = fromRole} memberKey gEvent | senderRole < GRAdmin || senderRole < fromRole = messageError "x.grp.mem.role with insufficient member permissions" $> Nothing | useRelays' gInfo && (isRosterRole memRole || isRosterRole fromRole) && senderRole /= GROwner = messageError "x.grp.mem.role: only the owner can change member, moderator and admin roles in relay groups" $> Nothing - -- in channels the owner-signed roster delivers role changes to subscribers; a forwarded - -- x.grp.mem.role landing after the roster already applied the role is a no-op, suppress it - | useRelays' gInfo && fromRole == memRole = pure $ memberEventDeliveryScope member - | otherwise = do + | useRelays' gInfo = case memberKey of + -- verify/pin the owner-signed key against the established one (re-key rejected in any + -- direction); applyMemberKeyRole reports Right Nothing when the role is already current + Just (MemberKey pubKey) -> + withStore' (\db -> applyMemberKeyRole db member pubKey memRole) >>= \case + Left _ -> messageWarning "x.grp.mem.role: key differs from established key, ignoring" $> Nothing + Right Nothing -> pure $ memberEventDeliveryScope member + Right (Just _) -> emitMemberRole + -- self role change (key omitted) or a member with no pinned key; an already-current role is a no-op + Nothing + | fromRole == memRole -> pure $ memberEventDeliveryScope member + | otherwise -> updateMemberRole + | otherwise = updateMemberRole + where + updateMemberRole = do withStore' $ \db -> updateGroupMemberRole db user member memRole + emitMemberRole + emitMemberRole = do (gInfo'', m', scopeInfo) <- mkGroupChatScope gInfo' m (ci, cInfo) <- saveRcvChatItemNoParse user (CDGroupRcv gInfo'' scopeInfo m') msg brokerTs (CIRcvGroupEvent gEvent) groupMsgToView cInfo ci @@ -3290,13 +3317,8 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = pure res cleanupGroupRosterFile user gInfo emitRosterResults gInfo author rosterBrokerTs results - when isRelay $ do - -- ack only while still setting up (own status RSAccepted); a serving relay must not ack broadcasts - when (relayOwnStatus gInfo == Just RSAccepted) $ sendRosterAck gInfo author pendingVer Nothing - -- broadcast on a bump: self-healing, and demotions must reach members. - -- re-serve via serveRoster (header + blob), not a delivery task: a - -- BFileChunk body is not a forwardable JSON message. - broadcastRoster gInfo + -- ack only while still setting up (own status RSAccepted); a serving relay must not ack broadcasts. + when (isRelay && relayOwnStatus gInfo == Just RSAccepted) $ sendRosterAck gInfo author pendingVer Nothing where readAssembledRoster = case fileStatus of RFSAccepted fp -> readAt fp @@ -3305,51 +3327,53 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = _ -> throwChatError $ CEInternalError "roster file not in progress" readAt fp = lift (toFSFilePath fp) >>= liftIO . B.readFile - -- Push the freshly applied roster to the relay's member subscribers in one batched re-serve. - broadcastRoster :: GroupInfo -> CM () - broadcastRoster gInfo = do - members <- withStore' $ \db -> getGroupMembers db cxt user gInfo - serveRoster user gInfo (filter rosterRecipient members) `catchAllErrors` eToView - where - rosterRecipient m = memberCurrent m && not (isRelay m) && memberRole' m /= GROwner && isJust (readyMemberConn m) + -- TOFU-apply an owner-signed (key, role) to a resolved member: pin the key if absent; for a keyed + -- member keep the trusted key (Left = reject a different one), else update the role. Right + -- (Just (member-at-new-role, fromRole)) when the role changed, Right Nothing when already current. + applyMemberKeyRole :: DB.Connection -> GroupMember -> C.PublicKeyEd25519 -> GroupMemberRole -> IO (Either MemberId (Maybe (GroupMember, GroupMemberRole))) + applyMemberKeyRole db m pubKey role = case memberPubKey m of + Just k + | k /= pubKey -> pure (Left (memberId' m)) + | memberRole' m == role -> pure (Right Nothing) + | otherwise -> updateGroupMemberRole db user m role $> Right (Just (m {memberRole = role}, memberRole' m)) + Nothing -> setGroupMemberKeyRole db m pubKey role $> Right (Just (m {memberRole = role}, memberRole' m)) -- TOFU apply: pin each member's key on first use, then update roles. - processRosterEntries :: DB.Connection -> GroupInfo -> GroupMemberRole -> [RosterMember] -> ExceptT StoreError IO ([MemberId], [(GroupMember, GroupMemberRole)]) + processRosterEntries :: DB.Connection -> GroupInfo -> GroupMemberRole -> [RosterMember] -> ExceptT StoreError IO ([MemberId], [(GroupMember, GroupMemberRole, Bool)]) processRosterEntries db gInfo defaultRole entries = do let rosterIds = map (\RosterMember {memberId} -> memberId) entries - acc <- foldrM applyRosterEntry ([], []) entries - -- absent privileged members revert to the joiner default - currentPriv <- liftIO $ (++) <$> getGroupRosterMembers db cxt user gInfo <*> getGroupOnlyMembers db cxt user gInfo - liftIO $ forM_ currentPriv $ \m -> - when (memberId' m `notElem` rosterIds) $ - updateGroupMemberRole db user m defaultRole - pure acc + (cs, as) <- foldrM applyRosterEntry ([], []) entries + currentPriv <- liftIO $ (<>) <$> getGroupRosterMembers db cxt user gInfo <*> getGroupOnlyMembers db cxt user gInfo + reverted <- liftIO $ fmap catMaybes $ forM currentPriv $ \m -> + if memberId' m `notElem` rosterIds + then updateGroupMemberRole db user m defaultRole $> Just ((m :: GroupMember) {memberRole = defaultRole}, memberRole' m, False) + else pure Nothing + pure (cs, as <> reverted) where -- entry-level failure (StoreError or IO exception) is muted; the entry is dropped applyRosterEntry RosterMember {memberId, key = MemberKey pubKey, role} (cs, as) = - apply `catchAllErrors` \_ -> pure (cs, as) - where - applied m = (cs, ((m :: GroupMember) {memberRole = role}, memberRole' m) : as) - apply = getCreateUnknownGMByMemberId db cxt user gInfo memberId (nameFromMemberId memberId) defaultRole True >>= \case + ( getCreateUnknownGMByMemberId db cxt user gInfo memberId (nameFromMemberId memberId) defaultRole True >>= \case Nothing -> pure (cs, as) - Just (m, _) -> case memberPubKey m of - Just k - | k /= pubKey -> pure (memberId : cs, as) - | memberRole' m == role -> pure (cs, as) - | otherwise -> liftIO (updateGroupMemberRole db user m role) $> applied m - Nothing -> liftIO (setGroupMemberKeyRole db m pubKey role) $> applied m + Just (m, created) -> liftIO (applyMemberKeyRole db m pubKey role) >>= \case + Left mid -> pure (mid : cs, as) + Right Nothing -> pure (cs, as) + Right (Just (rm, fromR)) -> pure (cs, (rm, fromR, created) : as) + ) + `catchAllErrors` \_ -> pure (cs, as) - emitRosterResults :: GroupInfo -> GroupMember -> UTCTime -> ([MemberId], [(GroupMember, GroupMemberRole)]) -> CM () + emitRosterResults :: GroupInfo -> GroupMember -> UTCTime -> ([MemberId], [(GroupMember, GroupMemberRole, Bool)]) -> CM () emitRosterResults gInfo author rosterBrokerTs (conflicts, applied) = do forM_ conflicts $ \mid' -> messageWarning $ "x.grp.roster: member key conflict, keeping trusted key, memberId=" <> safeDecodeUtf8 (strEncode mid') - forM_ applied $ \(member, fromRole) -> createItems member fromRole + forM_ applied $ \(member, fromRole, created) -> + unless created $ createItems member fromRole where createItems member fromRole = do let toRole = memberRole' member gEvent = RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) toRole (gInfo', author', scopeInfo) <- mkGroupChatScope gInfo author - createInternalChatItem user (CDGroupRcv gInfo' scopeInfo author') (CIRcvGroupEvent gEvent) (Just rosterBrokerTs) + ci <- createChatItem user (CDGroupRcv gInfo' scopeInfo author') False (CIRcvGroupEvent gEvent) Nothing (Just MSSVerified) (Just rosterBrokerTs) + toView $ CEvtNewChatItems user [ci] toView CEvtMemberRole {user, groupInfo = gInfo', byMember = author', member, fromRole, toRole, msgSigned = Just MSSVerified} sendRosterAck :: GroupInfo -> GroupMember -> VersionRoster -> Maybe Text -> CM () @@ -3699,7 +3723,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = XInfo p -> withAuthor XInfo_ $ \author -> void $ xInfoMember gInfo author p rcvMsg msgTs XGrpRelayNew rl -> withAuthor XGrpRelayNew_ $ \author -> void $ xGrpRelayNew gInfo author rl 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 + XGrpMemRole memId memRole memberKey rosterVer -> withAuthor XGrpMemRole_ $ \author -> void $ xGrpMemRole gInfo author memId memRole memberKey rosterVer 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 diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 203f74b321..b0a81a7f73 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -503,7 +503,7 @@ data ChatMsgEvent (e :: MsgEncoding) where XGrpMemInv :: MemberId -> IntroInvitation -> ChatMsgEvent 'Json XGrpMemFwd :: MemberInfo -> IntroInvitation -> ChatMsgEvent 'Json XGrpMemInfo :: MemberId -> Profile -> ChatMsgEvent 'Json - XGrpMemRole :: MemberId -> GroupMemberRole -> ChatMsgEvent 'Json + XGrpMemRole :: MemberId -> GroupMemberRole -> Maybe MemberKey -> Maybe VersionRoster -> ChatMsgEvent 'Json XGrpMemRestrict :: MemberId -> MemberRestrictions -> ChatMsgEvent 'Json XGrpMemCon :: MemberId -> ChatMsgEvent 'Json XGrpMemConAll :: MemberId -> ChatMsgEvent 'Json -- TODO not implemented @@ -1261,7 +1261,7 @@ toCMEventTag msg = case msg of XGrpMemInv _ _ -> XGrpMemInv_ XGrpMemFwd _ _ -> XGrpMemFwd_ XGrpMemInfo _ _ -> XGrpMemInfo_ - XGrpMemRole _ _ -> XGrpMemRole_ + XGrpMemRole {} -> XGrpMemRole_ XGrpMemRestrict _ _ -> XGrpMemRestrict_ XGrpMemCon _ -> XGrpMemCon_ XGrpMemConAll _ -> XGrpMemConAll_ @@ -1422,7 +1422,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro" XGrpMemFwd_ -> XGrpMemFwd <$> p "memberInfo" <*> p "memberIntro" XGrpMemInfo_ -> XGrpMemInfo <$> p "memberId" <*> p "profile" - XGrpMemRole_ -> XGrpMemRole <$> p "memberId" <*> p "role" + XGrpMemRole_ -> XGrpMemRole <$> p "memberId" <*> p "role" <*> opt "memberKey" <*> opt "rosterVersion" XGrpMemRestrict_ -> XGrpMemRestrict <$> p "memberId" <*> p "memberRestrictions" XGrpMemCon_ -> XGrpMemCon <$> p "memberId" XGrpMemConAll_ -> XGrpMemConAll <$> p "memberId" @@ -1496,7 +1496,7 @@ chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case en XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro] XGrpMemFwd memInfo memIntro -> o ["memberInfo" .= memInfo, "memberIntro" .= memIntro] XGrpMemInfo memId profile -> o ["memberId" .= memId, "profile" .= profile] - XGrpMemRole memId role -> o ["memberId" .= memId, "role" .= role] + XGrpMemRole memId role memberKey rosterVersion -> o $ ("memberKey" .=? memberKey) $ ("rosterVersion" .=? rosterVersion) ["memberId" .= memId, "role" .= role] XGrpMemRestrict memId memRestrictions -> o ["memberId" .= memId, "memberRestrictions" .= memRestrictions] XGrpMemCon memId -> o ["memberId" .= memId] XGrpMemConAll memId -> o ["memberId" .= memId] diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index 410b2ec6da..12876eb6c0 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -580,9 +580,9 @@ createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, msgS CDChannelRcv GroupInfo {membership = GroupMember {memberId = userMemberId}} _ -> (Just $ Just userMemberId == memberId, memberId) -createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> Maybe SharedMsgId -> Bool -> UTCTime -> UTCTime -> IO ChatItemId -createNewChatItemNoMsg db user chatDirection showGroupAsSender ciContent sharedMsgId_ hasLink itemTs = - createNewChatItem_ db user chatDirection showGroupAsSender Nothing sharedMsgId_ ciContent quoteRow Nothing Nothing False False hasLink itemTs Nothing Nothing +createNewChatItemNoMsg :: forall c d. MsgDirectionI d => DB.Connection -> User -> ChatDirection c d -> ShowGroupAsSender -> CIContent d -> Maybe SharedMsgId -> Bool -> Maybe MsgSigStatus -> UTCTime -> UTCTime -> IO ChatItemId +createNewChatItemNoMsg db user chatDirection showGroupAsSender ciContent sharedMsgId_ hasLink msgSigned itemTs = + createNewChatItem_ db user chatDirection showGroupAsSender Nothing sharedMsgId_ ciContent quoteRow Nothing Nothing False False hasLink itemTs Nothing msgSigned where quoteRow :: NewQuoteRow quoteRow = (Nothing, Nothing, Nothing, Nothing, Nothing) diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index cbd5247a49..468a660e5e 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -448,8 +448,8 @@ getTermLine' expected cc@TestCC {printOutput} = 5000000 `timeout` atomically (readTQueue $ termQ cc) >>= \case Just s -> do -- remove condition to always echo virtual terminal - -- when True $ do - when printOutput $ do + when True $ do + -- when printOutput $ do name <- userName cc putStrLn $ name <> ": " <> s pure s diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 13d169f0cf..ab770163e5 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -9653,12 +9653,9 @@ testChannelModeratorActionViaRoster ps = -- profile may not be loaded yet, so the actor renders by memberId hash) threadDelay 1000000 memberJoinChannel "team" [bob] [alice, cath] shortLink fullLink frank - -- cached roster carries cath (moderator) and dan (member); both emit a role-change item - frank - <### [ EndsWith "to moderator (signed)", - EndsWith "to member (signed)" - ] - threadDelay 500000 + -- the late joiner learns the roster from the served snapshot (verified below); under the + -- no-broadcast model the apply finds no role change to surface, so no item here + threadDelay 1000000 -- the served roster arrives async checkMemberRole frank "cath" "moderator" where checkMemberRole :: HasCallStack => TestCC -> T.Text -> T.Text -> IO () @@ -9721,11 +9718,11 @@ testChannelRoleTransitionsUpdateRoster ps = [ bob <## "#team: alice changed the role of cath from observer to moderator (signed)", cath <## "#team: alice changed your role from observer to moderator (signed)" ] - -- dan joins; cached roster has cath as moderator + -- dan joins; cached roster has cath as moderator (learned from the served snapshot, + -- no separate role-change item under the no-broadcast model) threadDelay 100000 memberJoinChannel "team" [bob] [alice, cath] shortLink fullLink dan - dan <### [EndsWith "to moderator (signed)"] - threadDelay 100000 + threadDelay 1000000 -- the served roster arrives async; wait before reading the applied state checkMemberRow dan "cath" (Just "moderator") -- moderator -> admin: dan now knows cath, role event lands cleanly threadDelay 100000 @@ -9736,11 +9733,10 @@ testChannelRoleTransitionsUpdateRoster ps = cath <## "#team: alice changed your role from moderator to admin (signed)", dan <## "#team: alice changed the role of cath from moderator to admin (signed)" ] - -- eve joins; cached roster has cath as admin + -- eve joins; cached roster has cath as admin (learned from the served snapshot) threadDelay 100000 memberJoinChannel "team" [bob] [alice, cath] shortLink fullLink eve - eve <### [EndsWith "to admin (signed)"] - threadDelay 100000 + threadDelay 1000000 -- the served roster arrives async; wait before reading the applied state checkMemberRow eve "cath" (Just "admin") -- admin -> observer (crossing out of roster, since member is now in-roster): roster drops cath threadDelay 100000 @@ -10457,14 +10453,14 @@ testChannelAddRelayWithRoster ps = ] -- cath (an existing member) connects to the new relay and is attached to her roster - -- record, kept as moderator + -- record, kept as moderator (the relay learned cath from the cached roster snapshot, so + -- it surfaces no role-change item for her) concurrentlyN_ [ do cath <## "#team: joining the group (connecting to relay dan)..." cath <## "#team: you joined the group (connected to relay dan)", dan - <### [ EndsWith "to moderator (signed)", - EndsWith "accepting request to join group #team...", + <### [ EndsWith "accepting request to join group #team...", EndsWith "is connected" ] ] @@ -10494,8 +10490,8 @@ testChannelRosterMultipartReassembly ps = ] threadDelay 100000 memberJoinChannel "team" [bob] [alice, cath] shortLink fullLink dan - dan <### [EndsWith "to moderator (signed)"] - threadDelay 100000 + -- dan reassembles the multi-chunk roster from the served snapshot (arrives async) + threadDelay 1000000 checkMemberRow dan "cath" (Just "moderator") where cfg = testCfg {fileChunkSize = 30} @@ -10621,8 +10617,7 @@ testChannelPromotedMemberRejoinViaRelay ps = cath <## "#team: joining the group (connecting to relay dan)..." cath <## "#team: you joined the group (connected to relay dan)", dan - <### [ EndsWith "to member (signed)", - EndsWith "accepting request to join group #team...", + <### [ EndsWith "accepting request to join group #team...", EndsWith "is connected" ] ]