From 5dd74a67825f116ed68021329585e6aa248ef218 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Mon, 15 Jun 2026 11:50:35 +0000 Subject: [PATCH] core: roster delivery via inline file (#7048) --- bots/api/TYPES.md | 11 + bots/src/API/Docs/Types.hs | 2 + docs/protocol/channels-overview.md | 3 +- .../types/typescript/src/types.ts | 6 + .../src/simplex_chat/types/_types.py | 3 + src/Simplex/Chat/Library/Commands.hs | 57 +- src/Simplex/Chat/Library/Internal.hs | 176 ++++-- src/Simplex/Chat/Library/Subscriber.hs | 396 +++++++----- src/Simplex/Chat/Protocol.hs | 72 ++- src/Simplex/Chat/Store/Files.hs | 70 ++- src/Simplex/Chat/Store/Groups.hs | 159 ++++- src/Simplex/Chat/Store/Messages.hs | 6 +- .../Migrations/M20260601_group_roster.hs | 22 + .../Store/Postgres/Migrations/chat_schema.sql | 20 +- .../Migrations/M20260601_group_roster.hs | 22 + .../SQLite/Migrations/agent_query_plans.txt | 9 - .../SQLite/Migrations/chat_query_plans.txt | 126 +++- .../Store/SQLite/Migrations/chat_schema.sql | 18 +- src/Simplex/Chat/Types.hs | 32 + src/Simplex/Chat/Types/Shared.hs | 7 + tests/ChatClient.hs | 2 +- tests/ChatTests/Groups.hs | 580 +++++++++++++----- tests/ProtocolTests.hs | 2 +- 23 files changed, 1314 insertions(+), 487 deletions(-) diff --git a/bots/api/TYPES.md b/bots/api/TYPES.md index d648de8e36..adc9025808 100644 --- a/bots/api/TYPES.md +++ b/bots/api/TYPES.md @@ -83,6 +83,7 @@ This file is generated automatically. - [FileProtocol](#fileprotocol) - [FileStatus](#filestatus) - [FileTransferMeta](#filetransfermeta) +- [FileType](#filetype) - [Format](#format) - [FormattedText](#formattedtext) - [FullGroupPreferences](#fullgrouppreferences) @@ -2051,6 +2052,15 @@ NO_FILE: - cancelled: bool +--- + +## FileType + +**Enum type**: +- "normal" +- "roster" + + --- ## Format @@ -3258,6 +3268,7 @@ Cancelled: - xftpRcvFile: [XFTPRcvFile](#xftprcvfile)? - fileInvitation: [FileInvitation](#fileinvitation) - fileStatus: [RcvFileStatus](#rcvfilestatus) +- fileType: [FileType](#filetype) - rcvFileInline: [InlineFileMode](#inlinefilemode)? - senderDisplayName: string - chunkSize: int64 diff --git a/bots/src/API/Docs/Types.hs b/bots/src/API/Docs/Types.hs index 8397503bbe..22d826da02 100644 --- a/bots/src/API/Docs/Types.hs +++ b/bots/src/API/Docs/Types.hs @@ -265,6 +265,7 @@ chatTypesDocsData = (sti @FileProtocol, STEnum' (consLower "FP"), "", [], "", ""), (sti @FileStatus, STEnum, "FS", [], "", ""), (sti @FileTransferMeta, STRecord, "", [], "", ""), + (sti @FileType, STEnum' (consLower "FT"), "", [], "", ""), (sti @Format, STUnion, "", ["Unknown"], "", ""), (sti @FormattedText, STRecord, "", [], "", ""), (sti @FullGroupPreferences, STRecord, "", [], "", ""), @@ -480,6 +481,7 @@ deriving instance Generic FileInvitation deriving instance Generic FileProtocol deriving instance Generic FileStatus deriving instance Generic FileTransferMeta +deriving instance Generic FileType deriving instance Generic Format deriving instance Generic FormattedText deriving instance Generic FullGroupPreferences diff --git a/docs/protocol/channels-overview.md b/docs/protocol/channels-overview.md index d4cd2d2965..7a55f8b6e5 100644 --- a/docs/protocol/channels-overview.md +++ b/docs/protocol/channels-overview.md @@ -182,7 +182,7 @@ The low-level protocol supports multiple owners from the initial release. The ap - **Subscribers** connect to relays and receive content. They cannot send messages by default, but can be given posting rights. -Additional roles (moderator, admin, member, author) exist in the hierarchy and are inherited from the group protocol. +Additional roles (moderator, admin, member, author) exist in the hierarchy and are inherited from the group protocol. The owner-signed roster tracks the promoted set - members, moderators, and admins; subscribers are observers until an owner promotes them. For protocol-level detail - wire formats, message types, signing and verification mechanics, delivery pipeline - see [SimpleX Channels Protocol](./channels-protocol.md). @@ -242,6 +242,7 @@ This threat model assumes the [SimpleX network threat model](https://github.com/ - Undetectably substitute content - subscribers on honest relays receive the original. - Alter the channel's authoritative state on the owner's device. - Substitute the channel profile or impersonate an owner - these require valid signatures. +- Replay an old roster or role change to re-elevate a removed or demoted member for existing subscribers - they reject anything older than the roster version they applied (a new joiner with no prior roster can still be served an old one, until it syncs from another relay). - Redirect subscribers to a different channel - the entity ID is validated across link and profile. - Determine subscriber identity or network address - inherited from SMP transport. - Correlate subscriber participation across channels - each connection uses independent SMP queues. The subscriber chooses their SMP router independently, so collusion between a relay and the relay's SMP router does not compromise connections through a different router. diff --git a/packages/simplex-chat-client/types/typescript/src/types.ts b/packages/simplex-chat-client/types/typescript/src/types.ts index f364bebd9b..6015eedb34 100644 --- a/packages/simplex-chat-client/types/typescript/src/types.ts +++ b/packages/simplex-chat-client/types/typescript/src/types.ts @@ -2341,6 +2341,11 @@ export interface FileTransferMeta { cancelled: boolean } +export enum FileType { + Normal = "normal", + Roster = "roster", +} + export type Format = | Format.Bold | Format.Italic @@ -3601,6 +3606,7 @@ export interface RcvFileTransfer { xftpRcvFile?: XFTPRcvFile fileInvitation: FileInvitation fileStatus: RcvFileStatus + fileType: FileType rcvFileInline?: InlineFileMode senderDisplayName: string chunkSize: number // int64 diff --git a/packages/simplex-chat-python/src/simplex_chat/types/_types.py b/packages/simplex-chat-python/src/simplex_chat/types/_types.py index c8445443b1..def8299142 100644 --- a/packages/simplex-chat-python/src/simplex_chat/types/_types.py +++ b/packages/simplex-chat-python/src/simplex_chat/types/_types.py @@ -1646,6 +1646,8 @@ class FileTransferMeta(TypedDict): chunkSize: int # int64 cancelled: bool +FileType = Literal["normal", "roster"] + class Format_bold(TypedDict): type: Literal["bold"] @@ -2529,6 +2531,7 @@ class RcvFileTransfer(TypedDict): xftpRcvFile: NotRequired["XFTPRcvFile"] fileInvitation: "FileInvitation" fileStatus: "RcvFileStatus" + fileType: "FileType" rcvFileInline: NotRequired["InlineFileMode"] senderDisplayName: str chunkSize: int # int64 diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index a220599fde..6b54019775 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -1270,6 +1270,8 @@ processChatCommand cxt nm = \case filesInfo <- withFastStore' $ \db -> getGroupFileInfo db user gInfo withGroupLock "deleteChat group" chatId $ do deleteCIFiles user filesInfo + -- the roster blob file has no chat item, so it is missed by getGroupFileInfo above + cleanupGroupRosterFile user gInfo (members, recipients) <- getRecipients gInfo let doSendDel = memberActive membership && isOwner msgSigned <- @@ -2022,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 @@ -2034,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 @@ -2053,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 @@ -2125,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' @@ -2218,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" @@ -2737,15 +2739,15 @@ processChatCommand cxt nm = \case when (useRelays' gInfo && (isRosterRole newRole || anyPrivilegedTarget) && memberRole' (membership gInfo) /= GROwner) $ throwCmdError "only the group owner can change moderator and admin roles" when (useRelays' gInfo && isRosterRole newRole && finalPrivilegedCount > maxGroupRosterSize) $ - throwCmdError $ "the number of moderators and admins would exceed the limit of " <> show 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) + rosterVer <- if doBumpRoster then Just <$> reserveRosterVersion gInfo else pure Nothing + (errs2, changed2, acis, msgSigned) <- changeRoleCurrentMems user g rosterVer currentMems + forM_ rosterVer $ \v -> broadcastRoster user gInfo v `catchAllErrors` eToView 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 @@ -2780,19 +2782,20 @@ 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 -> Maybe VersionRoster -> [GroupMember] -> CM ([ChatError], [GroupMember], [AChatItem], Bool) + changeRoleCurrentMems user (Group gInfo members) rosterVer memsToChange = case L.nonEmpty memsToChange of Nothing -> pure ([], [], [], False) Just memsToChange' -> do - let events = L.map (\GroupMember {memberId} -> XGrpMemRole memberId newRole) memsToChange' + let mKey m = if isJust rosterVer then MemberKey <$> memberPubKey m else Nothing + events = L.map (\m@GroupMember {memberId} -> XGrpMemRole memberId newRole (mKey m) rosterVer) 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_ + (errs, changed) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (updMember db) memsToChange) pure (errs, changed, acis, signed) where sndItemData :: GroupMember -> SndMessage -> NewSndChatItemData c @@ -2863,15 +2866,18 @@ processChatCommand cxt nm = \case when (memCount > 1 && anyAdmin) $ throwCmdError "can't remove multiple members when admins selected" assertUserGroupRole gInfo $ max GRAdmin maxRole when (useRelays' gInfo && anyPrivilegedRemoved && memberRole' (membership gInfo) /= GROwner) $ - throwCmdError "only the group owner can remove moderators and admins" + throwCmdError "only the group owner can remove members, moderators and admins" (errs1, deleted1) <- deleteInvitedMems user invitedMems let recipients = filter memberCurrent members - (errs2, deleted2, acis2, signed2) <- deleteMemsSend user gInfo Nothing recipients currentMems + let doBumpRoster = useRelays' gInfo && memberRole' (membership gInfo) == GROwner && anyPrivilegedRemoved + rosterVer <- if doBumpRoster then Just <$> reserveRosterVersion gInfo else pure Nothing + (errs2, deleted2, acis2, signed2) <- deleteMemsSend user gInfo Nothing rosterVer recipients currentMems (errs3, deleted3, acis3, signed3) <- foldM (\acc m -> deletePendingMember acc user gInfo [m] m) ([], [], [], False) pendingApprvMems let moderators = filter (\GroupMember {memberRole} -> memberRole >= GRModerator) members (errs4, deleted4, acis4, signed4) <- foldM (\acc m -> deletePendingMember acc user gInfo (m : moderators) m) ([], [], [], False) pendingRvwMems + forM_ rosterVer $ \v -> broadcastRoster user gInfo v `catchAllErrors` eToView let acis = acis2 <> acis3 <> acis4 errs = errs1 <> errs2 <> errs3 <> errs4 deleted = deleted1 <> deleted2 <> deleted3 <> deleted4 @@ -2884,9 +2890,6 @@ processChatCommand cxt nm = \case let acis' = map (updateACIGroupInfo gInfo') acis unless (null acis') $ toView $ CEvtNewChatItems user acis' 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 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) @@ -2915,14 +2918,14 @@ processChatCommand cxt nm = \case deletePendingMember :: ([ChatError], [GroupMember], [AChatItem], Bool) -> User -> GroupInfo -> [GroupMember] -> GroupMember -> CM ([ChatError], [GroupMember], [AChatItem], Bool) deletePendingMember (accErrs, accDeleted, accACIs, accSigned) user gInfo recipients m = do (m', scopeInfo) <- mkMemberSupportChatInfo m - (errs, deleted, acis, signed) <- deleteMemsSend user gInfo (Just scopeInfo) recipients [m'] + (errs, deleted, acis, signed) <- deleteMemsSend user gInfo (Just scopeInfo) Nothing recipients [m'] pure (errs <> accErrs, deleted <> accDeleted, acis <> accACIs, accSigned || signed) - deleteMemsSend :: User -> GroupInfo -> Maybe GroupChatScopeInfo -> [GroupMember] -> [GroupMember] -> CM ([ChatError], [GroupMember], [AChatItem], Bool) - deleteMemsSend user gInfo chatScopeInfo recipients memsToDelete = case L.nonEmpty memsToDelete of + deleteMemsSend :: User -> GroupInfo -> Maybe GroupChatScopeInfo -> Maybe VersionRoster -> [GroupMember] -> [GroupMember] -> CM ([ChatError], [GroupMember], [AChatItem], Bool) + deleteMemsSend user gInfo chatScopeInfo rosterVer recipients memsToDelete = case L.nonEmpty memsToDelete of Nothing -> pure ([], [], [], False) Just memsToDelete' -> do let chatScope = toChatScope <$> chatScopeInfo - events = L.map (\GroupMember {memberId} -> XGrpMemDel memberId withMessages) memsToDelete' + events = L.map (\GroupMember {memberId} -> XGrpMemDel memberId withMessages rosterVer) memsToDelete' (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_) @@ -3116,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 57cabfb90d..e318c2d498 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -79,6 +79,7 @@ import Simplex.Chat.Types.Shared import Simplex.Chat.Util (encryptFile, shuffle) import Simplex.FileTransfer.Description (FileDescriptionURI (..), ValidFileDescription) import qualified Simplex.FileTransfer.Description as FD +import qualified Simplex.Messaging.Crypto.Lazy as LC import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI) import Simplex.FileTransfer.Types (RcvFileId, SndFileId) import Simplex.Messaging.Agent @@ -949,7 +950,10 @@ acceptGroupJoinRequestAsync -- owner-authoritative role + key); everyone else is created fresh with the group-link role (groupMemberId, memberId) <- case existingMem_ of Just m -> do - withStore' $ \db -> updateGroupMemberStatus db userId m initialStatus + -- refresh the hash placeholder name from the authenticated join profile; role + key stay roster-authoritative + withStore $ \db -> do + liftIO $ updateGroupMemberStatus db userId m initialStatus + void $ updateMemberProfile db user m cReqProfile pure (groupMemberId' m, memberId' m) Nothing -> withStore $ \db -> createJoiningMember db gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ cReqMemberId_ welcomeMsgId_ gLinkMemRole initialStatus memberKey_ @@ -1167,20 +1171,22 @@ memberIntroEvt gInfo reMember = mRestrictions = memberRestrictions reMember in XGrpMemIntro mInfo mRestrictions --- Forward the saved owner-signed roster verbatim, attributed to the owner who --- sent it, so the recipient verifies the owner signature. -forwardGroupRoster :: User -> GroupInfo -> GroupMember -> CM () -forwardGroupRoster user gInfo subscriber = do +-- Forward the saved owner-signed roster verbatim (reusing its signed shared_msg_id), then the +-- blob chunks, so the recipient verifies the owner signature. +serveRoster :: User -> GroupInfo -> GroupMember -> CM () +serveRoster user gInfo member = do cxt <- chatStoreCxt withStore' (\db -> getGroupRoster db gInfo) >>= \case - Nothing -> pure () - Just (ownerGMId, brokerTs, sm@SignedMsg {signedBody}) -> - forM_ (eitherToMaybe (J.eitherDecodeStrict' signedBody) :: Maybe (ChatMessage 'Json)) $ \chatMsg -> + Just (ownerGMId, brokerTs, sm@SignedMsg {signedBody}, blob_) -> + forM_ (eitherToMaybe (J.eitherDecodeStrict' signedBody) :: Maybe (ChatMessage 'Json)) $ \chatMsg@ChatMessage {msgId} -> withStore' (\db -> runExceptT $ getGroupMemberById db cxt user ownerGMId) >>= \case Right owner -> do let fwd = GrpMsgForward {fwdSender = FwdMember (memberId' owner) (memberShortenedName owner), fwdBrokerTs = brokerTs} - sendFwdMemberMessage subscriber fwd (VMSigned MSSVerified sm chatMsg) + sendFwdMemberMessage member fwd (VMSigned MSSVerified sm chatMsg) + forM_ ((,) <$> msgId <*> blob_) $ \(sid, blob) -> + sendInlineBlobChunks user gInfo [member] sid blob Left _ -> pure () + Nothing -> pure () -- Used in groups with relays to introduce moderators and above to a new member, -- and to announce the new member to moderators and above. @@ -1188,16 +1194,16 @@ forwardGroupRoster user gInfo subscriber = do introduceInChannel :: StoreCxt -> User -> GroupInfo -> GroupMember -> CM () introduceInChannel _ _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active" introduceInChannel cxt user gInfo subscriber@GroupMember {activeConn = Just conn, indexInGroup = subscriberIdx} = do - (owners, rosterMems) <- withStore' $ \db -> - (,) <$> getGroupOwners db cxt user gInfo <*> getGroupRosterMembers db cxt user gInfo - let modMs = owners <> rosterMems + (owners, adminsMods) <- withStore' $ \db -> + (,) <$> getGroupOwners db cxt user gInfo <*> getGroupAdminsMods db cxt user gInfo + let modMs = owners <> adminsMods void $ sendGroupMessage' user gInfo modMs $ XGrpMemNew (memberInfo gInfo subscriber) Nothing withStore' $ \db -> setMemberVectorNewRelations db subscriber [(indexInGroup m, (IDSubjectIntroduced, MRIntroduced)) | m <- modMs] -- owner intros first so the joiner has the owner profile loaded before applying the saved roster (signed by the owner) sendIntros owners - forwardGroupRoster user gInfo subscriber - sendIntros rosterMems + serveRoster user gInfo subscriber + sendIntros adminsMods withStore' $ \db -> setMembersVectorsNewRelation db modMs subscriberIdx IDSubjectIntroduced MRIntroduced where @@ -1235,12 +1241,13 @@ redactedMemberProfile allowSimplexLinks Profile {displayName, fullName, shortDes -- Roles carried by the roster; owners are on the link, not the roster. isRosterRole :: GroupMemberRole -> Bool -isRosterRole r = r == GRModerator || r == GRAdmin +isRosterRole r = r == GRMember || r == GRModerator || r == GRAdmin -- Drop non-privileged-role entries and de-duplicate by memberId, keeping the first. -validateGroupRoster :: GroupRoster -> GroupRoster -validateGroupRoster GroupRoster {version = ver, roster = entries} = - GroupRoster {version = ver, roster = dedup [] $ filter (\RosterMember {role} -> isRosterRole role) entries} +-- Runs on the parsed roster blob. +validateGroupRoster :: [RosterMember] -> [RosterMember] +validateGroupRoster entries = + dedup [] $ filter (\RosterMember {role} -> isRosterRole role) entries where dedup _ [] = [] dedup seen (rm@RosterMember {memberId} : rms) @@ -1248,11 +1255,11 @@ validateGroupRoster GroupRoster {version = ver, roster = entries} = | otherwise = rm : dedup (memberId : seen) rms -- Privileged members without a known key are skipped (recipients can't verify them). -buildGroupRoster :: VersionRoster -> [GroupMember] -> GroupRoster -buildGroupRoster ver mods = GroupRoster {version = ver, roster = mapMaybe rosterMember mods} +buildGroupRoster :: [GroupMember] -> [RosterMember] +buildGroupRoster mods = mapMaybe rosterMember mods where - rosterMember m@GroupMember {memberId, memberPubKey, memberRole} - | isRosterRole memberRole = (\k -> RosterMember {memberId, name = memberShortenedName m, key = MemberKey k, role = memberRole}) <$> memberPubKey + rosterMember GroupMember {memberId, memberPubKey, memberRole} + | isRosterRole memberRole = (\k -> RosterMember {memberId, key = MemberKey k, role = memberRole, privileges = 0}) <$> memberPubKey | otherwise = Nothing sendHistory :: User -> GroupInfo -> GroupMember -> CM () @@ -1872,6 +1879,35 @@ closeFileHandle fileId files = do h_ <- atomically . stateTVar fs $ \m -> (M.lookup fileId m, M.delete fileId m) liftIO $ mapM_ hClose h_ `catchAll_` pure () +-- The roster file has no chat item, so chat-item file enumeration misses it; clean it up by group. +cleanupGroupRosterFile :: User -> GroupInfo -> CM () +cleanupGroupRosterFile User {userId} gInfo@GroupInfo {groupId} = do + infos <- withStore' $ \db -> getGroupRosterFileInfo db userId groupId + forM_ infos $ \(fileId, filePath_) -> do + lift $ closeFileHandle fileId rcvFiles + forM_ filePath_ removeFsFile + withStore' $ \db -> do + deleteGroupRosterFile db userId groupId + clearRosterPending db gInfo + +-- MUST evict the cached AppendMode handle before deleting chunks, else re-driven bytes append +-- after the stale prefix and corrupt the blob. +resetRosterPartialChunks :: RcvFileTransfer -> CM () +resetRosterPartialChunks ft@RcvFileTransfer {fileId, fileStatus} = do + lift $ closeFileHandle fileId rcvFiles + forM_ (rcvFilePath fileStatus) removeFsFile + withStore' $ \db -> deleteRcvFileChunks db ft + where + rcvFilePath = \case + RFSAccepted p -> Just p + RFSConnected p -> Just p + _ -> Nothing + +removeFsFile :: FilePath -> CM () +removeFsFile fp = do + p <- lift $ toFSFilePath fp + removeFile p `catchAllErrors` \_ -> pure () + deleteMembersConnections :: User -> [GroupMember] -> CM () deleteMembersConnections user members = deleteMembersConnections' user members False @@ -2172,25 +2208,49 @@ 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 gInfo = do - cxt <- chatStoreCxt +-- Persist the next roster version before sending the events that carry it (so a recipient never advances +-- past a version the owner hasn't recorded). The matching blob is broadcast separately, by broadcastRoster, +-- after the change is applied to the owner's members - so the served roster excludes demoted/removed members. +reserveRosterVersion :: GroupInfo -> CM VersionRoster +reserveRosterVersion gInfo = do let rosterVer = maybe (VersionRoster 0) (\(VersionRoster n) -> VersionRoster (n + 1)) (rosterVersion gInfo) - (relays, roster) <- withStore' $ \db -> do - relays <- getGroupRelayMembers db cxt user gInfo - mods <- getGroupRosterMembers db cxt user gInfo - setGroupRosterVersion db gInfo rosterVer - pure (relays, buildGroupRoster rosterVer mods) + withStore' $ \db -> setGroupRosterVersion db gInfo rosterVer + pure rosterVer + +broadcastRoster :: User -> GroupInfo -> VersionRoster -> CM () +broadcastRoster user gInfo rosterVer = do + cxt <- chatStoreCxt + (relays, rosterMems) <- withStore' $ \db -> + (,) <$> getGroupRelayMembers db cxt user gInfo <*> getGroupRosterMembers db cxt user gInfo forM_ (L.nonEmpty relays) $ \relays' -> - void $ sendGroupMessage' user gInfo (L.toList relays') (XGrpRoster roster) + sendRoster user gInfo (L.toList relays') rosterVer (buildGroupRoster rosterMems) -- Send the current roster (no version bump) to a newly added relay so it can serve joiners. sendGroupRosterToRelay :: User -> GroupInfo -> GroupMember -> CM () sendGroupRosterToRelay user gInfo relayMember = forM_ (rosterVersion gInfo) $ \rosterVer -> do cxt <- chatStoreCxt - mods <- withStore' $ \db -> getGroupRosterMembers db cxt user gInfo - void $ sendGroupMessage' user gInfo [relayMember] (XGrpRoster (buildGroupRoster rosterVer mods)) + rosterMems <- withStore' $ \db -> getGroupRosterMembers db cxt user gInfo + sendRoster user gInfo [relayMember] rosterVer (buildGroupRoster rosterMems) + +-- Row-less send (no files/snd_files rows, so no send-side cleanup); redelivery is the agent's. +sendRoster :: User -> GroupInfo -> [GroupMember] -> VersionRoster -> [RosterMember] -> CM () +sendRoster user gInfo members rosterVer roster = do + let blob = encodeRosterBlob roster + fileInv = InlineFileInvitation {fileSize = fromIntegral (B.length blob), fileDigest = FD.FileDigest $ LC.sha512Hash $ LB.fromStrict blob} + SndMessage {sharedMsgId} <- sendGroupMessage' user gInfo members (XGrpRoster GroupRoster {version = rosterVer, fileInv}) + sendInlineBlobChunks user gInfo members sharedMsgId blob + +-- Send a binary blob as BFileChunks under a shared_msg_id to the given members (chunked by fileChunkSize). +sendInlineBlobChunks :: User -> GroupInfo -> [GroupMember] -> SharedMsgId -> ByteString -> CM () +sendInlineBlobChunks user gInfo members sharedMsgId blob = do + chSize <- fromIntegral <$> asks (fileChunkSize . config) + go chSize 1 blob + where + go chSize chunkNo bytes = do + let (chunk, rest) = B.splitAt chSize bytes + void $ sendGroupMessage' user gInfo members (BFileChunk sharedMsgId (FileChunk chunkNo chunk)) + unless (B.null rest) $ go chSize (chunkNo + 1) rest 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 @@ -2411,10 +2471,14 @@ saveDirectRcvMSG conn@Connection {connId} agentMsgMeta chatMsg@ChatMessage {chat msg <- withStore $ \db -> createNewMessageAndRcvMsgDelivery db (ConnectionId connId) newMsg sharedMsgId_ rcvMsgDelivery Nothing pure (conn', msg) -saveGroupRcvMsg :: MsgEncodingI e => User -> GroupId -> GroupMember -> Connection -> MsgMeta -> VerifiedMsg e -> CM (GroupMember, Connection, RcvMessage) +saveGroupRcvMsg :: forall e. MsgEncodingI e => User -> GroupId -> GroupMember -> Connection -> MsgMeta -> VerifiedMsg e -> CM (GroupMember, Connection, RcvMessage) saveGroupRcvMsg user groupId authorMember conn@Connection {connId} agentMsgMeta verifiedMsg = do let ChatMessage {chatVRange, msgId = sharedMsgId_, chatMsgEvent} = verifiedChatMsg verifiedMsg - (am'@GroupMember {memberId = amMemId, groupMemberId = amGroupMemId}, conn') <- updateMemberChatVRange authorMember conn chatVRange + -- binary messages (file chunks) carry only the initial-version sentinel, not the sender's range; + -- applying it would downgrade the member's negotiated version and suppress version-gated delivery + (am'@GroupMember {memberId = amMemId, groupMemberId = amGroupMemId}, conn') <- case encoding @e of + SBinary -> pure (authorMember, conn) + SJson -> updateMemberChatVRange authorMember conn chatVRange let agentMsgId = fst $ recipient agentMsgMeta brokerTs = metaBrokerTs agentMsgMeta newMsg = NewRcvMessage {chatMsgEvent, verifiedMsg, brokerTs} @@ -2552,11 +2616,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 = @@ -2718,7 +2782,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 => @@ -2748,15 +2812,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 @@ -2789,16 +2853,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) @@ -2810,7 +2874,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 @@ -2819,24 +2883,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 f6d36415dd..46174d631c 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -24,6 +24,7 @@ import Control.Monad.IO.Unlift import Control.Monad.Reader import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy.Char8 as LB import Data.Either (lefts, partitionEithers, rights) import Data.Foldable (foldr', foldrM) import Data.Functor (($>)) @@ -40,12 +41,14 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1) import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, diffUTCTime, getCurrentTime) +import Data.Time.Format (defaultTimeLocale, formatTime) import qualified Data.UUID as UUID import qualified Data.UUID.V4 as V4 import Data.Word (Word32) import Simplex.Chat.Call import Simplex.Chat.Controller import Simplex.Chat.Delivery +import Simplex.Chat.Files (getChatTempDirectory) import Simplex.Chat.Library.Internal import Simplex.Chat.Messages import Simplex.Chat.Messages.Batch (batchDeliveryTasks1, batchProfiles, batchProfilesWithBody, encodeBinaryBatch, encodeFwdElement, maxBatchElementSize) @@ -86,8 +89,10 @@ import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..)) import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn) import qualified Simplex.Messaging.Crypto.Ratchet as CR +import qualified Simplex.Messaging.Crypto.Lazy as LC import Simplex.Messaging.Encoding (smpEncode) import Simplex.Messaging.Encoding.String +import Simplex.Messaging.Parsers (parseAll) import Simplex.Messaging.Protocol (ErrorType (..), MsgFlags (..), ServiceSub (..), ServiceSubError (..), ServiceSubResult (..)) import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.ServiceScheme (ServiceScheme (..)) @@ -581,7 +586,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) @@ -1029,7 +1034,7 @@ processAgentMessageConn cxt 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 - (m'', conn', msg@RcvMessage {msgId, chatMsgEvent = ACME _ event}) <- saveGroupRcvMsg user groupId m' conn msgMeta verifiedMsg + (m'', conn', msg@RcvMessage {msgId, sharedMsgId_, 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 @@ -1068,17 +1073,17 @@ 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 - SJson -> fmap ctx <$> xGrpMemDel gInfo' m'' memId withMessages verifiedMsg msg brokerTs False + XGrpMemDel memId withMessages rosterVer -> case encoding @e of + SJson -> fmap ctx <$> xGrpMemDel gInfo' m'' memId withMessages rosterVer verifiedMsg msg brokerTs False SBinary -> pure Nothing 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 gInfo' m'' ps' msg - XGrpRoster gr -> fmap ctx <$> xGrpRoster gInfo' m'' gr verifiedMsg brokerTs + XGrpRoster gr -> fmap ctx <$> xGrpRoster gInfo' m'' gr verifiedMsg sharedMsgId_ brokerTs XGrpRosterAck ackVer ackErr -> Nothing <$ xGrpRosterAck gInfo' m'' ackVer ackErr -- 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 @@ -1140,7 +1145,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = checkSndInlineFTComplete conn msgId updateGroupItemsStatus gInfo m conn msgId GSSSent (Just $ isJust proxy) when continued $ do - when (isUserGrpFwdRelay gInfo) $ forwardGroupRoster user gInfo m -- roster ahead of the resumed backlog + when (isUserGrpFwdRelay gInfo) $ serveRoster user gInfo m -- roster ahead of the resumed backlog sendPendingGroupMessages user gInfo m conn SWITCH qd phase cStats -> do toView $ CEvtGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats) @@ -1234,7 +1239,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = QCONT -> do continued <- continueSending connEntity conn when continued $ do - when (isUserGrpFwdRelay gInfo) $ forwardGroupRoster user gInfo m -- roster ahead of the resumed backlog + when (isUserGrpFwdRelay gInfo) $ serveRoster user gInfo m -- roster ahead of the resumed backlog sendPendingGroupMessages user gInfo m conn MWARN msgId err -> do withStore' $ \db -> updateGroupItemsErrorStatus db msgId (groupMemberId' m) (GSSWarning $ agentSndError err) @@ -1308,13 +1313,15 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = r n'' = Just (ci, CIRcvDecryptionError mde n'') mdeUpdatedCI _ _ = Nothing - receiveFileChunk :: RcvFileTransfer -> Maybe Connection -> MsgMeta -> FileChunk -> CM () - receiveFileChunk ft@RcvFileTransfer {fileId, chunkSize} conn_ meta@MsgMeta {recipient = (msgId, _), integrity} = \case - FileChunkCancel -> - unless (rcvFileCompleteOrCancelled ft) $ do - cancelRcvFileTransfer user ft - ci <- withStore $ \db -> getChatItemByFileId db cxt user fileId - toView $ CEvtRcvFileSndCancelled user ci ft + receiveFileChunk :: Maybe GroupInfo -> RcvFileTransfer -> Maybe Connection -> MsgMeta -> FileChunk -> CM () + receiveFileChunk gInfo_ ft@RcvFileTransfer {fileId, fileType, chunkSize} conn_ MsgMeta {recipient = (msgId, _), integrity} = \case + FileChunkCancel -> case fileType of + FTRoster -> forM_ gInfo_ $ cleanupGroupRosterFile user + FTNormal -> + unless (rcvFileCompleteOrCancelled ft) $ do + cancelRcvFileTransfer user ft + ci <- withStore $ \db -> getChatItemByFileId db cxt user fileId + toView $ CEvtRcvFileSndCancelled user ci ft FileChunk {chunkNo, chunkBytes = chunk} -> do case integrity of MsgOk -> pure () @@ -1325,21 +1332,24 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = RcvChunkOk -> if B.length chunk /= fromInteger chunkSize then badRcvFileChunk ft "incorrect chunk size" - else withAckMessage' "file msg" agentConnId meta $ appendFileChunk ft chunkNo chunk False + else appendFileChunk ft chunkNo chunk False RcvChunkFinal -> if B.length chunk > fromInteger chunkSize then badRcvFileChunk ft "incorrect chunk size" else do appendFileChunk ft chunkNo chunk True - ci <- withStore $ \db -> do - liftIO $ do - updateRcvFileStatus db fileId FSComplete - updateCIFileStatus db user fileId CIFSRcvComplete - deleteRcvFileChunks db ft - getChatItemByFileId db cxt user fileId - toView $ CEvtRcvFileComplete user ci - mapM_ (deleteAgentConnectionAsync . aConnId) conn_ - RcvChunkDuplicate -> withAckMessage' "file msg" agentConnId meta $ pure () + case fileType of + FTRoster -> forM_ gInfo_ $ \gInfo -> rosterCompletion gInfo ft + FTNormal -> do + ci <- withStore $ \db -> do + liftIO $ do + updateRcvFileStatus db fileId FSComplete + updateCIFileStatus db user fileId CIFSRcvComplete + deleteRcvFileChunks db ft + getChatItemByFileId db cxt user fileId + toView $ CEvtRcvFileComplete user ci + mapM_ (deleteAgentConnectionAsync . aConnId) conn_ + RcvChunkDuplicate -> pure () RcvChunkError -> badRcvFileChunk ft $ "incorrect chunk number " <> show chunkNo processContactConnMessage :: AEvent e -> ConnectionEntity -> Connection -> UserContact -> CM () @@ -1383,9 +1393,6 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = events = XGrpRelayNew <$> newlyActive unless (null recipients) $ void $ sendGroupMessages user gInfo Nothing False recipients events - -- send the current roster to relays that just became active so they can serve joiners - forM_ newlyActiveGMIds $ \gmId -> - (withStore (\db -> getGroupMemberById db cxt user gmId) >>= sendGroupRosterToRelay user gInfo) `catchAllErrors` eToView where updateRelay :: DB.Connection -> GroupRelay -> ([GroupRelay], Bool, [ShortLinkContact], [GroupMemberId]) -> IO ([GroupRelay], Bool, [ShortLinkContact], [GroupMemberId]) updateRelay db relay@GroupRelay {groupMemberId, relayLink, relayStatus} (acc, changed, newlyActiveLinks, newlyActiveGMIds) = @@ -1445,12 +1452,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 @@ -1475,13 +1482,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 @@ -1545,7 +1552,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) @@ -2163,7 +2170,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = unless (maybe False memberBlocked m') $ autoAcceptFile file_ processFileInv gInfo' m' = let fileMember_ = if sentAsGroup then Nothing else m' - in processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId gInfo' fileMember_ + in processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId gInfo' fileMember_ FTNormal sharedMsgId_ newChatItem gInfo' m' scopeInfo ciContent ciFile_ timed live = do let mentions' = if maybe False memberBlocked m' then M.empty else mentions (ci, cInfo) <- saveRcvCI gInfo' m' scopeInfo ciContent ciFile_ timed live mentions' @@ -2370,7 +2377,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = processGroupFileInvitation' gInfo m fInv@FileInvitation {fileName, fileSize} msg@RcvMessage {sharedMsgId_} brokerTs = do ChatConfig {fileChunkSize} <- asks config inline <- receiveInlineMode fInv Nothing fileChunkSize - RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvGroupFileTransfer db userId gInfo (Just m) fInv inline fileChunkSize + RcvFileTransfer {fileId, xftpRcvFile} <- withStore $ \db -> createRcvGroupFileTransfer db userId gInfo (Just m) FTNormal sharedMsgId_ fInv inline fileChunkSize let fileProtocol = if isJust xftpRcvFile then FPXFTP else FPSMP ciFile = Just $ CIFile {fileId, fileName, fileSize, fileSource = Nothing, fileStatus = CIFSRcvInvitation, fileProtocol} content = ciContentNoParse $ CIRcvMsgContent $ MCFile "" @@ -2466,10 +2473,17 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = ft <- withStore $ \db -> getDirectFileIdBySharedMsgId db user ct sharedMsgId >>= getRcvFileTransfer db user receiveInlineChunk ft chunk meta + -- A group BFileChunk is a normal inline file chunk or a roster blob chunk, both located by + -- (group_id, shared_msg_id). A chunk matching no in-flight transfer (an orphaned re-served roster + -- chunk, or a missing normal file) is ignored; the outer withAckMessage acks it. bFileChunkGroup :: GroupInfo -> SharedMsgId -> FileChunk -> MsgMeta -> CM () - bFileChunkGroup GroupInfo {groupId} sharedMsgId chunk meta = do - ft <- withStore $ \db -> getGroupFileIdBySharedMsgId db userId groupId sharedMsgId >>= getRcvFileTransfer db user - receiveInlineChunk ft chunk meta + bFileChunkGroup gInfo@GroupInfo {groupId} sharedMsgId chunk meta = do + fileId_ <- withStore' $ \db -> getGroupRcvFileIdBySharedMsgId db userId groupId sharedMsgId + forM_ fileId_ $ \fileId -> do + ft <- withStore $ \db -> getRcvFileTransfer db user fileId + case fileType ft of + FTRoster -> receiveRosterChunk gInfo ft meta chunk + FTNormal -> receiveInlineChunk ft chunk meta receiveInlineChunk :: RcvFileTransfer -> FileChunk -> MsgMeta -> CM () receiveInlineChunk RcvFileTransfer {fileId, fileStatus = RFSNew} FileChunk {chunkNo} _ @@ -2479,7 +2493,18 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = case chunk of FileChunk {chunkNo} -> when (chunkNo == 1) $ startReceivingFile user fileId _ -> pure () - receiveFileChunk ft Nothing meta chunk + receiveFileChunk Nothing ft Nothing meta chunk + + -- A roster re-serve re-sends the blob from chunk 1; discard any partial first, else chunk 1 over a + -- partial is out-of-order (RcvChunkError) and appending after the stale prefix corrupts the blob. + receiveRosterChunk :: GroupInfo -> RcvFileTransfer -> MsgMeta -> FileChunk -> CM () + receiveRosterChunk gInfo ft meta chunk = do + case chunk of + FileChunk {chunkNo} | chunkNo == 1 -> do + last_ <- withStore' $ \db -> getRcvFileLastChunkNo db ft + when (isJust last_) $ resetRosterPartialChunks ft + _ -> pure () + receiveFileChunk (Just gInfo) ft Nothing meta chunk xFileCancelGroup :: GroupInfo -> Maybe GroupMember -> SharedMsgId -> CM (Maybe DeliveryTaskContext) xFileCancelGroup g@GroupInfo {groupId} m_ sharedMsgId = do @@ -2537,7 +2562,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 @@ -3092,10 +3117,12 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = messageError "x.grp.mem.intro ignored: member already exists" Left _ | useRelays' gInfo -> do - -- drop the relay-asserted key for privileged roles; their keys come from the roster, not intros + -- role + key are owner-authoritative (roster); an intro establishes neither - a privileged + -- claim is created at the channel default with no key until the owner-signed roster confirms it + defaultRole <- unknownMemberRole gInfo let memInfo' = case memInfo of MemberInfo mId mRole v p _ - | mRole > GRMember -> MemberInfo mId mRole v p Nothing + | mRole >= GRMember -> MemberInfo mId defaultRole v p Nothing _ -> memInfo void $ withStore $ \db -> createIntroReMember db user gInfo memInfo' memRestrictions | otherwise -> do @@ -3165,116 +3192,204 @@ 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 + -- rollback defense (channels): apply an owner-signed role/removal only at a version >= the persisted + -- roster_version (not the batch-constant gInfo, which a relay can stale by reordering events in one + -- batch), then advance it in the same transaction; a strictly lower version is a replay and is ignored. + applyAtRosterVersion :: GroupInfo -> Maybe VersionRoster -> CM (Maybe DeliveryJobScope) -> CM (Maybe DeliveryJobScope) + applyAtRosterVersion gInfo rosterVer_ action + | not (useRelays' gInfo) = action + | otherwise = case rosterVer_ of + Nothing -> action + Just v -> do + accept <- withStore' $ \db -> do + cur <- getGroupRosterVersion db gInfo + let fresh = maybe True (v >=) cur + when fresh $ setGroupRosterVersion db gInfo v + pure fresh + if accept + then action + else messageWarning "x.grp.mem: roster version not newer than current, ignoring" $> 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 | 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 + applyAtRosterVersion gInfo rosterVer_ $ + let gInfo' = gInfo {membership = membership {memberRole = memRole}} + in changeMemberRole gInfo' membership (\db -> updateGroupMemberRole db user membership memRole) $ RGEUserRole memRole + | otherwise = applyAtRosterVersion gInfo rosterVer_ $ 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, created)) + -- just created (keyless, and allowCreate ensured the event carries its key): pin key + role + | created, Just (MemberKey pubKey) <- memberKey_ -> + let gEvent = RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole + in changeMemberRole gInfo member (\db -> void $ applyMemberKeyRole db member pubKey memRole) gEvent + -- known member: apply the role (its key is established via roster/intro; the event's key is ignored) + | otherwise -> + let gEvent = RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) memRole + in changeMemberRole gInfo member (\db -> updateGroupMemberRole db user member memRole) gEvent + -- in relay groups the roster may deliver role update for previously-unknown privileged members + _ | useRelays' gInfo -> pure Nothing | otherwise -> messageError "x.grp.mem.role with unknown member ID" $> Nothing where GroupMember {memberId = membershipMemId} = membership - changeMemberRole gInfo' member@GroupMember {memberRole = fromRole} gEvent + -- applyMember writes the change (role, or role + pinned key for a freshly TOFU-created member); + -- the delivery scope (relay forwarding) is computed on the pre-change role + changeMemberRole gInfo' member@GroupMember {memberRole = fromRole} applyMember 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 moderator/admin roles in relay groups" $> Nothing + messageError "x.grp.mem.role: only the owner can change member, moderator and admin roles in relay groups" $> Nothing + -- in channels a forwarded role event that the roster already applied is a no-op; suppress it + | useRelays' gInfo && fromRole == memRole = pure $ memberEventDeliveryScope member | otherwise = do - withStore' $ \db -> updateGroupMemberRole db user member memRole + withStore' applyMember (gInfo'', m', scopeInfo) <- mkGroupChatScope gInfo' m (ci, cInfo) <- saveRcvChatItemNoParse user (CDGroupRcv gInfo'' scopeInfo m') msg brokerTs (CIRcvGroupEvent gEvent) groupMsgToView cInfo ci toView CEvtMemberRole {user, groupInfo = gInfo'', byMember = m', member = member {memberRole = memRole}, fromRole, toRole = memRole, msgSigned} pure $ memberEventDeliveryScope member - xGrpRoster :: MsgEncodingI e => GroupInfo -> GroupMember -> GroupRoster -> VerifiedMsg e -> UTCTime -> CM (Maybe DeliveryJobScope) - xGrpRoster gInfo author roster verifiedMsg brokerTs + -- The header only starts the transfer; the roster is applied and the version bumped only at + -- blob completion, so a withheld or corrupted blob leaves the last good roster intact. + xGrpRoster :: GroupInfo -> GroupMember -> GroupRoster -> VerifiedMsg e -> Maybe SharedMsgId -> UTCTime -> CM (Maybe DeliveryJobScope) + xGrpRoster gInfo author GroupRoster {version = newVer, fileInv = InlineFileInvitation {fileSize, fileDigest}} verifiedMsg sharedMsgId_ brokerTs -- only an owner may sign a roster; otherwise a relay could route it as a member whose key it controls | memberRole' author /= GROwner = messageError "x.grp.roster: not signed by an owner" $> Nothing - | length entries > maxGroupRosterSize = messageError ("x.grp.roster: too many entries, max " <> tshow maxGroupRosterSize) $> Nothing - | isUserGrpFwdRelay gInfo = relayApplyRoster - | otherwise = Nothing <$ memberApplyRoster + | fileSize > maxGroupRosterBytes = messageError "x.grp.roster: roster blob size exceeds limit" $> Nothing + | otherwise = case verifiedMsg of + -- unreachable: XGrpRoster is in requiresSignature, so withVerifiedMsg rejected unsigned + VMUnsigned _ -> pure Nothing + VMSigned _ sm _ -> case sharedMsgId_ of + Nothing -> Nothing <$ messageWarning "x.grp.roster: missing shared message id" + Just sharedMsgId -> do + pendingVer_ <- fmap (\(v, _, _, _, _) -> v) <$> withStore' (\db -> getRosterPending db gInfo) + -- accept a version not below BOTH applied and pending (>=, Nothing below 0): a preceding signed + -- event may have already advanced rosterVersion to this blob's version; a lower one is a downgrade. + if newVer `aboveRoster` rosterVersion gInfo && newVer `aboveRoster` pendingVer_ + then startRosterTransfer sm sharedMsgId + else pure Nothing + where + startRosterTransfer sm sharedMsgId = do + -- supersede any in-flight roster file (older version or a restart) before the new transfer + cleanupGroupRosterFile user gInfo + let relayHdr = if isUserGrpFwdRelay gInfo then Just sm else Nothing + withStore' $ \db -> setRosterPending db gInfo newVer fileDigest (groupMemberId' author) brokerTs relayHdr + chSize <- asks $ fileChunkSize . config + let rosterFInv = FileInvitation {fileName = "roster", fileSize, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Just IFMSent, fileDescr = Nothing} + rft@RcvFileTransfer {fileId} <- withStore $ \db -> createRcvGroupFileTransfer db userId gInfo Nothing FTRoster (Just sharedMsgId) rosterFInv (Just IFMSent) (fromIntegral chSize) + -- accept the chat-item-free file before chunk 1 (FIFO before it) so chunk 1 isn't rejected on RFSNew + -- transient scratch file (consumed into roster_blob, then deleted): temp folder, not the user's files folder / Downloads + tmpDir <- lift getChatTempDirectory + rosterTs <- liftIO getCurrentTime + let GroupInfo {groupId = gId} = gInfo + rosterFile = "roster_" <> show gId <> "_" <> formatTime defaultTimeLocale "%Y%m%d_%H%M%S" rosterTs + filePath <- getRcvFilePath fileId (Just tmpDir) rosterFile False + withStore' $ \db -> startRcvInlineFT db user rft filePath (Just IFMSent) + pure Nothing + + -- Roster version comparison treating Nothing (un-materialized) as below 0. Non-strict (>=) so a relay + -- accepts the owner's blob at the version a preceding signed event already advanced rosterVersion to. + aboveRoster :: VersionRoster -> Maybe VersionRoster -> Bool + aboveRoster v = maybe True (v >=) + + -- Blob arrived: verify the owner-attested digest over the plaintext and guard against + -- downgrade before applying; on a relay, ack the owner and re-serve to members. + rosterCompletion :: GroupInfo -> RcvFileTransfer -> CM () + rosterCompletion gInfo RcvFileTransfer {fileStatus} = + withStore' (\db -> getRosterPending db gInfo) >>= \case + Nothing -> cleanupGroupRosterFile user gInfo + Just (pendingVer, pendingDigest, ownerGMId, rosterBrokerTs, _) -> do + owner_ <- withStore' $ \db -> eitherToMaybe <$> runExceptT (getGroupMemberById db cxt user ownerGMId) + blob <- readAssembledRoster + let isRelay = isUserGrpFwdRelay gInfo + ackErr err = do + cleanupGroupRosterFile user gInfo + when isRelay $ forM_ owner_ $ \owner -> sendRosterAck gInfo owner pendingVer (Just err) + if FD.FileDigest (LC.sha512Hash (LB.fromStrict blob)) /= pendingDigest + then ackErr "relay could not verify the roster blob" + else case parseAll rosterBlobP blob of + Left _ -> ackErr "relay could not parse the roster blob" + Right entries -> case owner_ of + Nothing -> cleanupGroupRosterFile user gInfo + Just author -> do + defaultRole <- unknownMemberRole gInfo + -- gate against the persisted roster_version inside the apply transaction, so a reordered + -- same-batch event cannot make this completion downgrade it; stale completion is rejected. + results_ <- withStore $ \db -> do + cur <- liftIO $ getGroupRosterVersion db gInfo + if maybe False (pendingVer <) cur + then pure Nothing + else do + res <- processRosterEntries db gInfo defaultRole (validateGroupRoster entries) + liftIO $ promoteRosterPending db gInfo blob + pure (Just res) + cleanupGroupRosterFile user gInfo + forM_ results_ $ \results -> do + emitRosterResults gInfo author rosterBrokerTs results + -- 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 + RFSConnected fp -> readAt fp + RFSComplete fp -> readAt fp + _ -> throwChatError $ CEInternalError "roster file not in progress" + readAt fp = lift (toFSFilePath fp) >>= liftIO . B.readFile + + -- 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, Bool)]) + processRosterEntries db gInfo defaultRole entries = do + let rosterIds = map (\RosterMember {memberId} -> memberId) entries + (cs, as) <- foldrM applyRosterEntry ([], []) entries + currentPriv <- liftIO $ getGroupRosterMembers 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) = + ( getCreateUnknownGMByMemberId db cxt user gInfo memberId (nameFromMemberId memberId) defaultRole True >>= \case + Nothing -> pure (cs, as) + 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, 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, created) -> + unless created $ createItems member fromRole where - GroupRoster {version = newVer, roster = entries} = validRoster - validRoster = validateGroupRoster roster - relayApplyRoster :: CM (Maybe DeliveryJobScope) - relayApplyRoster - | maybe False (newVer <=) (rosterVersion gInfo) = Nothing <$ messageWarning "x.grp.roster: not newer than saved version" - | otherwise = case verifiedMsg of - VMSigned _ sm _ -> - tryAllErrors (setRoster sm) >>= \case - Right results -> do - emitRosterResults results - -- ack only while still setting up (own status RSAccepted); a serving relay (RSActive) must not ack roster broadcasts - when (relayOwnStatus gInfo == Just RSAccepted) $ sendRosterAck author newVer Nothing - -- always broadcast on a bump: self-healing, and demotions must reach members - pure $ Just DJSGroup {jobSpec = DJDeliveryJob {includePending = False}} - Left e -> do - eToView e - when (relayOwnStatus gInfo == Just RSAccepted) $ sendRosterAck author newVer (Just "relay could not save the roster") - pure Nothing - VMUnsigned _ -> Nothing <$ messageWarning "x.grp.roster: unsigned roster" - setRoster :: SignedMsg -> CM ([MemberId], [(GroupMember, GroupMemberRole)]) - setRoster sm = do - defaultRole <- unknownMemberRole gInfo - withStore $ \db -> do - res <- processRoster db defaultRole - liftIO $ setGroupRoster db gInfo newVer (groupMemberId' author) brokerTs sm - pure res - memberApplyRoster :: CM () - memberApplyRoster - | maybe False (newVer <) (rosterVersion gInfo) = messageWarning "x.grp.roster: older than accepted version" - | maybe False (newVer ==) (rosterVersion gInfo) = pure () - | otherwise = do - defaultRole <- unknownMemberRole gInfo - results <- withStore $ \db -> do - res <- processRoster db defaultRole - liftIO $ setGroupRosterVersion db gInfo newVer - pure res - emitRosterResults results - processRoster :: DB.Connection -> GroupMemberRole -> ExceptT StoreError IO ([MemberId], [(GroupMember, GroupMemberRole)]) - processRoster db defaultRole = 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 - liftIO $ forM_ currentPriv $ \m -> - when (memberId' m `notElem` rosterIds) $ - updateGroupMemberRole db user m defaultRole - pure acc - where - -- entry-level failure (StoreError or IO exception) is muted; the entry is dropped - applyRosterEntry RosterMember {memberId, name, 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 name 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 - emitRosterResults :: ([MemberId], [(GroupMember, GroupMemberRole)]) -> CM () - emitRosterResults (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 - createItems :: GroupMember -> GroupMemberRole -> CM () 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 brokerTs) + 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 :: GroupMember -> VersionRoster -> Maybe Text -> CM () - sendRosterAck owner ackVer err = void $ sendGroupMessage' user gInfo [owner] (XGrpRosterAck ackVer err) + + sendRosterAck :: GroupInfo -> GroupMember -> VersionRoster -> Maybe Text -> CM () + sendRosterAck gInfo owner ackVer err = void $ sendGroupMessage' user gInfo [owner] (XGrpRosterAck ackVer err) xGrpRosterAck :: GroupInfo -> GroupMember -> VersionRoster -> Maybe Text -> CM () xGrpRosterAck gInfo m ackVer err = do @@ -3340,8 +3455,8 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = withStore $ \db -> setMemberVectorRelationConnected db sendingMem refMem MRSubjectConnected withStore $ \db -> setMemberVectorRelationConnected db refMem sendingMem MRReferencedConnected - xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> Bool -> VerifiedMsg 'Json -> RcvMessage -> UTCTime -> Bool -> CM (Maybe DeliveryJobScope) - xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId withMessages verifiedMsg msg@RcvMessage {msgSigned} brokerTs forwarded = do + xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> Bool -> Maybe VersionRoster -> VerifiedMsg 'Json -> RcvMessage -> UTCTime -> Bool -> CM (Maybe DeliveryJobScope) + xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId withMessages rosterVer_ verifiedMsg msg@RcvMessage {msgSigned} brokerTs forwarded = do let GroupMember {memberId = membershipMemId} = membership if membershipMemId == memId then checkRole membership $ do @@ -3356,7 +3471,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = deleteMemberItem msg gInfo RGEUserDeleted toView $ CEvtDeletedMemberUser user gInfo {membership = membership'} m withMessages msgSigned pure $ Just DJSGroup {jobSpec = DJRelayRemoved} - else + else applyAtRosterVersion gInfo rosterVer_ $ withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memId) >>= \case Left _ -> do messageError "x.grp.mem.del with unknown member ID" @@ -3435,9 +3550,6 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = (ci, cInfo) <- saveRcvChatItemNoParse user (CDGroupRcv gInfo''' scopeInfo m') msg brokerTs (CIRcvGroupEvent RGEMemberLeft) groupMsgToView cInfo ci toView $ CEvtLeftMember user gInfo''' m' {memberStatus = GSMemLeft} msgSigned - -- a privileged leaver drops out of the roster - when (useRelays' gInfo'' && memberRole' (membership gInfo'') == GROwner && isRosterRole (memberRole' m)) $ - bumpAndBroadcastRoster user gInfo'' `catchAllErrors` eToView pure $ memberEventDeliveryScope m xGrpDel :: GroupInfo -> GroupMember -> RcvMessage -> UTCTime -> CM () @@ -3608,7 +3720,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = processForwardedMsg :: VerifiedMsg 'Json -> Maybe GroupMember -> CM () processForwardedMsg verifiedMsg author_ = do rcvMsg_ <- saveGroupFwdRcvMsg user gInfo m author_ verifiedMsg brokerTs - forM_ rcvMsg_ $ \rcvMsg@RcvMessage {chatMsgEvent = ACME _ event} -> case event of + forM_ rcvMsg_ $ \rcvMsg@RcvMessage {sharedMsgId_, chatMsgEvent = ACME _ event} -> case event of XMsgNew mc -> void $ memberCanSend author_ scope $ newGroupContentMessage gInfo author_ mc rcvMsg msgTs True where @@ -3623,14 +3735,14 @@ 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 + XGrpMemDel memId withMessages rosterVer -> withAuthor XGrpMemDel_ $ \author -> void $ xGrpMemDel gInfo author memId withMessages rosterVer 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 gInfo author ps' rcvMsg - XGrpRoster gr -> withAuthor XGrpRoster_ $ \author -> void $ xGrpRoster gInfo author gr verifiedMsg msgTs + XGrpRoster gr -> withAuthor XGrpRoster_ $ \author -> void $ xGrpRoster gInfo author gr verifiedMsg sharedMsgId_ msgTs _ -> messageError $ "x.grp.msg.forward: unsupported forwarded event " <> T.pack (show $ toCMEventTag event) where withAuthor :: CMEventTag e -> (GroupMember -> CM ()) -> CM () diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index a7aa3284d9..798baeed0d 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -48,12 +48,13 @@ import Data.Time.Clock (UTCTime) import Data.Time.Clock.System (systemToUTCTime, utcToSystemTime) import Data.Type.Equality import Data.Typeable (Typeable) -import Data.Word (Word32) +import Data.Word (Word16, Word32) import Simplex.Chat.Call import Simplex.Chat.Options.DB (FromField (..), ToField (..)) import Simplex.Chat.Types import Simplex.Chat.Types.Preferences import Simplex.Chat.Types.Shared +import qualified Simplex.FileTransfer.Description as FD import Simplex.Messaging.Agent.Protocol (VersionSMPA, pqdrSMPAgentVersion) import Simplex.Messaging.Agent.Store.DB (blobFieldDecoder, fromTextField_) import Simplex.Messaging.Compression (Compressed, compress1, decompress1, decompressedSize) @@ -367,22 +368,37 @@ data GrpMsgForward = GrpMsgForward } deriving (Eq, Show) --- | Owner-signed snapshot of the privileged (moderator/admin) set; owners are --- not included, their keys come from the link. +-- | Owner-signed roster header for the privileged (moderator/admin/member) set; owners +-- are not included, their keys come from the link. The member list itself is not +-- here: it is sent as a binary blob over the inline file transfer, and this header +-- carries only its inline-file invitation (size + owner-attested digest). data GroupRoster = GroupRoster { version :: VersionRoster, - roster :: [RosterMember] + fileInv :: InlineFileInvitation + } + deriving (Eq, Show) + +-- | Lean always-inline file invitation for the roster blob, carried in the signed +-- header. The digest authenticates the unsigned blob; integrity is entirely the digest. +data InlineFileInvitation = InlineFileInvitation + { fileSize :: Integer, + fileDigest :: FD.FileDigest } deriving (Eq, Show) data RosterMember = RosterMember { memberId :: MemberId, - name :: Text, key :: MemberKey, -- trust-on-first-use pinned per memberId - role :: GroupMemberRole + role :: GroupMemberRole, + privileges :: Word16 -- reserved: serialized as 0, parsed and ignored in v1 } deriving (Eq, Show) +-- RosterMember is binary-only: it rides in the roster blob, never in a JSON message. +instance Encoding RosterMember where + smpEncode RosterMember {memberId, key, role, privileges} = smpEncode (memberId, key, role, privileges) + smpP = RosterMember <$> smpP <*> smpP <*> smpP <*> smpP + instance Encoding FwdSender where smpEncode = \case FwdMember memberId memberName -> smpEncode ('M', memberId, memberName) @@ -485,11 +501,11 @@ 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 - XGrpMemDel :: MemberId -> Bool -> ChatMsgEvent 'Json + XGrpMemDel :: MemberId -> Bool -> Maybe VersionRoster -> ChatMsgEvent 'Json XGrpLeave :: ChatMsgEvent 'Json XGrpDel :: ChatMsgEvent 'Json XGrpInfo :: GroupProfile -> ChatMsgEvent 'Json @@ -809,7 +825,7 @@ data MsgMention = MsgMention {memberId :: MemberId} newtype MsgMentions = MsgMentions (Map MemberName MsgMention) deriving (Eq, Show) -$(JQ.deriveJSON defaultJSON ''RosterMember) +$(JQ.deriveJSON defaultJSON ''InlineFileInvitation) $(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "MCL") ''MsgChatLink) @@ -911,11 +927,27 @@ maxCompressedMsgLength = 13380 maxDecompressedMsgLength :: Int maxDecompressedMsgLength = 65536 --- Bound so the signed roster fits maxEncodedMsgLength (15602 B): ~140 B per --- RosterMember (memberId + Ed25519 key both base64, role, name capped at 16 --- chars by memberShortenedName). Fits 64 entries even with 4-byte-UTF-8 names. +-- Defensive entry-count bound for the roster blob parser (rosterBlobP) and the +-- promotion cap over the promoted (member/moderator/admin) set. maxGroupRosterSize :: Int -maxGroupRosterSize = 64 +maxGroupRosterSize = 256 + +-- Receive-side byte bound: reject an owner-signed header whose claimed fileSize exceeds what +-- maxGroupRosterSize entries can occupy (128 B/entry is a generous worst case), before a file is created. +-- 128 B/entry ~ memberId + X.509 Ed25519 key (44 B) + role + privileges + 1-byte length prefixes (~2x the ~65 B typical). +maxGroupRosterBytes :: Integer +maxGroupRosterBytes = fromIntegral maxGroupRosterSize * 128 + +-- The byte sequence the owner-signed digest is computed over and verified against +-- before parsing. Word16 count (smpEncodeList's 1-byte count is too small for the future cap). +encodeRosterBlob :: [RosterMember] -> ByteString +encodeRosterBlob ms = smpEncode (fromIntegral (length ms) :: Word16) <> B.concat (map smpEncode ms) + +rosterBlobP :: A.Parser [RosterMember] +rosterBlobP = do + n <- fromIntegral <$> smpP @Word16 + when (n > maxGroupRosterSize) $ fail "roster: too many entries" + A.count n smpP -- maxEncodedMsgLength - delta between MSG and INFO + 100 (returned for forward overhead) -- delta between MSG and INFO = e2eEncUserMsgLength (no PQ) - e2eEncConnInfoLength (no PQ) = 1008 @@ -1227,7 +1259,7 @@ toCMEventTag msg = case msg of XGrpMemInv _ _ -> XGrpMemInv_ XGrpMemFwd _ _ -> XGrpMemFwd_ XGrpMemInfo _ _ -> XGrpMemInfo_ - XGrpMemRole _ _ -> XGrpMemRole_ + XGrpMemRole {} -> XGrpMemRole_ XGrpMemRestrict _ _ -> XGrpMemRestrict_ XGrpMemCon _ -> XGrpMemCon_ XGrpMemConAll _ -> XGrpMemConAll_ @@ -1388,17 +1420,17 @@ 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" - XGrpMemDel_ -> XGrpMemDel <$> p "memberId" <*> Right (fromRight False $ p "messages") + XGrpMemDel_ -> XGrpMemDel <$> p "memberId" <*> Right (fromRight False $ p "messages") <*> opt "rosterVersion" XGrpLeave_ -> pure XGrpLeave XGrpDel_ -> pure XGrpDel XGrpInfo_ -> XGrpInfo <$> p "groupProfile" XGrpPrefs_ -> XGrpPrefs <$> p "groupPreferences" XGrpDirectInv_ -> XGrpDirectInv <$> p "connReq" <*> opt "content" <*> opt "scope" - XGrpRoster_ -> XGrpRoster <$> (GroupRoster <$> p "version" <*> p "roster") + XGrpRoster_ -> XGrpRoster <$> (GroupRoster <$> p "version" <*> p "fileInv") XGrpRosterAck_ -> XGrpRosterAck <$> p "version" <*> opt "error" XGrpMsgForward_ -> do fwdSender <- opt "memberId" >>= \case @@ -1462,17 +1494,17 @@ 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] - XGrpMemDel memId messages -> o $ ("messages" .=? if messages then Just True else Nothing) ["memberId" .= memId] + XGrpMemDel memId messages rosterVersion -> o $ ("rosterVersion" .=? rosterVersion) $ ("messages" .=? if messages then Just True else Nothing) ["memberId" .= memId] XGrpLeave -> JM.empty XGrpDel -> JM.empty XGrpInfo p -> o ["groupProfile" .= p] XGrpPrefs p -> o ["groupPreferences" .= p] XGrpDirectInv connReq content scope -> o $ ("content" .=? content) $ ("scope" .=? scope) ["connReq" .= connReq] - XGrpRoster GroupRoster {version, roster} -> o ["version" .= version, "roster" .= roster] + XGrpRoster GroupRoster {version, fileInv} -> o ["version" .= version, "fileInv" .= fileInv] XGrpRosterAck version err -> o $ ("error" .=? err) ["version" .= version] XGrpMsgForward GrpMsgForward {fwdSender, fwdBrokerTs} msg -> o $ encodeFwdSender fwdSender ["msg" .= msg, "msgTs" .= fwdBrokerTs] where diff --git a/src/Simplex/Chat/Store/Files.hs b/src/Simplex/Chat/Store/Files.hs index 5289a3b304..2db63f6a5b 100644 --- a/src/Simplex/Chat/Store/Files.hs +++ b/src/Simplex/Chat/Store/Files.hs @@ -31,6 +31,10 @@ module Simplex.Chat.Store.Files getSharedMsgIdByFileId, getFileIdBySharedMsgId, getGroupFileIdBySharedMsgId, + getGroupRcvFileIdBySharedMsgId, + getGroupRosterFileInfo, + deleteGroupRosterFile, + getRcvFileLastChunkNo, getDirectFileIdBySharedMsgId, getChatRefByFileId, lookupChatRefByFileId, @@ -320,6 +324,42 @@ getGroupFileIdBySharedMsgId db userId groupId sharedMsgId = |] (userId, groupId, sharedMsgId) +-- Locates a received group file (normal or roster) by the header's shared_msg_id without the +-- chat_items join, so it finds the chat-item-free roster blob and normal inline files alike. +-- Nothing => no in-flight transfer (an orphaned re-served chunk), which the caller ACKs and ignores. +getGroupRcvFileIdBySharedMsgId :: DB.Connection -> UserId -> Int64 -> SharedMsgId -> IO (Maybe Int64) +getGroupRcvFileIdBySharedMsgId db userId groupId sharedMsgId = + maybeFirstRow fromOnly $ + DB.query + db + [sql| + SELECT f.file_id FROM files f + JOIN rcv_files r ON r.file_id = f.file_id + WHERE f.user_id = ? AND f.group_id = ? AND f.shared_msg_id = ? + |] + (userId, groupId, sharedMsgId) + +-- For roster-file cleanup keyed on the group (not a chat item): every matching file_id and its on-disk +-- path, so the caller evicts the handle and removes the file for each — delete-all like deleteGroupRosterFile. +getGroupRosterFileInfo :: DB.Connection -> UserId -> Int64 -> IO [(Int64, Maybe FilePath)] +getGroupRosterFileInfo db userId groupId = + DB.query + db + "SELECT file_id, file_path FROM files WHERE user_id = ? AND group_id = ? AND file_type = ?" + (userId, groupId, FTRoster) + +-- Deletes the roster files row; rcv_files and rcv_file_chunks cascade on the FK. +deleteGroupRosterFile :: DB.Connection -> UserId -> Int64 -> IO () +deleteGroupRosterFile db userId groupId = + DB.execute db "DELETE FROM files WHERE user_id = ? AND group_id = ? AND file_type = ?" (userId, groupId, FTRoster) + +-- The highest stored chunk number, or Nothing if no partial chunks exist (used to decide +-- whether an arriving chunk 1 is a re-driven transfer that must reset). +getRcvFileLastChunkNo :: DB.Connection -> RcvFileTransfer -> IO (Maybe Integer) +getRcvFileLastChunkNo db RcvFileTransfer {fileId} = + maybeFirstRow fromOnly $ + DB.query db "SELECT chunk_number FROM rcv_file_chunks WHERE file_id = ? ORDER BY chunk_number DESC LIMIT 1" (Only fileId) + getDirectFileIdBySharedMsgId :: DB.Connection -> User -> Contact -> SharedMsgId -> ExceptT StoreError IO Int64 getDirectFileIdBySharedMsgId db User {userId} Contact {contactId} sharedMsgId = ExceptT . firstRow fromOnly (SEFileIdNotFoundBySharedMsgId sharedMsgId) $ @@ -378,10 +418,10 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File db "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)" (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, rfdId, currentTs, currentTs) - pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing, cryptoArgs = Nothing} + pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, fileType = FTNormal, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing, cryptoArgs = Nothing} -createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupInfo -> Maybe GroupMember -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer -createRcvGroupFileTransfer db userId GroupInfo {groupId, localDisplayName = gName} m_ f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do +createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupInfo -> Maybe GroupMember -> FileType -> Maybe SharedMsgId -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer +createRcvGroupFileTransfer db userId GroupInfo {groupId, localDisplayName = gName} m_ fileType sharedMsgId_ f@FileInvitation {fileName, fileSize, fileConnReq, fileInline, fileDescr} rcvFileInline chunkSize = do currentTs <- liftIO getCurrentTime rfd_ <- mapM (createRcvFD_ db userId currentTs) fileDescr let rfdId = (\RcvFileDescr {fileDescrId} -> fileDescrId) <$> rfd_ @@ -393,15 +433,15 @@ createRcvGroupFileTransfer db userId GroupInfo {groupId, localDisplayName = gNam fileId <- liftIO $ do DB.execute db - "INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)" - (userId, groupId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, fileProtocol, currentTs, currentTs) + "INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, protocol, file_type, shared_msg_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)" + (userId, groupId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, fileProtocol, fileType, sharedMsgId_, currentTs, currentTs) insertedRowId db liftIO $ DB.execute db "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, group_member_id, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, grpMemberId_, rfdId, currentTs, currentTs) - pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = senderName, chunkSize, cancelled = False, grpMemberId = grpMemberId_, cryptoArgs = Nothing} + pure RcvFileTransfer {fileId, xftpRcvFile, fileInvitation = f, fileStatus = RFSNew, fileType, rcvFileInline, senderDisplayName = senderName, chunkSize, cancelled = False, grpMemberId = grpMemberId_, cryptoArgs = Nothing} createRcvStandaloneFileTransfer :: DB.Connection -> UserId -> CryptoFile -> Int64 -> Word32 -> ExceptT StoreError IO Int64 createRcvStandaloneFileTransfer db userId (CryptoFile filePath cfArgs_) fileSize chunkSize = do @@ -530,7 +570,7 @@ getRcvFileTransfer_ db userId fileId = do SELECT r.file_status, r.file_queue_info, r.group_member_id, f.file_name, f.file_size, f.chunk_size, f.cancelled, cs.local_display_name, m.local_display_name, f.file_path, f.file_crypto_key, f.file_crypto_nonce, r.file_inline, r.rcv_file_inline, - r.agent_rcv_file_id, r.agent_rcv_file_deleted, r.user_approved_relays, g.local_display_name + r.agent_rcv_file_id, r.agent_rcv_file_deleted, r.user_approved_relays, g.local_display_name, f.file_type FROM rcv_files r JOIN files f USING (file_id) LEFT JOIN contacts cs ON cs.contact_id = f.contact_id @@ -544,9 +584,9 @@ getRcvFileTransfer_ db userId fileId = do where rcvFileTransfer :: Maybe RcvFileDescr -> - (FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe BoolInt) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe InlineFileMode, Maybe AgentRcvFileId, BoolInt, BoolInt) :. Only (Maybe ContactName) -> + (FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe BoolInt) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe InlineFileMode, Maybe InlineFileMode, Maybe AgentRcvFileId, BoolInt, BoolInt) :. (Maybe ContactName, FileType) -> ExceptT StoreError IO RcvFileTransfer - rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileKey, fileNonce, fileInline, rcvFileInline, agentRcvFileId, BI agentRcvFileDeleted, BI userApprovedRelays) :. Only groupName_) = + rcvFileTransfer rfd_ ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileKey, fileNonce, fileInline, rcvFileInline, agentRcvFileId, BI agentRcvFileDeleted, BI userApprovedRelays) :. (groupName_, fileType)) = case contactName_ <|> memberName_ <|> groupName_ <|> standaloneName_ of Nothing -> throwError $ SERcvFileInvalid fileId Just name -> @@ -564,7 +604,7 @@ getRcvFileTransfer_ db userId fileId = do let fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing} cryptoArgs = CFArgs <$> fileKey <*> fileNonce xftpRcvFile = (\rfd -> XFTPRcvFile {rcvFileDescription = rfd, agentRcvFileId, agentRcvFileDeleted, userApprovedRelays}) <$> rfd_ - in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId, cryptoArgs} + in RcvFileTransfer {fileId, xftpRcvFile, fileInvitation, fileStatus, fileType, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId, cryptoArgs} filePath = case filePath_ of Nothing -> throwError $ SERcvFileInvalid fileId Just fp -> pure fp @@ -660,7 +700,15 @@ createRcvFileChunk db RcvFileTransfer {fileId, fileInvitation = FileInvitation { currentTs <- getCurrentTime DB.execute db - "INSERT OR REPLACE INTO rcv_file_chunks (file_id, chunk_number, chunk_agent_msg_id, created_at, updated_at) VALUES (?,?,?,?,?)" + [sql| + INSERT INTO rcv_file_chunks (file_id, chunk_number, chunk_agent_msg_id, created_at, updated_at) + VALUES (?,?,?,?,?) + ON CONFLICT (file_id, chunk_number) DO UPDATE SET + chunk_agent_msg_id = excluded.chunk_agent_msg_id, + chunk_stored = 0, + created_at = excluded.created_at, + updated_at = excluded.updated_at + |] (fileId, chunkNo, msgId, currentTs, currentTs) pure status where diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 48b4cffcbc..df239dd109 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -68,6 +68,8 @@ module Simplex.Chat.Store.Groups getSupportScopeMembersByIndexes, getGroupModerators, getGroupRosterMembers, + getGroupAdminsMods, + getGroupOnlyMembers, getGroupOwners, getGroupRelayMembers, getGroupMembersForExpiration, @@ -87,8 +89,12 @@ module Simplex.Chat.Store.Groups getGroupRelays, getConnectedGroupRelays, setGroupRosterVersion, - setGroupRoster, + getGroupRosterVersion, getGroupRoster, + setRosterPending, + getRosterPending, + promoteRosterPending, + clearRosterPending, setGroupMemberKeyRole, createRelayForOwner, getCreateRelayForMember, @@ -218,6 +224,7 @@ import Simplex.Chat.Types.Shared import Simplex.Chat.Types.UITheme import Simplex.Messaging.Agent.Protocol (ConfirmationId, ConnId, CreatedConnLink (..), InvitationId, OwnerAuth (..), UserId) import Simplex.Messaging.Agent.Store.AgentStore (firstRow, fromOnlyBI, maybeFirstRow) +import qualified Simplex.FileTransfer.Description as FD import Simplex.Messaging.Encoding (smpDecode, smpEncode) import Simplex.Messaging.Agent.Store.DB (Binary (..), BoolInt (..)) import Simplex.Messaging.Agent.Store.Entity (DBEntityId) @@ -1209,17 +1216,35 @@ getGroupModerators db cxt user@User {userId, userContactId} GroupInfo {groupId} (groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?,?)") (userId, groupId, userContactId, GRModerator, GRAdmin, GROwner) --- Moderators and admins only, excluding owners and non-current members. --- Used for roster-related paths where owners must not be touched (owners are --- link-anchored), and left/removed members must not appear in the saved roster. +-- The full roster set - members, moderators and admins - excluding owners (link-anchored) and +-- left/removed members. For the privileged subset only use getGroupAdminsMods; for plain members +-- only use getGroupOnlyMembers. getGroupRosterMembers :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember] getGroupRosterMembers db cxt user@User {userId, userContactId} GroupInfo {groupId} = do + filter memberCurrent . map (toContactMember cxt user) + <$> DB.query + db + (groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?,?)") + (userId, groupId, userContactId, GRMember, GRModerator, GRAdmin) + +-- Moderators and admins only (excluding owners and plain members) - the set introduced to a +-- joiner; plain members are learned from the roster blob, not via introductions. +getGroupAdminsMods :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember] +getGroupAdminsMods db cxt user@User {userId, userContactId} GroupInfo {groupId} = do filter memberCurrent . map (toContactMember cxt user) <$> DB.query db (groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?)") (userId, groupId, userContactId, GRModerator, GRAdmin) +getGroupOnlyMembers :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember] +getGroupOnlyMembers db cxt user@User {userId, userContactId} GroupInfo {groupId} = do + filter memberCurrent . map (toContactMember cxt user) + <$> DB.query + db + (groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role = ?") + (userId, groupId, userContactId, GRMember) + getGroupOwners :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupMember] getGroupOwners db cxt user@User {userId, userContactId} GroupInfo {groupId} = do filter memberCurrent . map (toContactMember cxt user) @@ -1411,35 +1436,114 @@ setGroupRosterVersion db GroupInfo {groupId} v = do currentTs <- getCurrentTime DB.execute db "UPDATE groups SET roster_version = ?, updated_at = ? WHERE group_id = ?" (v, currentTs, groupId) --- Relay saves the verbatim signed roster (parts + sending owner + broker ts) to re-forward to joiners. -setGroupRoster :: DB.Connection -> GroupInfo -> VersionRoster -> GroupMemberId -> UTCTime -> SignedMsg -> IO () -setGroupRoster db GroupInfo {groupId} v ownerGMId brokerTs SignedMsg {chatBinding, signatures, signedBody} = do - currentTs <- getCurrentTime - DB.execute - db - [sql| - UPDATE groups - SET roster_version = ?, roster_sending_owner_gm_id = ?, roster_broker_ts = ?, - roster_msg_chat_binding = ?, roster_msg_signatures = ?, roster_msg_body = ?, updated_at = ? - WHERE group_id = ? - |] - ((v, ownerGMId, brokerTs, chatBinding) :. (Binary (smpEncode signatures), Binary signedBody, currentTs, groupId)) +-- Persisted roster version (the gate baseline; the in-memory gInfo copy is batch-constant and stale on reorder). +getGroupRosterVersion :: DB.Connection -> GroupInfo -> IO (Maybe VersionRoster) +getGroupRosterVersion db GroupInfo {groupId} = + fmap join . maybeFirstRow fromOnly $ + DB.query db "SELECT roster_version FROM groups WHERE group_id = ?" (Only groupId) -getGroupRoster :: DB.Connection -> GroupInfo -> IO (Maybe (GroupMemberId, UTCTime, SignedMsg)) +-- The live roster header a relay re-serves to joiners, with the completed blob served alongside it +-- (both are written together at completion, so the blob is present whenever the header is). +getGroupRoster :: DB.Connection -> GroupInfo -> IO (Maybe (GroupMemberId, UTCTime, SignedMsg, Maybe ByteString)) getGroupRoster db GroupInfo {groupId} = (>>= toRoster) <$> maybeFirstRow id ( DB.query db - "SELECT roster_sending_owner_gm_id, roster_broker_ts, roster_msg_chat_binding, roster_msg_signatures, roster_msg_body FROM groups WHERE group_id = ?" + "SELECT roster_sending_owner_gm_id, roster_broker_ts, roster_msg_chat_binding, roster_msg_signatures, roster_msg_body, roster_blob FROM groups WHERE group_id = ?" (Only groupId) ) where - toRoster (Just ownerGMId, Just brokerTs, Just cb, Just (Binary sigsBs), Just (Binary body)) = - (\sigs -> (ownerGMId, brokerTs, SignedMsg cb sigs body)) <$> eitherToMaybe (smpDecode sigsBs) + toRoster (Just ownerGMId, Just brokerTs, Just cb, Just (Binary sigsBs), Just (Binary body), blob_) = + (\sigs -> (ownerGMId, brokerTs, SignedMsg cb sigs body, (\(Binary b) -> b) <$> blob_)) <$> eitherToMaybe (smpDecode sigsBs) toRoster _ = Nothing +-- The signed-header columns are relay-only (Nothing on a member); promoted to the live header at +-- completion so the relay can re-forward the roster. +setRosterPending :: DB.Connection -> GroupInfo -> VersionRoster -> FD.FileDigest -> GroupMemberId -> UTCTime -> Maybe SignedMsg -> IO () +setRosterPending db GroupInfo {groupId} v digest ownerGMId brokerTs sm_ = do + currentTs <- getCurrentTime + DB.execute + db + [sql| + UPDATE groups + SET roster_pending_version = ?, roster_pending_digest = ?, + roster_pending_sending_owner_gm_id = ?, roster_pending_broker_ts = ?, + roster_pending_msg_chat_binding = ?, roster_pending_msg_signatures = ?, roster_pending_msg_body = ?, + updated_at = ? + WHERE group_id = ? + |] + ((v, Binary (FD.unFileDigest digest), ownerGMId, brokerTs) + :. ((\SignedMsg {chatBinding} -> chatBinding) <$> sm_, (\SignedMsg {signatures} -> Binary (smpEncode signatures)) <$> sm_, (\SignedMsg {signedBody} -> Binary signedBody) <$> sm_, currentTs, groupId)) + +getRosterPending :: DB.Connection -> GroupInfo -> IO (Maybe (VersionRoster, FD.FileDigest, GroupMemberId, UTCTime, Maybe SignedMsg)) +getRosterPending db GroupInfo {groupId} = + (>>= toPending) + <$> maybeFirstRow + id + ( DB.query + db + [sql| + SELECT roster_pending_version, roster_pending_digest, + roster_pending_sending_owner_gm_id, roster_pending_broker_ts, + roster_pending_msg_chat_binding, roster_pending_msg_signatures, roster_pending_msg_body + FROM groups WHERE group_id = ? + |] + (Only groupId) + ) + where + toPending (Just v, Just (Binary d), Just ownerGMId, Just brokerTs, cb_, sigs_, body_) = + Just (v, FD.FileDigest d, ownerGMId, brokerTs, sm_) + where + sm_ = case (cb_, sigs_, body_) of + (Just cb, Just (Binary sigsBs), Just (Binary body)) -> + (\sigs -> SignedMsg cb sigs body) <$> eitherToMaybe (smpDecode sigsBs) + _ -> Nothing + toPending _ = Nothing + +-- Promote pending -> live (header + blob + version) and clear pending, in one statement. +promoteRosterPending :: DB.Connection -> GroupInfo -> ByteString -> IO () +promoteRosterPending db GroupInfo {groupId} blob = do + currentTs <- getCurrentTime + DB.execute + db + [sql| + UPDATE groups SET + roster_version = roster_pending_version, + roster_blob = ?, + roster_sending_owner_gm_id = roster_pending_sending_owner_gm_id, + roster_broker_ts = roster_pending_broker_ts, + roster_msg_chat_binding = roster_pending_msg_chat_binding, + roster_msg_signatures = roster_pending_msg_signatures, + roster_msg_body = roster_pending_msg_body, + roster_pending_version = NULL, + roster_pending_digest = NULL, + roster_pending_sending_owner_gm_id = NULL, + roster_pending_broker_ts = NULL, + roster_pending_msg_chat_binding = NULL, + roster_pending_msg_signatures = NULL, + roster_pending_msg_body = NULL, + updated_at = ? + WHERE group_id = ? + |] + (Binary blob, currentTs, groupId) + +clearRosterPending :: DB.Connection -> GroupInfo -> IO () +clearRosterPending db GroupInfo {groupId} = do + currentTs <- getCurrentTime + DB.execute + db + [sql| + UPDATE groups SET + roster_pending_version = NULL, roster_pending_digest = NULL, + roster_pending_sending_owner_gm_id = NULL, roster_pending_broker_ts = NULL, + roster_pending_msg_chat_binding = NULL, roster_pending_msg_signatures = NULL, roster_pending_msg_body = NULL, + updated_at = ? + WHERE group_id = ? + |] + (currentTs, groupId) + setGroupMemberKeyRole :: DB.Connection -> GroupMember -> C.PublicKeyEd25519 -> GroupMemberRole -> IO () setGroupMemberKeyRole db GroupMember {groupMemberId} pubKey role = do currentTs <- getCurrentTime @@ -3174,11 +3278,11 @@ createLinkOwnerMember db cxt user@User {userId, userContactId} GroupInfo {groupI where VersionRange minV maxV = vr cxt --- 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. +-- Intro refreshes only profile / status / peer version. Role and key stay owner-authoritative +-- (the owner-signed roster for members/moderators/admins, link data for owners), so taking either from +-- an in-band relayed intro would let a compromised relay substitute them. updatePreparedChannelMember :: DB.Connection -> StoreCxt -> User -> GroupMember -> MemberInfo -> ExceptT StoreError IO GroupMember -updatePreparedChannelMember db cxt user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {memberRole, v, profile} = do +updatePreparedChannelMember db cxt user@User {userId} member@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} = do _ <- updateMemberProfile db user member profile currentTs <- liftIO getCurrentTime liftIO $ @@ -3186,14 +3290,13 @@ updatePreparedChannelMember db cxt user@User {userId} member@GroupMember {groupM db [sql| UPDATE group_members - SET member_role = ?, - member_status = ?, + SET member_status = ?, peer_chat_min_version = ?, peer_chat_max_version = ?, updated_at = ? WHERE user_id = ? AND group_member_id = ? |] - (memberRole, GSMemIntroduced, minV, maxV, currentTs, userId, groupMemberId) + (GSMemIntroduced, minV, maxV, currentTs, userId, groupMemberId) getGroupMemberById db cxt user groupMemberId where VersionRange minV maxV = maybe memberChatVRange fromChatVRange v 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/src/Simplex/Chat/Store/Postgres/Migrations/M20260601_group_roster.hs b/src/Simplex/Chat/Store/Postgres/Migrations/M20260601_group_roster.hs index 21858f73e8..d569014c9b 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations/M20260601_group_roster.hs +++ b/src/Simplex/Chat/Store/Postgres/Migrations/M20260601_group_roster.hs @@ -15,11 +15,33 @@ ALTER TABLE groups ADD COLUMN roster_msg_chat_binding TEXT; ALTER TABLE groups ADD COLUMN roster_msg_signatures BYTEA; ALTER TABLE groups ADD COLUMN roster_sending_owner_gm_id BIGINT; ALTER TABLE groups ADD COLUMN roster_broker_ts TIMESTAMPTZ; +ALTER TABLE groups ADD COLUMN roster_blob BYTEA; +ALTER TABLE groups ADD COLUMN roster_pending_version INTEGER; +ALTER TABLE groups ADD COLUMN roster_pending_digest BYTEA; +ALTER TABLE groups ADD COLUMN roster_pending_msg_body BYTEA; +ALTER TABLE groups ADD COLUMN roster_pending_msg_chat_binding TEXT; +ALTER TABLE groups ADD COLUMN roster_pending_msg_signatures BYTEA; +ALTER TABLE groups ADD COLUMN roster_pending_sending_owner_gm_id BIGINT; +ALTER TABLE groups ADD COLUMN roster_pending_broker_ts TIMESTAMPTZ; +ALTER TABLE files ADD COLUMN shared_msg_id BYTEA; +ALTER TABLE files ADD COLUMN file_type TEXT NOT NULL DEFAULT 'normal'; +CREATE INDEX idx_files_group_id_shared_msg_id ON files(group_id, shared_msg_id); |] down_m20260601_group_roster :: Text down_m20260601_group_roster = [r| +DROP INDEX IF EXISTS idx_files_group_id_shared_msg_id; +ALTER TABLE files DROP COLUMN file_type; +ALTER TABLE files DROP COLUMN shared_msg_id; +ALTER TABLE groups DROP COLUMN roster_pending_broker_ts; +ALTER TABLE groups DROP COLUMN roster_pending_sending_owner_gm_id; +ALTER TABLE groups DROP COLUMN roster_pending_msg_signatures; +ALTER TABLE groups DROP COLUMN roster_pending_msg_chat_binding; +ALTER TABLE groups DROP COLUMN roster_pending_msg_body; +ALTER TABLE groups DROP COLUMN roster_pending_digest; +ALTER TABLE groups DROP COLUMN roster_pending_version; +ALTER TABLE groups DROP COLUMN roster_blob; ALTER TABLE groups DROP COLUMN roster_broker_ts; ALTER TABLE groups DROP COLUMN roster_sending_owner_gm_id; ALTER TABLE groups DROP COLUMN roster_msg_signatures; diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql index 6012625cca..0126d37228 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql @@ -743,7 +743,9 @@ CREATE TABLE test_chat_schema.files ( file_crypto_key bytea, file_crypto_nonce bytea, note_folder_id bigint, - redirect_file_id bigint + redirect_file_id bigint, + shared_msg_id bytea, + file_type text DEFAULT 'normal'::text NOT NULL ); @@ -968,14 +970,22 @@ CREATE TABLE test_chat_schema.groups ( public_member_count bigint, relay_request_retries bigint DEFAULT 0 NOT NULL, relay_request_delay bigint DEFAULT 0 NOT NULL, - relay_request_execute_at timestamp with time zone DEFAULT '1970-01-01 01:00:00+01'::timestamp with time zone NOT NULL, + relay_request_execute_at timestamp with time zone DEFAULT '1970-01-01 04:00:00+04'::timestamp with time zone NOT NULL, relay_inactive_at timestamp with time zone, roster_version integer, roster_msg_body bytea, roster_msg_chat_binding text, roster_msg_signatures bytea, roster_sending_owner_gm_id bigint, - roster_broker_ts timestamp with time zone + roster_broker_ts timestamp with time zone, + roster_blob bytea, + roster_pending_version integer, + roster_pending_digest bytea, + roster_pending_msg_body bytea, + roster_pending_msg_chat_binding text, + roster_pending_msg_signatures bytea, + roster_pending_sending_owner_gm_id bigint, + roster_pending_broker_ts timestamp with time zone ); @@ -2268,6 +2278,10 @@ CREATE INDEX idx_files_group_id ON test_chat_schema.files USING btree (group_id) +CREATE INDEX idx_files_group_id_shared_msg_id ON test_chat_schema.files USING btree (group_id, shared_msg_id); + + + CREATE INDEX idx_files_redirect_file_id ON test_chat_schema.files USING btree (redirect_file_id); diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20260601_group_roster.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20260601_group_roster.hs index f23e41ce54..f5179e3a07 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/M20260601_group_roster.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20260601_group_roster.hs @@ -14,11 +14,33 @@ ALTER TABLE groups ADD COLUMN roster_msg_chat_binding TEXT; ALTER TABLE groups ADD COLUMN roster_msg_signatures BLOB; ALTER TABLE groups ADD COLUMN roster_sending_owner_gm_id INTEGER; ALTER TABLE groups ADD COLUMN roster_broker_ts TEXT; +ALTER TABLE groups ADD COLUMN roster_blob BLOB; +ALTER TABLE groups ADD COLUMN roster_pending_version INTEGER; +ALTER TABLE groups ADD COLUMN roster_pending_digest BLOB; +ALTER TABLE groups ADD COLUMN roster_pending_msg_body BLOB; +ALTER TABLE groups ADD COLUMN roster_pending_msg_chat_binding TEXT; +ALTER TABLE groups ADD COLUMN roster_pending_msg_signatures BLOB; +ALTER TABLE groups ADD COLUMN roster_pending_sending_owner_gm_id INTEGER; +ALTER TABLE groups ADD COLUMN roster_pending_broker_ts TEXT; +ALTER TABLE files ADD COLUMN shared_msg_id BLOB; +ALTER TABLE files ADD COLUMN file_type TEXT NOT NULL DEFAULT 'normal'; +CREATE INDEX idx_files_group_id_shared_msg_id ON files(group_id, shared_msg_id); |] down_m20260601_group_roster :: Query down_m20260601_group_roster = [sql| +DROP INDEX IF EXISTS idx_files_group_id_shared_msg_id; +ALTER TABLE files DROP COLUMN file_type; +ALTER TABLE files DROP COLUMN shared_msg_id; +ALTER TABLE groups DROP COLUMN roster_pending_broker_ts; +ALTER TABLE groups DROP COLUMN roster_pending_sending_owner_gm_id; +ALTER TABLE groups DROP COLUMN roster_pending_msg_signatures; +ALTER TABLE groups DROP COLUMN roster_pending_msg_chat_binding; +ALTER TABLE groups DROP COLUMN roster_pending_msg_body; +ALTER TABLE groups DROP COLUMN roster_pending_digest; +ALTER TABLE groups DROP COLUMN roster_pending_version; +ALTER TABLE groups DROP COLUMN roster_blob; ALTER TABLE groups DROP COLUMN roster_broker_ts; ALTER TABLE groups DROP COLUMN roster_sending_owner_gm_id; ALTER TABLE groups DROP COLUMN roster_msg_signatures; 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 ee857211aa..a986773cb2 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/agent_query_plans.txt +++ b/src/Simplex/Chat/Store/SQLite/Migrations/agent_query_plans.txt @@ -548,15 +548,6 @@ Plan: SEARCH s USING PRIMARY KEY (conn_id=? AND internal_snd_id=?) SEARCH m USING PRIMARY KEY (conn_id=? AND internal_id=?) -Query: - UPDATE rcv_messages - SET receive_attempts = receive_attempts + 1 - WHERE conn_id = ? AND internal_id = ? - RETURNING receive_attempts - -Plan: -SEARCH rcv_messages USING COVERING INDEX idx_rcv_messages_conn_id_internal_id (conn_id=? AND internal_id=?) - Query: DELETE FROM conn_confirmations WHERE conn_id = ? diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt index 6a6d147b5c..38b280bc5e 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt @@ -1051,6 +1051,15 @@ Query: Plan: SEARCH display_names USING COVERING INDEX sqlite_autoindex_display_names_2 (user_id=? AND ldn_base=?) +Query: + SELECT roster_pending_version, roster_pending_digest, + roster_pending_sending_owner_gm_id, roster_pending_broker_ts, + roster_pending_msg_chat_binding, roster_pending_msg_signatures, roster_pending_msg_body + FROM groups WHERE group_id = ? + +Plan: +SEARCH groups USING INTEGER PRIMARY KEY (rowid=?) + Query: SELECT s.contact_id, g.group_id, s.group_member_id FROM sent_probes s @@ -1238,8 +1247,8 @@ Query: INSERT INTO groups (use_relays, creating_in_progress, local_display_name, user_id, group_profile_id, enable_ntfs, created_at, updated_at, chat_ts, user_member_profile_sent_at, - root_priv_key, root_pub_key, member_priv_key, public_member_count) - VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?) + root_priv_key, root_pub_key, member_priv_key, public_member_count, roster_version) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) Plan: @@ -1625,7 +1634,7 @@ Query: SELECT r.file_status, r.file_queue_info, r.group_member_id, f.file_name, f.file_size, f.chunk_size, f.cancelled, cs.local_display_name, m.local_display_name, f.file_path, f.file_crypto_key, f.file_crypto_nonce, r.file_inline, r.rcv_file_inline, - r.agent_rcv_file_id, r.agent_rcv_file_deleted, r.user_approved_relays, g.local_display_name + r.agent_rcv_file_id, r.agent_rcv_file_deleted, r.user_approved_relays, g.local_display_name, f.file_type FROM rcv_files r JOIN files f USING (file_id) LEFT JOIN contacts cs ON cs.contact_id = f.contact_id @@ -3659,6 +3668,15 @@ Plan: SEARCH i USING COVERING INDEX idx_chat_items_group_shared_msg_id (user_id=? AND group_id=?) SEARCH f USING COVERING INDEX idx_files_chat_item_id (chat_item_id=?) +Query: + SELECT f.file_id FROM files f + JOIN rcv_files r ON r.file_id = f.file_id + WHERE f.user_id = ? AND f.group_id = ? AND f.shared_msg_id = ? + +Plan: +SEARCH f USING INDEX idx_files_group_id_shared_msg_id (group_id=? AND shared_msg_id=?) +SEARCH r USING INTEGER PRIMARY KEY (rowid=?) + Query: SELECT file_id, contact_id, group_id, note_folder_id FROM files @@ -5140,14 +5158,6 @@ Query: Plan: SEARCH group_relays USING INDEX idx_group_relays_group_member_id (group_member_id=?) -Query: - UPDATE group_relays - SET relay_status = ?, updated_at = ? - WHERE group_member_id = ? - -Plan: -SEARCH group_relays USING INDEX idx_group_relays_group_member_id (group_member_id=?) - Query: UPDATE group_snd_item_statuses SET group_snd_item_status = ?, updated_at = ? @@ -5192,8 +5202,43 @@ SEARCH groups USING INTEGER PRIMARY KEY (rowid=?) Query: UPDATE groups - SET roster_version = ?, roster_sending_owner_gm_id = ?, roster_broker_ts = ?, - roster_msg_chat_binding = ?, roster_msg_signatures = ?, roster_msg_body = ?, updated_at = ? + SET roster_pending_version = ?, roster_pending_digest = ?, + roster_pending_sending_owner_gm_id = ?, roster_pending_broker_ts = ?, + roster_pending_msg_chat_binding = ?, roster_pending_msg_signatures = ?, roster_pending_msg_body = ?, + updated_at = ? + WHERE group_id = ? + +Plan: +SEARCH groups USING INTEGER PRIMARY KEY (rowid=?) + +Query: + UPDATE groups SET + roster_pending_version = NULL, roster_pending_digest = NULL, + roster_pending_sending_owner_gm_id = NULL, roster_pending_broker_ts = NULL, + roster_pending_msg_chat_binding = NULL, roster_pending_msg_signatures = NULL, roster_pending_msg_body = NULL, + updated_at = ? + WHERE group_id = ? + +Plan: +SEARCH groups USING INTEGER PRIMARY KEY (rowid=?) + +Query: + UPDATE groups SET + roster_version = roster_pending_version, + roster_blob = ?, + roster_sending_owner_gm_id = roster_pending_sending_owner_gm_id, + roster_broker_ts = roster_pending_broker_ts, + roster_msg_chat_binding = roster_pending_msg_chat_binding, + roster_msg_signatures = roster_pending_msg_signatures, + roster_msg_body = roster_pending_msg_body, + roster_pending_version = NULL, + roster_pending_digest = NULL, + roster_pending_sending_owner_gm_id = NULL, + roster_pending_broker_ts = NULL, + roster_pending_msg_chat_binding = NULL, + roster_pending_msg_signatures = NULL, + roster_pending_msg_body = NULL, + updated_at = ? WHERE group_id = ? Plan: @@ -5216,6 +5261,14 @@ Query: Plan: SEARCH protocol_servers USING INTEGER PRIMARY KEY (rowid=?) +Query: + UPDATE rcv_file_chunks + SET chunk_stored = 1, updated_at = ? + WHERE file_id = ? AND chunk_number = ? + +Plan: +SEARCH rcv_file_chunks USING PRIMARY KEY (file_id=? AND chunk_number=?) + Query: UPDATE rcv_files SET to_receive = 1, user_approved_relays = ?, updated_at = ? @@ -6429,6 +6482,14 @@ SEARCH rcv_files USING INTEGER PRIMARY KEY (rowid=?) SEARCH snd_files USING COVERING INDEX idx_snd_files_file_id (file_id=?) SEARCH files USING COVERING INDEX idx_files_redirect_file_id (redirect_file_id=?) +Query: DELETE FROM files WHERE user_id = ? AND group_id = ? AND file_type = ? +Plan: +SEARCH files USING INDEX idx_files_group_id (group_id=?) +SEARCH extra_xftp_file_descriptions USING COVERING INDEX idx_extra_xftp_file_descriptions_file_id (file_id=?) +SEARCH rcv_files USING INTEGER PRIMARY KEY (rowid=?) +SEARCH snd_files USING COVERING INDEX idx_snd_files_file_id (file_id=?) +SEARCH files USING COVERING INDEX idx_files_redirect_file_id (redirect_file_id=?) + Query: DELETE FROM group_members WHERE user_id = ? AND group_id = ? Plan: SEARCH group_members USING COVERING INDEX idx_group_members_group_id (user_id=? AND group_id=?) @@ -6681,7 +6742,7 @@ Plan: Query: INSERT INTO files (user_id, file_name, file_path, file_size, chunk_size, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?) Plan: -Query: INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?) +Query: INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, protocol, file_type, shared_msg_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?) Plan: Query: INSERT INTO group_profiles (display_name, full_name, short_descr, description, image, user_id, preferences, member_admission, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?) @@ -6736,6 +6797,9 @@ Plan: Query: INSERT INTO xftp_file_descriptions (user_id, file_descr_text, file_descr_part_no, file_descr_complete, created_at, updated_at) VALUES (?,?,?,?,?,?) Plan: +Query: INSERT OR REPLACE INTO rcv_file_chunks (file_id, chunk_number, chunk_agent_msg_id, created_at, updated_at) VALUES (?,?,?,?,?) +Plan: + Query: SELECT 1 FROM settings WHERE user_id = ? LIMIT 1 Plan: SEARCH settings USING COVERING INDEX idx_settings_user_id (user_id=?) @@ -6871,6 +6935,10 @@ Query: SELECT chat_tag_id FROM chat_tags_chats WHERE group_id = ? Plan: SEARCH chat_tags_chats USING COVERING INDEX idx_chat_tags_chats_chat_tag_id_group_id (group_id=?) +Query: SELECT chunk_number FROM rcv_file_chunks WHERE file_id = ? ORDER BY chunk_number DESC LIMIT 1 +Plan: +SEARCH rcv_file_chunks USING COVERING INDEX idx_rcv_file_chunks_file_id (file_id=?) + Query: SELECT conn_req_inv FROM connections WHERE connection_id = ? Plan: SEARCH connections USING INTEGER PRIMARY KEY (rowid=?) @@ -6935,6 +7003,10 @@ Query: SELECT file_id FROM files WHERE user_id = ? AND redirect_file_id = ? Plan: SEARCH files USING INDEX idx_files_redirect_file_id (redirect_file_id=?) +Query: SELECT file_id, file_path FROM files WHERE user_id = ? AND group_id = ? AND file_type = ? +Plan: +SEARCH files USING INDEX idx_files_group_id (group_id=?) + Query: SELECT g.inv_queue_info FROM groups g WHERE g.group_id = ? AND g.user_id = ? Plan: SEARCH g USING INTEGER PRIMARY KEY (rowid=?) @@ -7003,6 +7075,14 @@ Query: SELECT max(active_order) FROM users Plan: SEARCH users +Query: SELECT member_id FROM group_members WHERE local_display_name = ? +Plan: +SCAN group_members + +Query: SELECT member_pub_key FROM group_members WHERE local_display_name = ? +Plan: +SCAN group_members + Query: SELECT member_relations_vector FROM group_members WHERE group_member_id = ? Plan: SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) @@ -7055,10 +7135,18 @@ Query: SELECT relay_status FROM group_relays WHERE group_relay_id = ? Plan: SEARCH group_relays USING INTEGER PRIMARY KEY (rowid=?) -Query: SELECT roster_sending_owner_gm_id, roster_broker_ts, roster_msg_chat_binding, roster_msg_signatures, roster_msg_body FROM groups WHERE group_id = ? +Query: SELECT roster_blob FROM groups WHERE roster_blob IS NOT NULL +Plan: +SCAN groups + +Query: SELECT roster_sending_owner_gm_id, roster_broker_ts, roster_msg_chat_binding, roster_msg_signatures, roster_msg_body, roster_blob FROM groups WHERE group_id = ? Plan: SEARCH groups USING INTEGER PRIMARY KEY (rowid=?) +Query: SELECT roster_version FROM groups +Plan: +SCAN groups + Query: SELECT sent_inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ? Plan: SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) @@ -7303,6 +7391,10 @@ Query: UPDATE group_members SET member_role = ? WHERE user_id = ? AND group_memb Plan: SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) +Query: UPDATE group_members SET member_role = ?, member_pub_key = NULL WHERE local_display_name = ? +Plan: +SCAN group_members + Query: UPDATE group_members SET support_chat_items_member_attention = ?, updated_at = ? WHERE group_member_id = ? Plan: SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?) @@ -7383,6 +7475,10 @@ Query: UPDATE groups SET root_pub_key = ?, member_priv_key = ?, updated_at = ? W Plan: SEARCH groups USING INTEGER PRIMARY KEY (rowid=?) +Query: UPDATE groups SET roster_blob = ? WHERE roster_blob IS NOT NULL +Plan: +SCAN groups + Query: UPDATE groups SET roster_version = ?, updated_at = ? WHERE group_id = ? Plan: SEARCH groups USING INTEGER PRIMARY KEY (rowid=?) diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql index ed31f10880..81df9730c0 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql @@ -188,7 +188,15 @@ CREATE TABLE groups( roster_msg_chat_binding TEXT, roster_msg_signatures BLOB, roster_sending_owner_gm_id INTEGER, - roster_broker_ts TEXT, -- received + roster_broker_ts TEXT, + roster_blob BLOB, + roster_pending_version INTEGER, + roster_pending_digest BLOB, + roster_pending_msg_body BLOB, + roster_pending_msg_chat_binding TEXT, + roster_pending_msg_signatures BLOB, + roster_pending_sending_owner_gm_id INTEGER, + roster_pending_broker_ts TEXT, -- received FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE @@ -274,7 +282,9 @@ CREATE TABLE files( file_crypto_key BLOB, file_crypto_nonce BLOB, note_folder_id INTEGER DEFAULT NULL REFERENCES note_folders ON DELETE CASCADE, - redirect_file_id INTEGER REFERENCES files ON DELETE CASCADE + redirect_file_id INTEGER REFERENCES files ON DELETE CASCADE, + shared_msg_id BLOB, + file_type TEXT NOT NULL DEFAULT 'normal' ) STRICT; CREATE TABLE snd_files( file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE, @@ -1313,6 +1323,10 @@ ON groups( relay_request_group_link ) WHERE relay_request_group_link IS NOT NULL; +CREATE INDEX idx_files_group_id_shared_msg_id ON files( + group_id, + shared_msg_id +); CREATE TRIGGER on_group_members_insert_update_summary AFTER INSERT ON group_members FOR EACH ROW diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index c6c53f69e9..abace312a2 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -973,6 +973,11 @@ newtype MemberKey = MemberKey C.PublicKeyEd25519 deriving (Eq, Show) deriving newtype (StrEncoding) +-- Binary encoding for the roster blob; delegates to the Ed25519 key. +instance Encoding MemberKey where + smpEncode (MemberKey k) = smpEncode k + smpP = MemberKey <$> smpP + instance FromJSON MemberKey where parseJSON = strParseJSON "MemberKey" @@ -1494,11 +1499,38 @@ instance ToJSON InlineFileMode where toJSON = J.String . textEncode toEncoding = JE.text . textEncode +-- Discriminates ordinary chat files from the roster blob file, so the receive +-- completion / cancel paths branch on the type rather than on chat_item_id (note +-- folders and redirects also lack a chat item). +data FileType = FTNormal | FTRoster + deriving (Eq, Show) + +instance TextEncoding FileType where + textEncode = \case + FTNormal -> "normal" + FTRoster -> "roster" + textDecode = \case + "normal" -> Just FTNormal + "roster" -> Just FTRoster + _ -> Nothing + +instance FromField FileType where fromField = fromTextField_ textDecode + +instance ToField FileType where toField = toField . textEncode + +instance FromJSON FileType where + parseJSON = textParseJSON "FileType" + +instance ToJSON FileType where + toJSON = J.String . textEncode + toEncoding = JE.text . textEncode + data RcvFileTransfer = RcvFileTransfer { fileId :: FileTransferId, xftpRcvFile :: Maybe XFTPRcvFile, fileInvitation :: FileInvitation, fileStatus :: RcvFileStatus, + fileType :: FileType, rcvFileInline :: Maybe InlineFileMode, senderDisplayName :: ContactName, chunkSize :: Integer, diff --git a/src/Simplex/Chat/Types/Shared.hs b/src/Simplex/Chat/Types/Shared.hs index c71f7ce37a..1f3d9dd5a8 100644 --- a/src/Simplex/Chat/Types/Shared.hs +++ b/src/Simplex/Chat/Types/Shared.hs @@ -11,6 +11,7 @@ import qualified Data.ByteString.Char8 as B import Data.Text (Text) import Simplex.Chat.Options.DB (FromField (..), ToField (..)) import Simplex.Messaging.Agent.Store.DB (fromTextField_) +import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix, enumJSON) import Simplex.Messaging.Util ((<$?>)) @@ -57,6 +58,12 @@ instance ToJSON GroupMemberRole where toJSON = textToJSON toEncoding = textToEncoding +-- Binary encoding for the roster blob; delegates to the canonical TextEncoding +-- (same member/moderator/admin form JSON and the DB use). GRUnknown round-trips. +instance Encoding GroupMemberRole where + smpEncode = smpEncode . textEncode + smpP = maybe (fail "bad GroupMemberRole") pure . textDecode =<< smpP + data GroupAcceptance = GAAccepted | GAPendingApproval | GAPendingReview deriving (Eq, Show) instance StrEncoding GroupAcceptance where diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index ede3c1f2a2..cbd5247a49 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -212,7 +212,7 @@ testCfg = shortLinkPresetServers = ["smp://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:7001"], testView = True, tbqSize = 16, - channelSubscriberRole = GRMember, -- starting role is GRMember to test members sending messages + channelSubscriberRole = GRObserver, confirmMigrations = MCYesUp } diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index 131c09cae9..5f55c38990 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -289,10 +289,14 @@ chatGroupTests = do describe "promoted members roster" $ do it "moderator action verifies via owner-signed roster" testChannelModeratorActionViaRoster it "removed moderator drops from the roster cache" testChannelRemovedModeratorRefreshesRoster - it "leaving moderator drops from the roster cache" testChannelLeftModeratorDropsFromRoster it "role transitions update the roster (mod <-> admin, admin -> non-roster)" testChannelRoleTransitionsUpdateRoster it "malicious relay cannot downgrade or re-key a roster-established moderator via XGrpMemNew" testChannelRelayCannotDowngradeRosterMember it "should add relay to channel with roster (relay caches roster before joinable)" testChannelAddRelayWithRoster + it "roster blob spanning multiple chunks reassembles" testChannelRosterMultipartReassembly + it "corrupted roster blob is rejected on digest mismatch" testChannelRosterDigestMismatchRejected + it "promoted member enters the roster and can post" testChannelPromotedMemberCanPost + it "observer cannot post until promoted" testChannelObserverCannotPost + it "promoted member re-connecting via a new relay is accepted via the roster-pinned key" testChannelPromotedMemberRejoinViaRelay describe "channel message operations" $ do it "should update channel message" testChannelMessageUpdate it "should delete channel message" testChannelMessageDelete @@ -8631,6 +8635,20 @@ createChannel1Relay gName owner relay cath dan eve = do forM_ [cath, dan, eve] $ \member -> memberJoinChannel gName [relay] [owner] shortLink fullLink member +-- Promote a fresh channel subscriber (observer default) to member so it can post; the roster bump +-- re-serves to the other (still-unknown) subscribers, who see the change rendered by member id hash. +promoteChannelMember :: HasCallStack => String -> TestCC -> TestCC -> TestCC -> [TestCC] -> IO () +promoteChannelMember gName owner relay member others = do + mName <- userName member + oName <- userName owner + owner ##> ("/mr #" <> gName <> " " <> mName <> " member") + owner <## ("#" <> gName <> ": you changed the role of " <> mName <> " to member (signed)") + concurrentlyN_ $ + [ relay <## ("#" <> gName <> ": " <> oName <> " changed the role of " <> mName <> " from observer to member (signed)"), + member <## ("#" <> gName <> ": " <> oName <> " changed your role from observer to member (signed)") + ] + <> [o <### [EndsWith "from observer to member (signed)"] | o <- others] + setupRelay :: TestCC -> TestCC -> IO String setupRelay owner relay = do rName <- userName relay @@ -8665,7 +8683,7 @@ prepareChannel' relayId gName owner relay = do ] owner ##> ("/show link #" <> gName) - getGroupLinks owner gName GRMember False + getGroupLinks owner gName GRObserver False createChannel2Relays :: String -> TestCC -> TestCC -> TestCC -> TestCC -> TestCC -> TestCC -> IO () createChannel2Relays gName owner relay1 relay2 dan eve frank = do @@ -8713,7 +8731,7 @@ prepareChannel2Relays gName owner relay1 relay2 = do ] owner ##> ("/show link #" <> gName) - getGroupLinks owner gName GRMember False + getGroupLinks owner gName GRObserver False memberJoinChannel :: String -> [TestCC] -> [TestCC] -> String -> String -> TestCC -> IO () memberJoinChannel gName = memberJoinChannel' gName 1 0 0 0 @@ -8842,6 +8860,9 @@ testChannelsSenderDeduplicateOwn ps = do withNewTestChat ps "eve" eveProfile $ \eve -> do withNewTestChatCfgOpts ps cfg relayTestOpts "bob" bobProfile $ \bob -> do createChannel1Relay "team" alice bob cath dan eve + -- promote cath and dan while the relay is online, so their buffered posts replay as members + promoteChannelMember "team" alice bob cath [dan, eve] + promoteChannelMember "team" alice bob dan [cath, eve] -- chat relay bob is offline alice #> "#team 1" @@ -8867,14 +8888,16 @@ testChannelsSenderDeduplicateOwn ps = do WithTime "#team dan> 6 [>>]" ] cath - <### [ "#team: bob introduced dan (Daniel) in the channel", + <### [ EndsWith "updated to dan", + "#team: bob introduced dan (Daniel) in the channel", WithTime "#team> 1 [>>]", WithTime "#team> 2 [>>]", WithTime "#team> 3 [>>]", WithTime "#team dan> 6 [>>]" ] dan - <### [ "#team: bob introduced cath (Catherine) in the channel", + <### [ EndsWith "updated to cath", + "#team: bob introduced cath (Catherine) in the channel", WithTime "#team> 1 [>>]", WithTime "#team> 2 [>>]", WithTime "#team> 3 [>>]", @@ -8882,7 +8905,9 @@ testChannelsSenderDeduplicateOwn ps = do WithTime "#team cath> 5 [>>]" ] eve - <### [ "#team: bob introduced cath (Catherine) in the channel", + <### [ EndsWith "updated to cath", + EndsWith "updated to dan", + "#team: bob introduced cath (Catherine) in the channel", "#team: bob introduced dan (Daniel) in the channel", WithTime "#team> 1 [>>]", WithTime "#team> 2 [>>]", @@ -8903,11 +8928,13 @@ testChannelLateJoinerReceivesProfile ps = (shortLink, fullLink) <- prepareChannel1Relay "team" alice bob memberJoinChannel "team" [bob] [alice] shortLink fullLink cath memberJoinChannel "team" [bob] [alice] shortLink fullLink dan + promoteChannelMember "team" alice bob cath [dan] - -- first forward: dan learns cath via prepended XGrpMemNew. + -- first forward: dan resolves cath (roster-known by id hash) on the prepended XGrpMemNew. cath #> "#team hi" bob <# "#team cath> hi" alice <# "#team cath> hi [>>]" + dan <### [EndsWith "updated to cath"] dan <## "#team: bob introduced cath (Catherine) in the channel" dan <# "#team cath> hi [>>]" @@ -8943,12 +8970,23 @@ testChannel2RelaysDeduplicateProfile ps = memberJoinChannel "team" [bob, cath] [alice] shortLink fullLink dan memberJoinChannel "team" [bob, cath] [alice] shortLink fullLink eve + -- promote dan (observer default) so it can post; eve learns dan via the roster (id hash) + alice ##> "/mr #team dan member" + alice <## "#team: you changed the role of dan to member (signed)" + concurrentlyN_ + [ bob <## "#team: alice changed the role of dan from observer to member (signed)", + cath <## "#team: alice changed the role of dan from observer to member (signed)", + dan <## "#team: alice changed your role from observer to member (signed)", + eve <### [EndsWith "from observer to member (signed)"] + ] + -- first forward: both relays prepend XGrpMemNew(dan) for eve; -- second hits xGrpMemNew's "already created via another relay" branch. dan #> "#team hi" bob <# "#team dan> hi" cath <# "#team dan> hi" alice <# "#team dan> hi [>>]" + eve <### [EndsWith "updated to dan"] eve .<## " introduced dan (Daniel) in the channel" eve <# "#team dan> hi [>>]" @@ -8990,6 +9028,7 @@ testChannelLargeProfileFits ps = (shortLink, fullLink) <- prepareChannel1Relay "team" alice bob memberJoinChannel "team" [bob] [alice] shortLink fullLink cath memberJoinChannel "team" [bob] [alice] shortLink fullLink dan + promoteChannelMember "team" alice bob cath [dan] -- ~14000 chars: profile fits in a singleton batch AND packs -- inline with the forwarded body (exercises the in-body path). @@ -9000,6 +9039,7 @@ testChannelLargeProfileFits ps = cath #> "#team hi" bob <# "#team cath> hi" alice <# "#team cath> hi [>>]" + dan <### [EndsWith "updated to cath"] dan <## "#team: bob introduced cath (Catherine) in the channel" dan <# "#team cath> hi [>>]" @@ -9013,6 +9053,8 @@ testChannelMultipleLargeProfiles ps = withNewTestChat ps "dan" danProfile $ \dan -> do withNewTestChat ps "eve" eveProfile $ \eve -> do createChannel1Relay "team" alice bob cath dan eve + promoteChannelMember "team" alice bob cath [dan, eve] + promoteChannelMember "team" alice bob dan [cath, eve] -- ~14500 chars each: one rides inline with the body, -- the other spills into a standalone overflow batch. @@ -9034,15 +9076,19 @@ testChannelMultipleLargeProfiles ps = WithTime "#team dan> from dan [>>]" ] cath - <### [ "#team: bob introduced dan (Daniel) in the channel", + <### [ EndsWith "updated to dan", + "#team: bob introduced dan (Daniel) in the channel", WithTime "#team dan> from dan [>>]" ] dan - <### [ "#team: bob introduced cath (Catherine) in the channel", + <### [ EndsWith "updated to cath", + "#team: bob introduced cath (Catherine) in the channel", WithTime "#team cath> from cath [>>]" ] eve - <### [ "#team: bob introduced dan (Daniel) in the channel", + <### [ EndsWith "updated to cath", + EndsWith "updated to dan", + "#team: bob introduced dan (Daniel) in the channel", "#team: bob introduced cath (Catherine) in the channel", WithTime "#team cath> from cath [>>]", WithTime "#team dan> from dan [>>]" @@ -9064,10 +9110,12 @@ testChannelProfileUpdateNoRePrepend ps = (shortLink, fullLink) <- prepareChannel1Relay "team" alice bob memberJoinChannel "team" [bob] [alice] shortLink fullLink cath memberJoinChannel "team" [bob] [alice] shortLink fullLink dan + promoteChannelMember "team" alice bob cath [dan] cath #> "#team hi" bob <# "#team cath> hi" alice <# "#team cath> hi [>>]" + dan <### [EndsWith "updated to cath"] dan <## "#team: bob introduced cath (Catherine) in the channel" dan <# "#team cath> hi [>>]" @@ -9093,22 +9141,28 @@ testChannelMultiSendersIndependent ps = withNewTestChat ps "dan" danProfile $ \dan -> do withNewTestChat ps "eve" eveProfile $ \eve -> do createChannel1Relay "team" alice bob cath dan eve + promoteChannelMember "team" alice bob cath [dan, eve] + promoteChannelMember "team" alice bob dan [cath, eve] - -- cath posts: dan and eve learn cath via prepended XGrpMemNew + -- cath posts: dan and eve resolve cath on the prepended XGrpMemNew cath #> "#team from cath" bob <# "#team cath> from cath" alice <# "#team cath> from cath [>>]" + dan <### [EndsWith "updated to cath"] dan <## "#team: bob introduced cath (Catherine) in the channel" dan <# "#team cath> from cath [>>]" + eve <### [EndsWith "updated to cath"] eve <## "#team: bob introduced cath (Catherine) in the channel" eve <# "#team cath> from cath [>>]" - -- dan posts: cath and eve learn dan independently of cath's vector + -- dan posts: cath and eve resolve dan independently of cath's vector dan #> "#team from dan" bob <# "#team dan> from dan" alice <# "#team dan> from dan [>>]" + cath <### [EndsWith "updated to dan"] cath <## "#team: bob introduced dan (Daniel) in the channel" cath <# "#team dan> from dan [>>]" + eve <### [EndsWith "updated to dan"] eve <## "#team: bob introduced dan (Daniel) in the channel" eve <# "#team dan> from dan [>>]" @@ -9129,6 +9183,17 @@ testChannels2RelaysDeliver ps = withNewTestChat ps "frank" frankProfile $ \frank -> do createChannel2Relays "team" alice bob cath dan eve frank + -- promote dan (observer default) so it can send; eve/frank learn dan via the roster + alice ##> "/mr #team dan member" + alice <## "#team: you changed the role of dan to member (signed)" + concurrentlyN_ + [ bob <## "#team: alice changed the role of dan from observer to member (signed)", + cath <## "#team: alice changed the role of dan from observer to member (signed)", + dan <## "#team: alice changed your role from observer to member (signed)", + eve <### [EndsWith "from observer to member (signed)"], + frank <### [EndsWith "from observer to member (signed)"] + ] + alice #> "#team hi" [bob, cath] *<# "#team> hi" [dan, eve, frank] *<# "#team> hi [>>]" @@ -9141,18 +9206,15 @@ testChannels2RelaysDeliver ps = cath <## " + 👍" alice <# "#team dan> > hi" alice <## " + 👍" + eve .<##. ("#team: unknown member ", " updated to dan") eve .<## " introduced dan (Daniel) in the channel" eve <# "#team dan> > hi" eve <## " + 👍" + frank .<##. ("#team: unknown member ", " updated to dan") frank .<## " introduced dan (Daniel) in the channel" frank <# "#team dan> > hi" frank <## " + 👍" - -- remove below if default role is changed to observer - dan #> "#team hey" - [bob, cath] *<# "#team dan> hey" - [alice, eve, frank] *<# "#team dan> hey [>>]" - testChannels2RelaysIncognito :: HasCallStack => TestParams -> IO () testChannels2RelaysIncognito ps = withNewTestChat ps "alice" aliceProfile $ \alice -> do @@ -9166,6 +9228,17 @@ testChannels2RelaysIncognito ps = forM_ [eve, frank] $ \member -> memberJoinChannel "team" [bob, cath] [alice] shortLink fullLink member + -- promote dan (observer default) so it can send; eve/frank learn dan via the roster + alice ##> ("/mr #team " <> danIncognito <> " member") + alice <## ("#team: you changed the role of " <> danIncognito <> " to member (signed)") + concurrentlyN_ + [ bob <## ("#team: alice changed the role of " <> danIncognito <> " from observer to member (signed)"), + cath <## ("#team: alice changed the role of " <> danIncognito <> " from observer to member (signed)"), + dan <## "#team: alice changed your role from observer to member (signed)", + eve <### [EndsWith "from observer to member (signed)"], + frank <### [EndsWith "from observer to member (signed)"] + ] + alice #> "#team hi" [bob, cath] *<# "#team> hi" dan ?<# "#team> hi [>>]" @@ -9179,18 +9252,15 @@ testChannels2RelaysIncognito ps = cath <## " + 👍" alice <# ("#team " <> danIncognito <> "> > hi") alice <## " + 👍" + eve .<##. ("#team: unknown member ", (" updated to " <> danIncognito)) eve .<## (" introduced " <> danIncognito <> " in the channel") eve <# ("#team " <> danIncognito <> "> > hi") eve <## " + 👍" + frank .<##. ("#team: unknown member ", (" updated to " <> danIncognito)) frank .<## (" introduced " <> danIncognito <> " in the channel") frank <# ("#team " <> danIncognito <> "> > hi") frank <## " + 👍" - -- remove below if default role is changed to observer - dan ?#> "#team hey" - [bob, cath] *<# ("#team " <> danIncognito <> "> hey") - [alice, eve, frank] *<# ("#team " <> danIncognito <> "> hey [>>]") - testChannelUpdateProfileSigned :: HasCallStack => TestParams -> IO () testChannelUpdateProfileSigned ps = withNewTestChat ps "alice" aliceProfile $ \alice -> @@ -9248,7 +9318,7 @@ testChannelLinkAfterProfileUpdate ps = -- late subscriber joins via the same channel link after profile update threadDelay 100000 alice ##> "/show link #my_team" - (shortLink', fullLink') <- getGroupLinks alice "my_team" GRMember False + (shortLink', fullLink') <- getGroupLinks alice "my_team" GRObserver False shortLink' `shouldBe` shortLink fullLink' `shouldBe` fullLink memberJoinChannel "my_team" [bob] [alice] shortLink' fullLink' dan @@ -9285,7 +9355,7 @@ testChannelLinkAfterWelcomeUpdate ps = -- re-fetch updated link, late subscriber joins threadDelay 100000 alice ##> "/show link #team" - (shortLink', fullLink') <- getGroupLinks alice "team" GRMember False + (shortLink', fullLink') <- getGroupLinks alice "team" GRObserver False shortLink' `shouldBe` shortLink fullLink' `shouldBe` fullLink memberJoinChannel "team" [bob] [alice] shortLink' fullLink' dan @@ -9322,7 +9392,7 @@ testChannelOwnerKeyAfterLinkUpdate ps = -- Late subscriber joins via the same channel link after profile update. alice ##> "/show link #my_team" - (shortLink', fullLink') <- getGroupLinks alice "my_team" GRMember False + (shortLink', fullLink') <- getGroupLinks alice "my_team" GRObserver False shortLink' `shouldBe` shortLink fullLink' `shouldBe` fullLink memberJoinChannel "my_team" [bob] [alice] shortLink' fullLink' dan @@ -9389,15 +9459,20 @@ testChannelChangeRoleSigned ps = withNewTestChat ps "eve" eveProfile $ \eve -> do createChannel1Relay "team" alice bob cath dan eve + -- promote cath to member (observer default) so it can post + promoteChannelMember "team" alice bob cath [dan, eve] + -- other members discover cath cath #> "#team hello from cath" bob <# "#team cath> hello from cath" concurrentlyN_ [ alice <# "#team cath> hello from cath [>>]", do + dan <### [EndsWith "updated to cath"] dan <## "#team: bob introduced cath (Catherine) in the channel" dan <# "#team cath> hello from cath [>>]", do + eve <### [EndsWith "updated to cath"] eve <## "#team: bob introduced cath (Catherine) in the channel" eve <# "#team cath> hello from cath [>>]" ] @@ -9424,17 +9499,15 @@ testChannelChangeRoleSigned ps = alice ##> "/mr #team dan admin" alice <## "#team: you changed the role of dan to admin (signed)" concurrentlyN_ - [ bob <## "#team: alice changed the role of dan from member to admin (signed)", - dan <## "#team: alice changed your role from member to admin (signed)", - cath <## "#team: alice changed the role of dan from member to admin (signed)", - eve <## "#team: alice changed the role of dan from member to admin (signed)" + [ bob <## "#team: alice changed the role of dan from observer to admin (signed)", + dan <## "#team: alice changed your role from observer to admin (signed)", + cath .<##. ("#team: alice changed the role of ", " from observer to admin (signed)"), + eve .<##. ("#team: alice changed the role of ", " from observer to admin (signed)") ] + -- cath/eve render dan by id hash (unknown to them, roster-TOFU); arrival verified above 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)")]) - -- roster-emitted items don't carry the signed marker in chat content text (live event does) - cath #$> ("/_get chat #1 count=1", chat, [(0, "changed role of dan to admin")]) 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 dan to admin")]) testChannelBlockMemberSigned :: HasCallStack => TestParams -> IO () testChannelBlockMemberSigned ps = @@ -9445,6 +9518,9 @@ testChannelBlockMemberSigned ps = withNewTestChat ps "eve" eveProfile $ \eve -> do createChannel1Relay "team" alice bob cath dan eve + -- promote cath to member (observer default) so it can post + promoteChannelMember "team" alice bob cath [dan, eve] + -- other members discover cath threadDelay 1000000 cath #> "#team hello from cath" @@ -9452,9 +9528,11 @@ testChannelBlockMemberSigned ps = concurrentlyN_ [ alice <# "#team cath> hello from cath [>>]", do + dan <### [EndsWith "updated to cath"] dan <## "#team: bob introduced cath (Catherine) in the channel" dan <# "#team cath> hello from cath [>>]", do + eve <### [EndsWith "updated to cath"] eve <## "#team: bob introduced cath (Catherine) in the channel" eve <# "#team cath> hello from cath [>>]" ] @@ -9518,30 +9596,33 @@ testChannelModeratorActionViaRoster ps = forM_ [cath, dan, eve] $ \member -> memberJoinChannel "team" [bob] [alice] shortLink fullLink member - -- dan posts so cath and eve discover dan + -- promote dan (observer default) so it can post; cath and eve then discover dan threadDelay 1000000 + promoteChannelMember "team" alice bob dan [cath, eve] dan #> "#team hello from dan" bob <# "#team dan> hello from dan" concurrentlyN_ [ alice <# "#team dan> hello from dan [>>]", do + cath <### [EndsWith "updated to dan"] cath <## "#team: bob introduced dan (Daniel) in the channel" cath <# "#team dan> hello from dan [>>]", do + eve <### [EndsWith "updated to dan"] eve <## "#team: bob introduced dan (Daniel) in the channel" eve <# "#team dan> hello from dan [>>]" ] - -- dan/eve XGrpMemRole is skipped (target unknown); roster apply creates cath - -- and emits the role-change chat item + -- cath promoted observer -> moderator; dan/eve learn cath via the roster re-serve + -- (no name yet -> rendered by member id hash) threadDelay 1000000 alice ##> "/mr #team cath moderator" alice <## "#team: you changed the role of cath to moderator (signed)" concurrentlyN_ - [ bob <## "#team: alice changed the role of cath from member to moderator (signed)", - cath <## "#team: alice changed your role from member to moderator (signed)", - dan <## "#team: alice changed the role of cath from member to moderator (signed)", - eve <## "#team: alice changed the role of cath from member to moderator (signed)" + [ 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 <### [EndsWith "to moderator (signed)"], + eve <### [EndsWith "to moderator (signed)"] ] -- cath (moderator) blocks dan; profile prepend carries cath's full profile to dan/eve @@ -9550,10 +9631,10 @@ testChannelModeratorActionViaRoster ps = cath <## "#team: you blocked dan (signed)" bob <## "#team: cath blocked dan (signed)" alice <## "#team: cath blocked dan (signed)" - eve <## "#team: unknown member cath updated to cath" + eve <### [EndsWith "updated to cath"] eve <## "#team: bob introduced cath (Catherine) in the channel" eve <## "#team: cath blocked dan (signed)" - dan <## "#team: unknown member cath updated to cath" + dan <### [EndsWith "updated to cath"] dan <## "#team: bob introduced cath (Catherine) in the channel" -- frank joins after the roster update; cached roster gives him cath as moderator. @@ -9562,8 +9643,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 - frank <### [EndsWith "changed the role of cath from member to moderator (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 () @@ -9583,15 +9665,15 @@ testChannelRemovedModeratorRefreshesRoster ps = (shortLink, fullLink) <- prepareChannel1Relay "team" alice bob forM_ [cath, dan, eve] $ \member -> memberJoinChannel "team" [bob] [alice] shortLink fullLink member - -- dan/eve XGrpMemRole is skipped; roster apply creates cath and emits the chat item + -- cath promoted observer -> moderator; dan/eve learn cath via the roster (id hash) threadDelay 1000000 alice ##> "/mr #team cath moderator" alice <## "#team: you changed the role of cath to moderator (signed)" concurrentlyN_ - [ bob <## "#team: alice changed the role of cath from member to moderator (signed)", - cath <## "#team: alice changed your role from member to moderator (signed)", - dan <## "#team: alice changed the role of cath from member to moderator (signed)", - eve <## "#team: alice changed the role of cath from member to moderator (signed)" + [ 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 <### [EndsWith "to moderator (signed)"], + eve <### [EndsWith "to moderator (signed)"] ] threadDelay 1000000 alice ##> "/rm #team cath" @@ -9599,8 +9681,8 @@ testChannelRemovedModeratorRefreshesRoster ps = bob <## "#team: alice removed cath from the group (signed)" cath <## "#team: alice removed you from the group (signed)" cath <## "use /d #team to delete the group" - dan <## "#team: alice removed cath from the group (signed)" - eve <## "#team: alice removed cath from the group (signed)" + dan <### [EndsWith "from the group (signed)"] + eve <### [EndsWith "from the group (signed)"] -- frank joins after the removal; cached roster has dropped cath threadDelay 1000000 @@ -9608,44 +9690,6 @@ testChannelRemovedModeratorRefreshesRoster ps = threadDelay 100000 checkMemberRow frank "cath" Nothing -testChannelLeftModeratorDropsFromRoster :: HasCallStack => TestParams -> IO () -testChannelLeftModeratorDropsFromRoster 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 -> - withNewTestChat ps "frank" frankProfile $ \frank -> do - (shortLink, fullLink) <- prepareChannel1Relay "team" alice bob - forM_ [cath, dan, eve] $ \member -> - memberJoinChannel "team" [bob] [alice] shortLink fullLink member - -- promote cath; dan/eve XGrpMemRole skipped, roster apply emits the chat item - threadDelay 1000000 - alice ##> "/mr #team cath moderator" - alice <## "#team: you changed the role of cath to moderator (signed)" - concurrentlyN_ - [ bob <## "#team: alice changed the role of cath from member to moderator (signed)", - cath <## "#team: alice changed your role from member to moderator (signed)", - dan <## "#team: alice changed the role of cath from member to moderator (signed)", - eve <## "#team: alice changed the role of cath from member to moderator (signed)" - ] - -- cath (moderator) leaves; owner xGrpLeave refreshes the cached roster - threadDelay 1000000 - cath ##> "/leave #team" - cath <## "#team: you left the group" - cath <## "use /d #team to delete the group" - concurrentlyN_ - [ alice <## "#team: cath left the group (signed)", - bob <## "#team: cath left the group (signed)", - dan <## "#team: cath left the group (signed)", - eve <## "#team: cath left the group (signed)" - ] - -- frank joins; cached roster (refreshed) has dropped cath - threadDelay 1000000 - memberJoinChannel "team" [bob] [alice] shortLink fullLink frank - threadDelay 100000 - checkMemberRow frank "cath" Nothing - testChannelRoleTransitionsUpdateRoster :: HasCallStack => TestParams -> IO () testChannelRoleTransitionsUpdateRoster ps = withNewTestChat ps "alice" aliceProfile $ \alice -> @@ -9656,19 +9700,19 @@ testChannelRoleTransitionsUpdateRoster ps = withNewTestChat ps "frank" frankProfile $ \frank -> do (shortLink, fullLink) <- prepareChannel1Relay "team" alice bob memberJoinChannel "team" [bob] [alice] shortLink fullLink cath - -- member -> moderator + -- observer -> moderator threadDelay 100000 alice ##> "/mr #team cath moderator" alice <## "#team: you changed the role of cath to moderator (signed)" concurrentlyN_ - [ bob <## "#team: alice changed the role of cath from member to moderator (signed)", - cath <## "#team: alice changed your role from member to moderator (signed)" + [ 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 <## "#team: alice changed the role of cath from member 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 @@ -9679,21 +9723,20 @@ 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 <## "#team: alice changed the role of cath from member to admin (signed)" - threadDelay 100000 + threadDelay 1000000 -- the served roster arrives async; wait before reading the applied state checkMemberRow eve "cath" (Just "admin") - -- admin -> member (crossing out of roster): roster drops cath + -- admin -> observer (crossing out of roster, since member is now in-roster): roster drops cath threadDelay 100000 - alice ##> "/mr #team cath member" - alice <## "#team: you changed the role of cath to member (signed)" + alice ##> "/mr #team cath observer" + alice <## "#team: you changed the role of cath to observer (signed)" concurrentlyN_ - [ bob <## "#team: alice changed the role of cath from admin to member (signed)", - cath <## "#team: alice changed your role from admin to member (signed)", - dan <## "#team: alice changed the role of cath from admin to member (signed)", - eve <## "#team: alice changed the role of cath from admin to member (signed)" + [ bob <## "#team: alice changed the role of cath from admin to observer (signed)", + cath <## "#team: alice changed your role from admin to observer (signed)", + dan <## "#team: alice changed the role of cath from admin to observer (signed)", + eve <## "#team: alice changed the role of cath from admin to observer (signed)" ] -- frank joins; cath isn't in the roster, so frank has no record of her threadDelay 100000 @@ -9715,9 +9758,9 @@ testChannelRelayCannotDowngradeRosterMember ps = alice ##> "/mr #team cath moderator" alice <## "#team: you changed the role of cath to moderator (signed)" concurrentlyN_ - [ bob <## "#team: alice changed the role of cath from member to moderator (signed)", - cath <## "#team: alice changed your role from member to moderator (signed)", - frank <## "#team: alice changed the role of cath from member to moderator (signed)" + [ bob <## "#team: alice changed the role of cath from observer to moderator (signed)", + cath <## "#team: alice changed your role from observer to moderator (signed)", + frank <### [EndsWith "to moderator (signed)"] ] threadDelay 100000 realKey <- getMemberPubKey bob "cath" @@ -9736,7 +9779,7 @@ testChannelRelayCannotDowngradeRosterMember ps = [ alice <# "#team cath> hello from cath [>>]", do frank <##. "warning: x.grp.mem.new: relay asserted key differs from roster-established key, keeping roster key, memberId=" - frank <## "#team: unknown member cath updated to cath" + frank <### [EndsWith "updated to cath"] frank <## "#team: bob introduced cath (Catherine) in the channel" frank <# "#team cath> hello from cath [>>]" ] @@ -9762,15 +9805,20 @@ testChannelRemoveMemberSigned ps = withNewTestChat ps "eve" eveProfile $ \eve -> do createChannel1Relay "team" alice bob cath dan eve + -- promote eve to member (observer default) so it can post + promoteChannelMember "team" alice bob eve [cath, dan] + -- other members discover eve eve #> "#team hello from eve" bob <# "#team eve> hello from eve" concurrentlyN_ [ alice <# "#team eve> hello from eve [>>]", do + dan <### [EndsWith "updated to eve"] dan <## "#team: bob introduced eve (Eve) in the channel" dan <# "#team eve> hello from eve [>>]", do + cath <### [EndsWith "updated to eve"] cath <## "#team: bob introduced eve (Eve) in the channel" cath <# "#team eve> hello from eve [>>]" ] @@ -9943,6 +9991,9 @@ testChannelSubscriberLeave ps = withNewTestChat ps "eve" eveProfile $ \eve -> do createChannel1Relay "team" alice bob cath dan eve + -- promote cath to member (observer default) so it can post + promoteChannelMember "team" alice bob cath [dan, eve] + -- other members discover cath threadDelay 1000000 cath #> "#team hello from cath" @@ -9950,9 +10001,11 @@ testChannelSubscriberLeave ps = concurrentlyN_ [ alice <# "#team cath> hello from cath [>>]", do + dan <### [EndsWith "updated to cath"] dan <## "#team: bob introduced cath (Catherine) in the channel" dan <# "#team cath> hello from cath [>>]", do + eve <### [EndsWith "updated to cath"] eve <## "#team: bob introduced cath (Catherine) in the channel" eve <# "#team cath> hello from cath [>>]" ] @@ -10178,6 +10231,9 @@ testChannelSubscriberProfileUpdate ps = withNewTestChat ps "eve" eveProfile $ \eve -> do createChannel1Relay "team" alice bob cath dan eve + -- promote dan to member early (observer default) so its role-change item precedes the messages + promoteChannelMember "team" alice bob dan [cath, eve] + -- enable support and create support chat for cath (but not dan) threadDelay 1000000 alice ##> "/set support #team on" @@ -10197,6 +10253,9 @@ testChannelSubscriberProfileUpdate ps = (dan "#team hello from cath" @@ -10204,9 +10263,11 @@ testChannelSubscriberProfileUpdate ps = concurrentlyN_ [ alice <# "#team cath> hello from cath [>>]", do + dan <### [EndsWith "updated to cath"] dan <## "#team: bob introduced cath (Catherine) in the channel" dan <# "#team cath> hello from cath [>>]", do + eve <### [EndsWith "updated to cath"] eve <## "#team: bob introduced cath (Catherine) in the channel" eve <# "#team cath> hello from cath [>>]" ] @@ -10236,9 +10297,8 @@ testChannelSubscriberProfileUpdate ps = 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"] + -- cath/eve also know dan by id hash now (roster-learned before dan posts); not asserted -- previously silent subscriber updates profile -- dan has no support chat -> no profile update item created @@ -10250,9 +10310,11 @@ testChannelSubscriberProfileUpdate ps = concurrentlyN_ [ alice <# "#team dave> hello from dave [>>]", do + eve <### [EndsWith "updated to dave"] eve <## "#team: bob introduced dave in the channel" eve <# "#team dave> hello from dave [>>]", do + cath <### [EndsWith "updated to dave"] cath <## "#team: bob introduced dave in the channel" cath <# "#team dave> hello from dave [>>]" ] @@ -10348,13 +10410,13 @@ testChannelAddRelayWithRoster ps = (shortLink, fullLink) <- prepareChannel1Relay "team" alice bob memberJoinChannel "team" [bob] [alice] shortLink fullLink cath - -- promote cath to moderator: the roster is created (bob caches it) + -- promote cath observer -> moderator: the roster is created (bob caches it) threadDelay 100000 alice ##> "/mr #team cath moderator" alice <## "#team: you changed the role of cath to moderator (signed)" concurrentlyN_ - [ bob <## "#team: alice changed the role of cath from member to moderator (signed)", - cath <## "#team: alice changed your role from member to moderator (signed)" + [ bob <## "#team: alice changed the role of cath from observer to moderator (signed)", + cath <## "#team: alice changed your role from observer to moderator (signed)" ] threadDelay 100000 @@ -10381,22 +10443,171 @@ 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 "changed the role of cath from member to moderator (signed)", - EndsWith "accepting request to join group #team...", - EndsWith "member cath is connected" + <### [ EndsWith "accepting request to join group #team...", + EndsWith "is connected" ] ] threadDelay 100000 - -- the new relay holds the roster (cath is moderator) before it serves joiners + -- the new relay holds the roster (cath is moderator) and learns her name when she connects checkMemberRow dan "cath" (Just "moderator") +testChannelRosterMultipartReassembly :: HasCallStack => TestParams -> IO () +testChannelRosterMultipartReassembly ps = + withNewTestChatCfgOpts ps cfg testOpts "alice" aliceProfile $ \alice -> + withNewTestChatCfgOpts ps cfg relayTestOpts "bob" bobProfile $ \bob -> + withNewTestChatCfgOpts ps cfg testOpts "cath" cathProfile $ \cath -> + withNewTestChatCfgOpts ps cfg testOpts "dan" danProfile $ \dan -> do + (shortLink, fullLink) <- prepareChannel1Relay "team" alice bob + memberJoinChannel "team" [bob] [alice] shortLink fullLink cath + threadDelay 100000 + alice ##> "/mr #team cath moderator" + alice <## "#team: you changed the role of cath to moderator (signed)" + concurrentlyN_ + [ bob <## "#team: alice changed the role of cath from observer to moderator (signed)", + cath <## "#team: alice changed your role from observer to moderator (signed)" + ] + threadDelay 100000 + memberJoinChannel "team" [bob] [alice, cath] shortLink fullLink dan + -- dan reassembles the multi-chunk roster from the served snapshot (arrives async) + threadDelay 1000000 + checkMemberRow dan "cath" (Just "moderator") + where + cfg = testCfg {fileChunkSize = 30} + +testChannelRosterDigestMismatchRejected :: HasCallStack => TestParams -> IO () +testChannelRosterDigestMismatchRejected ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> + withNewTestChat ps "frank" frankProfile $ \frank -> do + (shortLink, fullLink) <- prepareChannel1Relay "team" alice bob + memberJoinChannel "team" [bob] [alice] shortLink fullLink cath + threadDelay 100000 + alice ##> "/mr #team cath moderator" + alice <## "#team: you changed the role of cath to moderator (signed)" + concurrentlyN_ + [ bob <## "#team: alice changed the role of cath from observer to moderator (signed)", + cath <## "#team: alice changed your role from observer to moderator (signed)" + ] + threadDelay 100000 + -- corrupt the relay's stored blob (same length, different content) so its digest no + -- longer matches the signed header (DB-agnostic: read it, overwrite with zeroed bytes) + withCCTransaction bob $ \db -> do + rows <- DB.query_ db "SELECT roster_blob FROM groups WHERE roster_blob IS NOT NULL" :: IO [Only (Binary ByteString)] + forM_ rows $ \(Only (Binary blob)) -> + DB.execute db "UPDATE groups SET roster_blob = ? WHERE roster_blob IS NOT NULL" (Only (Binary (B.replicate (B.length blob) '\NUL'))) + -- frank joins; bob re-serves the valid header with the corrupted blob, frank rejects it + threadDelay 100000 + memberJoinChannel "team" [bob] [alice, cath] shortLink fullLink frank + threadDelay 100000 + -- the rejected roster never elevates cath: the intro caps her to the channel default, so she + -- stays observer (not moderator), and the version must not advance to the corrupted roster's version 1 + checkMemberRow frank "cath" (Just "observer") + checkRosterNotApplied frank + where + -- the version is the second guarantee (the role is asserted above): frank holds exactly the team + -- group with no roster applied, so roster_version is NULL - it never advanced to the corrupted version 1 + checkRosterNotApplied :: HasCallStack => TestCC -> IO () + checkRosterNotApplied cc = do + vs <- withCCTransaction cc $ \db -> + DB.query_ db "SELECT roster_version FROM groups" :: IO [Only (Maybe Int64)] + map (\(Only v) -> v) vs `shouldBe` [Nothing] + +testChannelPromotedMemberCanPost :: HasCallStack => TestParams -> IO () +testChannelPromotedMemberCanPost ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> + withNewTestChat ps "dan" danProfile $ \dan -> do + (shortLink, fullLink) <- prepareChannel1Relay "team" alice bob + memberJoinChannel "team" [bob] [alice] shortLink fullLink cath + memberJoinChannel "team" [bob] [alice] shortLink fullLink dan + -- promote cath to member: cath enters the owner-signed roster (dan learns cath by id hash) + promoteChannelMember "team" alice bob cath [dan] + -- the promoted member can now post; dan resolves cath on the first forward + cath #> "#team hi from cath" + bob <# "#team cath> hi from cath" + alice <# "#team cath> hi from cath [>>]" + dan <### [EndsWith "updated to cath"] + dan <## "#team: bob introduced cath (Catherine) in the channel" + dan <# "#team cath> hi from cath [>>]" + checkMemberRow dan "cath" (Just "member") + +testChannelObserverCannotPost :: HasCallStack => TestParams -> IO () +testChannelObserverCannotPost ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> + withNewTestChat ps "cath" cathProfile $ \cath -> + withNewTestChat ps "dan" danProfile $ \dan -> do + (shortLink, fullLink) <- prepareChannel1Relay "team" alice bob + memberJoinChannel "team" [bob] [alice] shortLink fullLink cath + memberJoinChannel "team" [bob] [alice] shortLink fullLink dan + -- cath is an observer (default): its own post is rejected locally and never reaches the relay + cath ##> "#team observer attempt" + cath <## "#team: you don't have permission to send messages" + -- promote cath to member; the post is now accepted and delivered, dan resolves cath + promoteChannelMember "team" alice bob cath [dan] + cath #> "#team member post" + bob <# "#team cath> member post" + alice <# "#team cath> member post [>>]" + dan <### [EndsWith "updated to cath"] + dan <## "#team: bob introduced cath (Catherine) in the channel" + dan <# "#team cath> member post [>>]" + +testChannelPromotedMemberRejoinViaRelay :: HasCallStack => TestParams -> IO () +testChannelPromotedMemberRejoinViaRelay ps = + withNewTestChat ps "alice" aliceProfile $ \alice -> + withNewTestChatOpts ps relayTestOpts "bob" bobProfile $ \bob -> + withNewTestChatOpts ps relayTestOpts "dan" danProfile $ \dan -> + withNewTestChat ps "cath" cathProfile $ \cath -> do + (shortLink, fullLink) <- prepareChannel1Relay "team" alice bob + memberJoinChannel "team" [bob] [alice] shortLink fullLink cath + -- promote cath to member: cath enters the owner-signed roster with her pinned key + threadDelay 100000 + promoteChannelMember "team" alice bob cath [] + threadDelay 100000 + -- add dan as a 2nd relay; it caches the roster (incl. member cath) before joinable + dan ##> "/ad" + (danSLink, _cLink) <- getContactLinks dan True + alice ##> ("/relays name=dan " <> danSLink) + alice <## "ok" + alice ##> "/_add relays #1 2" + alice <## "#team: group relays:" + alice <## " - relay id 1: active" + alice <## " - relay id 2: invited" + concurrentlyN_ + [ do + alice <## "#team: group link relays updated, current relays:" + alice + <### [ " - relay id 1: active", + " - relay id 2: active" + ] + alice <## "group link:" + void $ getTermLine alice, + dan <## "#team: you joined the group as relay" + ] + -- cath (a promoted member) connects to the new relay; the widened join gate + -- (verifyKey over the roster-pinned key) accepts her and keeps her as member + concurrentlyN_ + [ do + cath <## "#team: joining the group (connecting to relay dan)..." + cath <## "#team: you joined the group (connected to relay dan)", + dan + <### [ EndsWith "accepting request to join group #team...", + EndsWith "is connected" + ] + ] + threadDelay 100000 + checkMemberRow dan "cath" (Just "member") + testChannelRemoveRelay :: HasCallStack => TestParams -> IO () testChannelRemoveRelay ps = withNewTestChat ps "alice" aliceProfile $ \alice -> @@ -10977,42 +11188,48 @@ testChannelMessageFile ps = withNewTestChat ps "dan" danProfile $ \dan -> withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer $ do createChannel1Relay "team" alice bob cath dan eve - + -- the roster arrives as a file before this one; Postgres assigns it a new id and does not + -- reuse it on delete (SQLite does), so the received message file is id 2 here, 1 on SQLite. +#if defined(dbPostgres) + let rcvFileId = 2 :: Int +#else + let rcvFileId = 1 :: Int +#endif -- owner sends file as channel message alice #> "/f #team ./tests/fixtures/test.jpg" alice <## "use /fc 1 to cancel sending" alice <## "completed uploading file 1 (test.jpg) for #team" bob <# "#team> sends file test.jpg (136.5 KiB / 139737 bytes)" - bob <## "use /fr 1 [/ | ] to receive it" + bob <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it") concurrentlyN_ [ do cath <# "#team> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]" - cath <## "use /fr 1 [/ | ] to receive it [>>]", + cath <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it [>>]"), do dan <# "#team> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]" - dan <## "use /fr 1 [/ | ] to receive it [>>]", + dan <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it [>>]"), do eve <# "#team> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]" - eve <## "use /fr 1 [/ | ] to receive it [>>]" + eve <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it [>>]") ] -- all members receive the file concurrently src <- B.readFile "./tests/fixtures/test.jpg" concurrentlyN_ - [ receiveFile bob "bob" src, - receiveFile cath "cath" src, - receiveFile dan "dan" src, - receiveFile eve "eve" src + [ receiveFile bob "bob" rcvFileId src, + receiveFile cath "cath" rcvFileId src, + receiveFile dan "dan" rcvFileId src, + receiveFile eve "eve" rcvFileId src ] where - receiveFile cc name src = do + receiveFile cc name fileId src = do let path = "./tests/tmp/test_" <> name <> ".jpg" - cc ##> ("/fr 1 " <> path) + cc ##> ("/fr " <> show fileId <> " " <> path) cc - <### [ ConsoleString ("saving file 1 from #team to " <> path), - "started receiving file 1 (test.jpg) from #team" + <### [ ConsoleString ("saving file " <> show fileId <> " from #team to " <> path), + ConsoleString ("started receiving file " <> show fileId <> " (test.jpg) from #team") ] - cc <## "completed receiving file 1 (test.jpg) from #team" + cc <## ("completed receiving file " <> show fileId <> " (test.jpg) from #team") B.readFile path >>= (`shouldBe` src) testChannelMessageFileCancel :: HasCallStack => TestParams -> IO () @@ -11023,33 +11240,37 @@ testChannelMessageFileCancel ps = withNewTestChat ps "dan" danProfile $ \dan -> withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer $ do createChannel1Relay "team" alice bob cath dan eve - +#if defined(dbPostgres) + let rcvFileId = 2 :: Int +#else + let rcvFileId = 1 :: Int +#endif -- owner sends file as channel message alice #> "/f #team ./tests/fixtures/test.jpg" alice <## "use /fc 1 to cancel sending" alice <## "completed uploading file 1 (test.jpg) for #team" bob <# "#team> sends file test.jpg (136.5 KiB / 139737 bytes)" - bob <## "use /fr 1 [/ | ] to receive it" + bob <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it") concurrentlyN_ [ do cath <# "#team> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]" - cath <## "use /fr 1 [/ | ] to receive it [>>]", + cath <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it [>>]"), do dan <# "#team> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]" - dan <## "use /fr 1 [/ | ] to receive it [>>]", + dan <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it [>>]"), do eve <# "#team> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]" - eve <## "use /fr 1 [/ | ] to receive it [>>]" + eve <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it [>>]") ] -- owner cancels file alice ##> "/fc 1" alice <## "cancelled sending file 1 (test.jpg) to bob" - bob <## "team cancelled sending file 1 (test.jpg)" + bob <## ("team cancelled sending file " <> show rcvFileId <> " (test.jpg)") concurrentlyN_ - [ cath <## "team cancelled sending file 1 (test.jpg)", - dan <## "team cancelled sending file 1 (test.jpg)", - eve <## "team cancelled sending file 1 (test.jpg)" + [ cath <## ("team cancelled sending file " <> show rcvFileId <> " (test.jpg)"), + dan <## ("team cancelled sending file " <> show rcvFileId <> " (test.jpg)"), + eve <## ("team cancelled sending file " <> show rcvFileId <> " (test.jpg)") ] testChannelMessageQuote :: HasCallStack => TestParams -> IO () @@ -11066,6 +11287,9 @@ testChannelMessageQuote ps = bob <# "#team> hello from channel" [cath, dan, eve] *<# "#team> hello from channel [>>]" + -- promote cath to member (observer default) so it can post + promoteChannelMember "team" alice bob cath [dan, eve] + -- member quotes channel message cath `send` "> #team (hello from) replying to channel" cath <# "#team > hello from channel" @@ -11077,10 +11301,12 @@ testChannelMessageQuote ps = alice <# "#team cath> > hello from channel [>>]" alice <## " replying to channel [>>]", do + dan <### [EndsWith "updated to cath"] dan <## "#team: bob introduced cath (Catherine) in the channel" dan <# "#team cath> > hello from channel [>>]" dan <## " replying to channel [>>]", do + eve <### [EndsWith "updated to cath"] eve <## "#team: bob introduced cath (Catherine) in the channel" eve <# "#team cath> > hello from channel [>>]" eve <## " replying to channel [>>]" @@ -11194,43 +11420,47 @@ testChannelOwnerFileTransferAsMember ps = withNewTestChat ps "dan" danProfile $ \dan -> withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer $ do createChannel1Relay "team" alice bob cath dan eve - +#if defined(dbPostgres) + let rcvFileId = 2 :: Int +#else + let rcvFileId = 1 :: Int +#endif -- owner sends file as member (not as channel) alice ##> "/_send #1(as_group=off) json [{\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"type\": \"file\", \"text\": \"\"}}]" alice <# "/f #team ./tests/fixtures/test.jpg" alice <## "use /fc 1 to cancel sending" alice <## "completed uploading file 1 (test.jpg) for #team" bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)" - bob <## "use /fr 1 [/ | ] to receive it" + bob <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it") concurrentlyN_ [ do cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]" - cath <## "use /fr 1 [/ | ] to receive it [>>]", + cath <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it [>>]"), do dan <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]" - dan <## "use /fr 1 [/ | ] to receive it [>>]", + dan <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it [>>]"), do eve <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]" - eve <## "use /fr 1 [/ | ] to receive it [>>]" + eve <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it [>>]") ] -- all members receive the file src <- B.readFile "./tests/fixtures/test.jpg" concurrentlyN_ - [ receiveFile bob "bob" src, - receiveFile cath "cath" src, - receiveFile dan "dan" src, - receiveFile eve "eve" src + [ receiveFile bob "bob" rcvFileId src, + receiveFile cath "cath" rcvFileId src, + receiveFile dan "dan" rcvFileId src, + receiveFile eve "eve" rcvFileId src ] where - receiveFile cc name src = do + receiveFile cc name fileId src = do let path = "./tests/tmp/test_" <> name <> ".jpg" - cc ##> ("/fr 1 " <> path) + cc ##> ("/fr " <> show fileId <> " " <> path) cc - <### [ ConsoleString ("saving file 1 from alice to " <> path), - "started receiving file 1 (test.jpg) from alice" + <### [ ConsoleString ("saving file " <> show fileId <> " from alice to " <> path), + ConsoleString ("started receiving file " <> show fileId <> " (test.jpg) from alice") ] - cc <## "completed receiving file 1 (test.jpg) from alice" + cc <## ("completed receiving file " <> show fileId <> " (test.jpg) from alice") B.readFile path >>= (`shouldBe` src) testChannelOwnerFileCancelAsMember :: HasCallStack => TestParams -> IO () @@ -11241,34 +11471,38 @@ testChannelOwnerFileCancelAsMember ps = withNewTestChat ps "dan" danProfile $ \dan -> withNewTestChat ps "eve" eveProfile $ \eve -> withXFTPServer $ do createChannel1Relay "team" alice bob cath dan eve - +#if defined(dbPostgres) + let rcvFileId = 2 :: Int +#else + let rcvFileId = 1 :: Int +#endif -- owner sends file as member (not as channel) alice ##> "/_send #1(as_group=off) json [{\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"type\": \"file\", \"text\": \"\"}}]" alice <# "/f #team ./tests/fixtures/test.jpg" alice <## "use /fc 1 to cancel sending" alice <## "completed uploading file 1 (test.jpg) for #team" bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)" - bob <## "use /fr 1 [/ | ] to receive it" + bob <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it") concurrentlyN_ [ do cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]" - cath <## "use /fr 1 [/ | ] to receive it [>>]", + cath <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it [>>]"), do dan <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]" - dan <## "use /fr 1 [/ | ] to receive it [>>]", + dan <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it [>>]"), do eve <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes) [>>]" - eve <## "use /fr 1 [/ | ] to receive it [>>]" + eve <## ("use /fr " <> show rcvFileId <> " [/ | ] to receive it [>>]") ] -- owner cancels file alice ##> "/fc 1" alice <## "cancelled sending file 1 (test.jpg) to bob" - bob <## "alice cancelled sending file 1 (test.jpg)" + bob <## ("alice cancelled sending file " <> show rcvFileId <> " (test.jpg)") concurrentlyN_ - [ cath <## "alice cancelled sending file 1 (test.jpg)", - dan <## "alice cancelled sending file 1 (test.jpg)", - eve <## "alice cancelled sending file 1 (test.jpg)" + [ cath <## ("alice cancelled sending file " <> show rcvFileId <> " (test.jpg)"), + dan <## ("alice cancelled sending file " <> show rcvFileId <> " (test.jpg)"), + eve <## ("alice cancelled sending file " <> show rcvFileId <> " (test.jpg)") ] testChannelReactionAttribution :: HasCallStack => TestParams -> IO () @@ -11432,14 +11666,19 @@ testChannelMemberMessageUpdate ps = withNewTestChat ps "eve" eveProfile $ \eve -> do createChannel1Relay "team" alice bob cath dan eve + -- promote cath to member (observer default) so it can post + promoteChannelMember "team" alice bob cath [dan, eve] + -- member sends a message cath #> "#team hello" bob <# "#team cath> hello" concurrentlyN_ [ alice <# "#team cath> hello [>>]", - do dan <## "#team: bob introduced cath (Catherine) in the channel" + do dan <### [EndsWith "updated to cath"] + dan <## "#team: bob introduced cath (Catherine) in the channel" dan <# "#team cath> hello [>>]", - do eve <## "#team: bob introduced cath (Catherine) in the channel" + do eve <### [EndsWith "updated to cath"] + eve <## "#team: bob introduced cath (Catherine) in the channel" eve <# "#team cath> hello [>>]" ] @@ -11463,14 +11702,19 @@ testChannelMemberMessageDelete ps = withNewTestChat ps "eve" eveProfile $ \eve -> do createChannel1Relay "team" alice bob cath dan eve + -- promote cath to member (observer default) so it can post + promoteChannelMember "team" alice bob cath [dan, eve] + -- member sends a message cath #> "#team hello" bob <# "#team cath> hello" concurrentlyN_ [ alice <# "#team cath> hello [>>]", - do dan <## "#team: bob introduced cath (Catherine) in the channel" + do dan <### [EndsWith "updated to cath"] + dan <## "#team: bob introduced cath (Catherine) in the channel" dan <# "#team cath> hello [>>]", - do eve <## "#team: bob introduced cath (Catherine) in the channel" + do eve <### [EndsWith "updated to cath"] + eve <## "#team: bob introduced cath (Catherine) in the channel" eve <# "#team cath> hello [>>]" ] diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index aef41e90d2..2a1848a93b 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -278,7 +278,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do #==# XGrpMemConAll (MemberId "\1\2\3\4") it "x.grp.mem.del" $ "{\"v\":\"1\",\"event\":\"x.grp.mem.del\",\"params\":{\"memberId\":\"AQIDBA==\"}}" - #==# XGrpMemDel (MemberId "\1\2\3\4") False + #==# XGrpMemDel (MemberId "\1\2\3\4") False Nothing it "x.grp.leave" $ "{\"v\":\"1\",\"event\":\"x.grp.leave\",\"params\":{}}" ==# XGrpLeave