dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-07-02 17:52:00 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: public groups - roster of privileged members (#7017)

Browse Source
This commit is contained in:
spaced4ndy
2026-06-22 10:15:41 +00:00
committed by GitHub
parent 5d3f016627
commit 0e09b38ea6
33 changed files with 2902 additions and 411 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Library/Commands.hs
+78 -56
View File
@@ -1289,6 +1289,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 <-
@@ -2050,9 +2052,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
@@ -2062,9 +2064,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
@@ -2081,11 +2083,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
@@ -2153,7 +2155,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'
@@ -2246,7 +2248,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"
@@ -2756,34 +2758,45 @@ processChatCommand cxt nm = \case
-- TODO [relays] possible optimization is to read only required members + relays
g@(Group gInfo members) <- withFastStore $ \db -> getGroup db cxt user groupId
when (selfSelected gInfo) $ throwCmdError "can't change role for self"
let (invitedMems, currentMems, unchangedMems, maxRole, anyAdmin, anyPending) = selectMembers members
let (invitedMems, currentMems, unchangedMems, maxRole, anyAdmin, anyPending, anyPrivilegedTarget, finalPrivilegedCount) = selectMembers members
when (length invitedMems + length currentMems + length unchangedMems /= length memberIds) $ throwChatError CEGroupMemberNotFound
when (length memberIds > 1 && (anyAdmin || newRole >= GRAdmin)) $
throwCmdError "can't change role of multiple members when admins selected, or new role is admin"
when anyPending $ throwCmdError "can't change role of members pending approval"
assertUserGroupRole gInfo $ maximum ([GRAdmin, maxRole, newRole] :: [GroupMemberRole])
-- in relay groups the roster has a single signer, so only the owner may change moderator/admin roles
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 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
pure $ CRMembersRoleUser {user, groupInfo = gInfo, members = changed1 <> changed2, toRole = newRole, msgSigned} -- same order is not guaranteed
where
selfSelected GroupInfo {membership} = elem (groupMemberId' membership) memberIds
selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
selectMembers = foldr' addMember ([], [], [], GRObserver, False, False)
-- anyPrivilegedTarget: a target currently moderator/admin; finalPrivilegedCount:
-- moderators + admins after the change (targets take newRole, others keep their role).
selectMembers :: [GroupMember] -> ([GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool, Bool, Bool, Int)
selectMembers = foldr' addMember ([], [], [], GRObserver, False, False, False, 0)
where
addMember m@GroupMember {groupMemberId, memberStatus, memberRole} (invited, current, unchanged, maxRole, anyAdmin, anyPending)
addMember m@GroupMember {groupMemberId, memberStatus, memberRole} (invited, current, unchanged, maxRole, anyAdmin, anyPending, anyPrivTarget, privCount)
| groupMemberId `elem` memberIds =
let maxRole' = max maxRole memberRole
anyAdmin' = anyAdmin || memberRole >= GRAdmin
anyPending' = anyPending || memberPending m
in
if
| memberRole == newRole -> (invited, current, m : unchanged, maxRole', anyAdmin', anyPending')
| memberStatus == GSMemInvited -> (m : invited, current, unchanged, maxRole', anyAdmin', anyPending')
| otherwise -> (invited, m : current, unchanged, maxRole', anyAdmin', anyPending')
| otherwise = (invited, current, unchanged, maxRole, anyAdmin, anyPending)
anyPrivTarget' = anyPrivTarget || isRosterRole memberRole
privCount' = if isRosterRole newRole then privCount + 1 else privCount
in if
| memberRole == newRole -> (invited, current, m : unchanged, maxRole', anyAdmin', anyPending', anyPrivTarget', privCount')
| memberStatus == GSMemInvited -> (m : invited, current, unchanged, maxRole', anyAdmin', anyPending', anyPrivTarget', privCount')
| otherwise -> (invited, m : current, unchanged, maxRole', anyAdmin', anyPending', anyPrivTarget', privCount')
| otherwise = (invited, current, unchanged, maxRole, anyAdmin, anyPending, anyPrivTarget, if isRosterRole memberRole then privCount + 1 else privCount)
changeRoleInvitedMems :: User -> GroupInfo -> [GroupMember] -> CM ([ChatError], [GroupMember])
changeRoleInvitedMems user gInfo memsToChange = do
-- not batched, as we need to send different invitations to different connections anyway
@@ -2798,19 +2811,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
@@ -2874,20 +2888,25 @@ processChatCommand cxt nm = \case
withGroupLock "removeMembers" groupId $ do
-- TODO [relays] possible optimization is to read only required members + relays
Group gInfo members <- withFastStore $ \db -> getGroup db cxt user groupId
let (count, invitedMems, pendingApprvMems, pendingRvwMems, currentMems, maxRole, anyAdmin) = selectMembers gmIds members
let (count, invitedMems, pendingApprvMems, pendingRvwMems, currentMems, maxRole, anyAdmin, anyPrivilegedRemoved) = selectMembers gmIds members
gmIds = S.fromList $ L.toList groupMemberIds
memCount = length groupMemberIds
when (count /= memCount) $ throwChatError CEGroupMemberNotFound
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 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
@@ -2902,19 +2921,20 @@ processChatCommand cxt nm = \case
unless (null errs) $ toView $ CEvtChatErrors errs
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)
selectMembers gmIds = foldl' addMember (0, [], [], [], [], GRObserver, False)
selectMembers :: S.Set GroupMemberId -> [GroupMember] -> (Int, [GroupMember], [GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)
selectMembers gmIds = foldl' addMember (0, [], [], [], [], GRObserver, False, False)
where
addMember acc@(n, invited, pendingApprv, pendingRvw, current, maxRole, anyAdmin) m@GroupMember {groupMemberId, memberStatus, memberRole}
addMember acc@(n, invited, pendingApprv, pendingRvw, current, maxRole, anyAdmin, anyPrivRemoved) m@GroupMember {groupMemberId, memberStatus, memberRole}
| groupMemberId `S.member` gmIds =
let maxRole' = max maxRole memberRole
anyAdmin' = anyAdmin || memberRole >= GRAdmin
anyPrivRemoved' = anyPrivRemoved || isRosterRole memberRole
n' = n + 1
in case memberStatus of
GSMemInvited -> (n', m : invited, pendingApprv, pendingRvw, current, maxRole', anyAdmin')
GSMemPendingApproval -> (n', invited, m : pendingApprv, pendingRvw, current, maxRole', anyAdmin')
GSMemPendingReview -> (n', invited, pendingApprv, m : pendingRvw, current, maxRole', anyAdmin')
_ -> (n', invited, pendingApprv, pendingRvw, m : current, maxRole', anyAdmin')
GSMemInvited -> (n', m : invited, pendingApprv, pendingRvw, current, maxRole', anyAdmin', anyPrivRemoved')
GSMemPendingApproval -> (n', invited, m : pendingApprv, pendingRvw, current, maxRole', anyAdmin', anyPrivRemoved')
GSMemPendingReview -> (n', invited, pendingApprv, m : pendingRvw, current, maxRole', anyAdmin', anyPrivRemoved')
_ -> (n', invited, pendingApprv, pendingRvw, m : current, maxRole', anyAdmin', anyPrivRemoved')
| otherwise = acc
deleteInvitedMems :: User -> [GroupMember] -> CM ([ChatError], [GroupMember])
deleteInvitedMems user memsToDelete = do
@@ -2927,14 +2947,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_)
@@ -3134,7 +3154,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
@@ -3613,13 +3633,18 @@ processChatCommand cxt nm = \case
where
cReqHash1 = contactCReqHash $ CRContactUri crData {crScheme = SSSimplex}
cReqHash2 = contactCReqHash $ CRContactUri crData {crScheme = simplexChat}
-- relay-group joins (only via connectToRelay) carry the target relay member in preparedEntity_;
-- its memberId binds the join signature so a sibling relay can't replay it
relayMemberId_ = case preparedEntity_ of
Just (PCEGroup gInfo m) | useRelays' gInfo -> Just (memberId' m)
_ -> Nothing
joinPreparedConn' xContactId_ conn@Connection {customUserProfileId} gInfo_ = do
when (incognito /= isJust customUserProfileId) $ throwCmdError "incognito mode is different from prepared connection"
-- TODO [relays] member: refactor joinContact and up avoiding parallel ifs, xContactId is not used
xContactId <- mkXContactId xContactId_
localIncognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId
let incognitoProfile = fromLocalProfile <$> localIncognitoProfile
conn' <- joinContact user conn cReq incognitoProfile xContactId welcomeSharedMsgId msg_ gInfo_ PQSupportOn
conn' <- joinContact user conn cReq incognitoProfile xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ PQSupportOn
pure $ CVRSentInvitation conn' incognitoProfile
connect' groupLinkId xContactId_ gInfo_ = do
let inGroup = isJust groupLinkId
@@ -3634,7 +3659,7 @@ processChatCommand cxt nm = \case
subMode <- chatReadVar subscriptionMode
let sLnk' = serverShortLink <$> sLnk
conn <- withFastStore' $ \db -> createConnReqConnection db userId connId preparedEntity_ cReq cReqHash1 sLnk' xContactId incognitoProfile_ groupLinkId subMode chatV pqSup
conn' <- joinContact user conn cReq incognitoProfile xContactId welcomeSharedMsgId msg_ gInfo_ pqSup
conn' <- joinContact user conn cReq incognitoProfile xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ pqSup
pure $ CVRSentInvitation conn' incognitoProfile
connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> CreatedLinkContact -> CM ChatResponse
connectContactViaAddress user@User {userId} incognito ct@Contact {contactId, activeConn} (CCLink cReq shortLink) =
@@ -3649,7 +3674,7 @@ processChatCommand cxt nm = \case
subMode <- chatReadVar subscriptionMode
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
conn <- withFastStore' $ \db -> createConnReqConnection db userId connId (Just $ PCEContact ct) cReq cReqHash shortLink newXContactId (NewIncognito <$> incognitoProfile) Nothing subMode chatV pqSup
void $ joinContact user conn cReq incognitoProfile newXContactId Nothing Nothing Nothing pqSup
void $ joinContact user conn cReq incognitoProfile newXContactId Nothing Nothing Nothing Nothing pqSup
ct' <- withStore $ \db -> getContact db cxt user contactId
pure $ CRSentInvitationToContact user ct' incognitoProfile
Just conn@Connection {connStatus, xContactId = xContactId_, customUserProfileId} -> case connStatus of
@@ -3658,7 +3683,7 @@ processChatCommand cxt nm = \case
xContactId <- mkXContactId xContactId_
localIncognitoProfile <- forM customUserProfileId $ \pId -> withFastStore $ \db -> getProfileById db userId pId
let incognitoProfile = fromLocalProfile <$> localIncognitoProfile
void $ joinContact user conn cReq incognitoProfile xContactId Nothing Nothing Nothing PQSupportOn
void $ joinContact user conn cReq incognitoProfile xContactId Nothing Nothing Nothing Nothing PQSupportOn
ct' <- withStore $ \db -> getContact db cxt user contactId
pure $ CRSentInvitationToContact user ct' incognitoProfile
_ -> throwCmdError "contact already has connection"
@@ -3670,13 +3695,14 @@ processChatCommand cxt nm = \case
r <- tryAllErrors $ do
(fd@FixedLinkData {rootKey = relayKey, linkEntityId}, cData) <- getShortLinkConnReq nm user relayLink
relayLinkData_ <- liftIO $ decodeLinkUserData cData
case (relayLinkData_, linkEntityId) of
(Just RelayShortLinkData {relayProfile = p}, Just entityId) ->
relayMemberId <- case (relayLinkData_, linkEntityId) of
(Just RelayShortLinkData {relayProfile = p}, Just entityId) -> do
withFastStore $ \db -> updateRelayMemberData db cxt user relayMember (MemberId entityId) (MemberKey relayKey) p
pure $ MemberId entityId
_ -> throwChatError $ CEException "relay link: no relay link data or entity id"
let cReq = linkConnReq fd
relayLinkToConnect = CCLink cReq (Just relayLink)
void $ connectViaContact user (Just $ PCEGroup gInfo relayMember) (incognitoMembership gInfo) relayLinkToConnect Nothing Nothing
void $ connectViaContact user (Just $ PCEGroup gInfo (relayMember {memberId = relayMemberId})) (incognitoMembership gInfo) relayLinkToConnect Nothing Nothing
relayMember' <- withFastStore $ \db -> getGroupMember db cxt user (groupId' gInfo) (groupMemberId' relayMember)
pure (relayLink, relayMember', r)
syncSubscriberRelays :: User -> GroupInfo -> [ShortLinkContact] -> CM ()
@@ -3712,8 +3738,8 @@ processChatCommand cxt nm = \case
pure (connId, chatV)
mkXContactId :: Maybe XContactId -> CM XContactId
mkXContactId = maybe (XContactId <$> drgRandomBytes 16) pure
joinContact :: User -> Connection -> ConnReqContact -> Maybe Profile -> XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> Maybe (Maybe GroupInfo) -> PQSupport -> CM Connection
joinContact user conn@Connection {connChatVersion = chatV} cReq incognitoProfile xContactId welcomeSharedMsgId msg_ gInfo_ pqSup = do
joinContact :: User -> Connection -> ConnReqContact -> Maybe Profile -> XContactId -> Maybe SharedMsgId -> Maybe (SharedMsgId, MsgContent) -> Maybe (Maybe GroupInfo) -> Maybe MemberId -> PQSupport -> CM Connection
joinContact user conn@Connection {connChatVersion = chatV} cReq incognitoProfile xContactId welcomeSharedMsgId msg_ gInfo_ relayMemberId_ pqSup = do
-- gInfo_ is Maybe (Maybe GroupInfo), where Just Nothing means "some unknown group", e.g. when joining via link without profile
profileToSend <-
presentUserBadge user incognitoProfile $ case gInfo_ of
@@ -3721,15 +3747,11 @@ processChatCommand cxt nm = \case
let allowSimplexLinks = maybe True groupUserAllowSimplexLinks gInfo_'
in userProfileInGroup' user allowSimplexLinks incognitoProfile
Nothing -> userProfileDirect user incognitoProfile Nothing True
chatEvent <- case gInfo_ of
Just (Just gInfo) | useRelays' gInfo -> do
let GroupInfo {membership = GroupMember {memberId}} = gInfo
memberPubKey <- case groupKeys gInfo of
Just GroupKeys {memberPrivKey} -> pure $ C.publicKey memberPrivKey
Nothing -> throwChatError $ CEInternalError "no group keys for channel membership"
pure $ XMember profileToSend memberId (MemberKey memberPubKey)
_ -> pure $ XContact profileToSend (Just xContactId) welcomeSharedMsgId msg_
dm <- encodeConnInfoPQ pqSup chatV chatEvent
dm <- case gInfo_ of
Just (Just gInfo) | useRelays' gInfo -> case relayMemberId_ of
Just relayMemberId -> encodeXMemberConnInfo gInfo relayMemberId profileToSend
Nothing -> throwChatError $ CEInternalError "relay group join without target relay memberId"
_ -> encodeConnInfoPQ pqSup chatV $ XContact profileToSend (Just xContactId) welcomeSharedMsgId msg_
subMode <- chatReadVar subscriptionMode
void $ withAgent $ \a -> joinConnection a nm (aUserId user) (aConnId conn) True cReq dm pqSup subMode
withFastStore' $ \db -> updateConnectionStatusFromTo db conn ConnPrepared ConnJoined
@@ -4914,7 +4936,7 @@ runRelayGroupLinkChecks user = do
then do
-- TODO [relays] emit event to UI when relay own status promoted to RSActive
-- CEvtGroupRelayUpdated requires GroupRelay (owner-side), not available on relay side
void $ withStore' $ \db -> updateRelayOwnStatusFromTo db gInfo RSAccepted RSActive
void $ withStore' $ \db -> updateRelayOwnStatus_ db gInfo RSActive
else void $ withStore' $ \db -> updateRelayOwnStatusFromTo db gInfo RSActive RSInactive
_ -> pure ()
_ -> pure ()
src/Simplex/Chat/Library/Internal.hs
+216 -38
View File
@@ -59,7 +59,7 @@ import Simplex.Chat.Controller
import Simplex.Chat.Files
import Simplex.Chat.Markdown
import Simplex.Chat.Messages
import Simplex.Chat.Messages.Batch (BatchMode (..), MsgBatch (..), batchMessages, encodeBinaryBatch, encodeFwdElement)
import Simplex.Chat.Messages.Batch (BatchMode (..), MsgBatch (..), batchMessages, encodeBatchElement, encodeBinaryBatch, encodeFwdElement)
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Messages.CIContent.Events
import Simplex.Chat.Operators
@@ -80,6 +80,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
@@ -935,9 +936,9 @@ acceptContactRequestAsync
liftIO $ setCommandConnId db user cmdId connId
getContact db cxt user contactId
acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> Maybe MemberKey -> CM GroupMember
acceptGroupJoinRequestAsync :: User -> Int64 -> GroupInfo -> InvitationId -> VersionRangeChat -> Profile -> Maybe XContactId -> Maybe MemberId -> Maybe SharedMsgId -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> Maybe MemberKey -> Maybe GroupMember -> CM GroupMember
acceptGroupJoinRequestAsync
user
user@User {userId}
uclId
gInfo@GroupInfo {groupProfile, membership, businessChat}
cReqInvId
@@ -949,12 +950,22 @@ acceptGroupJoinRequestAsync
gAccepted
gLinkMemRole
incognitoProfile
memberKey_ = do
memberKey_
existingMem_ = do
gVar <- asks random
let initialStatus = acceptanceToStatus (memberAdmission groupProfile) gAccepted
-- a roster-established privileged member attaches a connection to its existing record (keeping
-- owner-authoritative role + key); everyone else is created fresh with the group-link role
cxt <- chatStoreCxt
(groupMemberId, memberId) <- withStore $ \db ->
createJoiningMember db cxt gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ cReqMemberId_ welcomeMsgId_ gLinkMemRole initialStatus memberKey_
(groupMemberId, memberId) <- case existingMem_ of
Just m -> do
-- 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 cxt user m cReqProfile
pure (groupMemberId' m, memberId' m)
Nothing -> withStore $ \db ->
createJoiningMember db cxt gVar user gInfo cReqChatVRange cReqProfile cReqXContactId_ cReqMemberId_ welcomeMsgId_ gLinkMemRole initialStatus memberKey_
let currentMemCount = fromIntegral $ currentMembers $ groupSummary gInfo
let Profile {displayName} = userProfileInGroup user gInfo (fromIncognitoProfile <$> incognitoProfile)
GroupMember {memberRole = userRole, memberId = userMemberId} = membership
@@ -1169,21 +1180,47 @@ memberIntroEvt gInfo reMember =
mRestrictions = memberRestrictions reMember
in XGrpMemIntro mInfo mRestrictions
-- 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 =
when (member `supportsVersion` groupRosterVersion) $ do
cxt <- chatStoreCxt
withStore' (\db -> getGroupRoster db gInfo) >>= \case
Just (ownerGMId, brokerTs, sm@SignedMsg {signedBody}, blob_) ->
case J.eitherDecodeStrict' signedBody :: Either String (ChatMessage 'Json) of
Left e -> logError $ "serveRoster: cannot decode saved roster message: " <> tshow e
Right 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 member fwd (VMSigned MSSVerified sm chatMsg)
forM_ ((,) <$> msgId <*> blob_) $ \(sid, blob) ->
sendInlineBlobChunks user gInfo [member] sid blob
Left e -> logError $ "serveRoster: roster owner not found: " <> tshow e
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.
-- This doesn't create introduction records in db, compared to above methods.
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
modMs <- withStore' $ \db -> getGroupModerators db cxt user gInfo
(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]
let introEvts = map (memberIntroEvt gInfo) modMs
forM_ (L.nonEmpty introEvts) $ \introEvts' ->
sendGroupMemberMessages user gInfo conn introEvts'
-- owner intros first so the joiner has the owner profile loaded before applying the saved roster (signed by the owner)
sendIntros owners
serveRoster user gInfo subscriber
sendIntros adminsMods
withStore' $ \db ->
setMembersVectorsNewRelation db modMs subscriberIdx IDSubjectIntroduced MRIntroduced
where
sendIntros ms = forM_ (L.nonEmpty $ map (memberIntroEvt gInfo) ms) $ \evts ->
sendGroupMemberMessages user gInfo conn evts
userProfileInGroup :: User -> GroupInfo -> Maybe Profile -> Profile
userProfileInGroup user = userProfileInGroup' user . groupUserAllowSimplexLinks
@@ -1215,6 +1252,29 @@ redactedMemberProfile allowSimplexLinks Profile {displayName, fullName, shortDes
| hasObfuscatedSimplexLink s = Nothing
| otherwise = maybe (Just s) (\fts -> if any ftIsSimplexLink fts then Nothing else Just s) $ parseMaybeMarkdownList s
-- Roles carried by the roster; owners are on the link, not the roster.
isRosterRole :: GroupMemberRole -> Bool
isRosterRole r = r == GRMember || r == GRModerator || r == GRAdmin
-- Drop non-privileged-role entries and de-duplicate by memberId, keeping the first.
-- Runs on the parsed roster blob.
validateGroupRoster :: [RosterMember] -> [RosterMember]
validateGroupRoster entries =
dedup S.empty $ filter (\RosterMember {role} -> isRosterRole role) entries
where
dedup _ [] = []
dedup seen (rm@RosterMember {memberId} : rms)
| memberId `S.member` seen = dedup seen rms
| otherwise = rm : dedup (S.insert memberId seen) rms
-- Privileged members without a known key are skipped (recipients can't verify them).
buildGroupRoster :: [GroupMember] -> [RosterMember]
buildGroupRoster mods = take maxGroupRosterSize $ mapMaybe rosterMember mods
where
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 ()
sendHistory _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active"
sendHistory user gInfo@GroupInfo {membership} m@GroupMember {activeConn = Just conn} =
@@ -1341,7 +1401,7 @@ setGroupLinkData :: NetworkRequestMode -> User -> GroupInfo -> GroupLink -> CM G
setGroupLinkData nm user gInfo gLink = do
cxt <- chatStoreCxt
(conn, groupRelays) <- withFastStore $ \db ->
(,) <$> getGroupLinkConnection db cxt user gInfo <*> liftIO (getConnectedGroupRelays db gInfo)
(,) <$> getGroupLinkConnection db cxt user gInfo <*> liftIO (getPublishableGroupRelays db cxt user gInfo)
let (userLinkData, crClientData) = groupLinkData gInfo gLink groupRelays
linkType = if useRelays' gInfo then CCTChannel else CCTGroup
sLnk <- shortenShortLink' . setShortLinkType_ linkType =<< withAgent (\a -> setConnShortLink a nm (aConnId conn) SCMContact userLinkData (Just crClientData))
@@ -1351,7 +1411,7 @@ setGroupLinkDataAsync :: User -> GroupInfo -> GroupLink -> CM ()
setGroupLinkDataAsync user gInfo gLink = do
cxt <- chatStoreCxt
(conn, groupRelays) <- withStore $ \db ->
(,) <$> getGroupLinkConnection db cxt user gInfo <*> liftIO (getConnectedGroupRelays db gInfo)
(,) <$> getGroupLinkConnection db cxt user gInfo <*> liftIO (getPublishableGroupRelays db cxt user gInfo)
let (userLinkData, crClientData) = groupLinkData gInfo gLink groupRelays
setAgentConnShortLinkAsync user conn userLinkData (Just crClientData)
@@ -1628,13 +1688,16 @@ sendFileInline_ FileTransferMeta {filePath, chunkSize} sharedMsgId sendMsg =
chSize = fromIntegral chunkSize
parseChatMessage :: Connection -> ByteString -> CM (ChatMessage 'Json)
parseChatMessage conn s = do
parseChatMessage conn s = snd <$> parseChatMessage' conn s
{-# INLINE parseChatMessage #-}
parseChatMessage' :: Connection -> ByteString -> CM (Maybe SignedMsg, ChatMessage 'Json)
parseChatMessage' conn s =
case parseChatMessages s of
[msg] -> liftEither . first (ChatError . errType) $ (\(APMsg _ (ParsedMsg _ _ m)) -> checkEncoding m) =<< msg
[msg] -> liftEither . first (ChatError . errType) $ (\(APMsg _ (ParsedMsg _ sm m)) -> (sm,) <$> checkEncoding m) =<< msg
_ -> throwChatError $ CEException "parseChatMessage: single message is expected"
where
errType = CEInvalidChatMessage conn Nothing (safeDecodeUtf8 s)
{-# INLINE parseChatMessage #-}
getChatScopeInfo :: StoreCxt -> User -> GroupChatScope -> CM GroupChatScopeInfo
getChatScopeInfo cxt user = \case
@@ -1831,6 +1894,51 @@ 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} 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
deleteGroupRosterTransfers db groupId
-- Supersede/cancel one source relay's in-flight roster transfer: remove its on-disk file + cached
-- handle first (the cascade only does rows), then the files + transfer rows.
cleanupRosterTransfer :: GroupInfo -> GroupMemberId -> CM ()
cleanupRosterTransfer gInfo fromMemberId =
withStore' (\db -> getRosterTransferId db gInfo fromMemberId) >>= mapM_ cleanupRosterTransferById
cleanupRosterTransferById :: Int64 -> CM ()
cleanupRosterTransferById transferId = do
file_ <- withStore' $ \db -> getRosterTransferFile db transferId
forM_ file_ $ \(fileId, filePath_) -> do
lift $ closeFileHandle fileId rcvFiles
forM_ filePath_ removeFsFile
withStore' $ \db -> do
deleteRosterTransferFile db transferId
deleteRosterTransfer db transferId
-- 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
@@ -2063,6 +2171,26 @@ encodeConnInfoPQ pqSup v chatMsgEvent = do
_ -> pure connInfo
ECMLarge -> throwChatError $ CEException "large info"
-- conn-info wrapped as a signed element, so the receiver can verify the signature over the body
encodeSignedConnInfo :: MsgEncodingI e => MsgSigning -> ChatMsgEvent e -> CM ByteString
encodeSignedConnInfo signing chatMsgEvent = do
vr <- chatVersionRange
let info = ChatMessage {chatVRange = vr, msgId = Nothing, chatMsgEvent}
case encodeChatMessage maxEncodedInfoLength info of
ECMEncoded body -> pure $ encodeBatchElement (Just $ signChatMsgBody signing body) body
ECMLarge -> throwChatError $ CEException "large signed info"
-- signed XMember for a relay-group join: proves the joiner holds the member key it asserts, and carries
-- viaRelay = the target relay's memberId inside the signed body so a sibling relay can't accept a replay
encodeXMemberConnInfo :: GroupInfo -> MemberId -> Profile -> CM ByteString
encodeXMemberConnInfo GroupInfo {membership = GroupMember {memberId}, groupKeys} relayMemberId profileToSend =
case groupKeys of
Just GroupKeys {publicGroupId, memberPrivKey} ->
let xMemberEvt = XMember profileToSend memberId (MemberKey $ C.publicKey memberPrivKey) (Just relayMemberId)
signing = MsgSigning CBGroup (smpEncode (publicGroupId, memberId)) KRMember memberPrivKey
in encodeSignedConnInfo signing xMemberEvt
Nothing -> throwChatError $ CEInternalError "no group keys for channel membership"
deliverMessage :: Connection -> CMEventTag e -> MsgBody -> MessageId -> CM (Int64, PQEncryption)
deliverMessage conn cmEventTag msgBody msgId = do
let msgFlags = MsgFlags {notification = hasNotification cmEventTag}
@@ -2136,6 +2264,52 @@ sendGroupMessage' user gInfo members chatMsgEvent =
((Right msg) :| [], _) -> pure msg
_ -> throwChatError $ CEInternalError "sendGroupMessage': expected 1 message"
-- 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)
-- 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)
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' ->
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
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
-- Relay advertises its current web preview capability to channel owners.
-- Idempotent: sends only when the configured web domain differs from what was last sent, and only to
-- owners whose recorded chat version supports relayWebCapVersion (older apps can't parse XGrpRelayCap).
@@ -2372,10 +2546,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}
@@ -2513,11 +2691,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 =
@@ -2679,7 +2857,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 =>
@@ -2709,15 +2887,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
@@ -2750,16 +2928,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)
@@ -2771,7 +2949,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
@@ -2780,24 +2958,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,
src/Simplex/Chat/Library/Subscriber.hs
+448 -135
View File
@@ -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.Web (channelContentChanged, channelProfileUpdated, channelRemoved)
import Simplex.Chat.Messages
@@ -77,7 +80,7 @@ import qualified Simplex.FileTransfer.Transport as XFTP
import Simplex.FileTransfer.Types (FileErrorType (..), RcvFileId, SndFileId)
import Simplex.Messaging.Agent
import Simplex.Messaging.Agent.Client (getAgentWorker, temporaryOrHostError, waitForUserNetwork, waitForWork, waitWhileSuspended, withWorkItems, withWork_)
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), Worker (..))
import Simplex.Messaging.Agent.Env.SQLite (Worker (..))
import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..))
import Simplex.Messaging.Agent.RetryInterval (RetryInterval (..), nextRetryDelay)
@@ -87,8 +90,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 (..))
@@ -106,6 +111,13 @@ import UnliftIO.STM
smallGroupsRcptsMemLimit :: Int
smallGroupsRcptsMemLimit = 20
-- Verifies member signatures over CBGroup <> (publicGroupId, memberId) <> signedBody under the given key.
-- signatures is NonEmpty so the verification can't be vacuously true.
verifyGroupSig :: C.PublicKeyEd25519 -> B64UrlByteString -> MemberId -> NonEmpty MsgSignature -> ByteString -> Bool
verifyGroupSig key publicGroupId memberId signatures signedBody =
let prefix = smpEncode CBGroup <> smpEncode (publicGroupId, memberId)
in all (\case (MsgSignature KRMember sig) -> C.verify (C.APublicVerifyKey C.SEd25519 key) sig (prefix <> signedBody)) signatures
processAgentMessage :: ACorrId -> ConnId -> AEvent 'AEConn -> CM ()
processAgentMessage _ _ (DEL_RCVQS delQs) =
toView $ CEvtAgentRcvQueuesDeleted $ L.map rcvQ delQs
@@ -576,7 +588,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)
profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile)
@@ -901,8 +913,21 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
GCInviteeMember
| isRelay m -> do
withStore' $ \db -> updateGroupMemberStatus db userId m GSMemConnected
gLink <- withStore $ \db -> getGroupLink db user gInfo
setGroupLinkDataAsync user gInfo gLink
if m `supportsVersion` groupRosterVersion
then do
-- send the relay a roster (materializing version 0 for old channels with NULL roster_version);
-- the relay stays RSInvited (unpublishable) until it acks, so no joiner can impersonate a privileged member
gInfo' <- case rosterVersion gInfo of
Just _ -> pure gInfo
Nothing -> do
withStore' $ \db -> setGroupRosterVersion db gInfo (VersionRoster 0)
pure gInfo {rosterVersion = Just (VersionRoster 0)}
sendGroupRosterToRelay user gInfo' m
else do
-- a relay below groupRosterVersion can't ack a roster; publish it on connect as before
-- the handshake (getPublishableGroupRelays and the LINK handler include/activate it by version)
gLink <- withStore $ \db -> getGroupLink db user gInfo
setGroupLinkDataAsync user gInfo gLink
| otherwise -> do
(gInfo', mStatus) <-
if not (memberPending m)
@@ -1024,8 +1049,8 @@ 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
cc <- ask
(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
@@ -1064,23 +1089,25 @@ 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'' 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
XGrpMsgForward fwd msg' -> Nothing <$ xGrpMsgForward gInfo' Nothing m'' fwd (ParsedMsg Nothing Nothing msg') brokerTs
XInfoProbe probe -> Nothing <$ xInfoProbe (COMGroupMember m'') probe
XInfoProbeCheck probeHash -> Nothing <$ xInfoProbeCheck (COMGroupMember m'') probeHash
XInfoProbeOk probe -> Nothing <$ xInfoProbeOk (COMGroupMember m'') probe
BFileChunk sharedMsgId chunk -> Nothing <$ bFileChunkGroup gInfo' sharedMsgId chunk msgMeta
BFileChunk sharedMsgId chunk -> Nothing <$ bFileChunkGroup gInfo' m'' sharedMsgId chunk msgMeta
_ -> Nothing <$ messageError ("unsupported message: " <> tshow event)
forM deliveryTaskContext_ $ \taskContext -> do
let contentChanged :: CM ()
@@ -1143,7 +1170,9 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
sentMsgDeliveryEvent conn msgId
checkSndInlineFTComplete conn msgId
updateGroupItemsStatus gInfo m conn msgId GSSSent (Just $ isJust proxy)
when continued $ sendPendingGroupMessages user gInfo m conn
when continued $ do
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)
(gInfo', m', scopeInfo) <- mkGroupChatScope gInfo m
@@ -1195,9 +1224,10 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
CFGetRelayDataJoin -> do
-- Update relay member with key, memberId and profile from link
relayLinkData_ <- liftIO $ decodeLinkUserData cData
case (relayLinkData_, linkEntityId) of
(Just RelayShortLinkData {relayProfile = p}, Just entityId) ->
relayMemberId <- case (relayLinkData_, linkEntityId) of
(Just RelayShortLinkData {relayProfile = p}, Just entityId) -> do
withStore $ \db -> updateRelayMemberData db cxt user m (MemberId entityId) (MemberKey relayKey) p
pure $ MemberId entityId
_ -> throwChatError $ CEException "relay link: no relay link data or entity id"
case cReq of
CRContactUri crData@ConnReqUriData {crClientData} -> do
@@ -1210,13 +1240,9 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
cReqHash = contactCReqHash $ CRContactUri crData {crScheme = SSSimplex}
-- Update connection with data derived from cReq, now available after getConnShortLinkAsync
withStore' $ \db -> updateConnLinkData db user conn cReq cReqHash groupLinkId chatV pqSup
let GroupMember {memberId = membershipMemId} = membership
incognitoProfile = incognitoMembershipProfile gInfo
profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile)
memberPubKey <- case groupKeys gInfo of
Just GroupKeys {memberPrivKey} -> pure $ C.publicKey memberPrivKey
Nothing -> throwChatError $ CEInternalError "no group keys for channel membership"
dm <- encodeConnInfo $ XMember profileToSend membershipMemId (MemberKey memberPubKey)
let incognitoProfile = fromLocalProfile <$> incognitoMembershipProfile gInfo
profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo incognitoProfile
dm <- encodeXMemberConnInfo gInfo relayMemberId profileToSend
subMode <- chatReadVar subscriptionMode
void $ joinAgentConnectionAsync user (Just conn) True cReq dm subMode
CFGetRelayDataAccept -> do
@@ -1226,7 +1252,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
relayProfile <- liftIO (decodeLinkUserData cData) >>= \case
Just RelayShortLinkData {relayProfile = p} -> pure p
Nothing -> throwChatError $ CEException "relay link: no relay link data"
(confId, m', relay) <- withStore $ \db -> do
(confId, m', relay) <- withStore $ \db -> do
confId <- getRelayConfId db m
liftIO $ updateGroupMemberStatus db userId m GSMemAccepted
(m', relay) <- setRelayLinkAccepted db cxt user m (MemberKey relayKey) relayProfile
@@ -1239,7 +1265,9 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
_ -> throwChatError $ CECommandError "unexpected cmdFunction"
QCONT -> do
continued <- continueSending connEntity conn
when continued $ sendPendingGroupMessages user gInfo m conn
when continued $ do
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)
processConnMWARN connEntity conn err
@@ -1312,13 +1340,18 @@ 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
-- cancel only this source's transfer; other relays' in-flight transfers are independent
FTRoster -> do
t_ <- withStore' $ \db -> getRosterTransfer db fileId
forM_ t_ $ \RcvRosterTransfer {rosterTransferId} -> cleanupRosterTransferById rosterTransferId
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 ()
@@ -1329,30 +1362,33 @@ 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 ()
processContactConnMessage agentMsg connEntity conn UserContact {userContactLinkId = uclId, groupId = ucGroupId_} = case agentMsg of
REQ invId pqSupport _ connInfo -> do
ChatMessage {chatVRange, chatMsgEvent} <- parseChatMessage conn connInfo
(signedMsg_, ChatMessage {chatVRange, chatMsgEvent}) <- parseChatMessage' conn connInfo
case chatMsgEvent of
XContact p xContactId_ welcomeMsgId_ requestMsg_ -> profileContactRequest invId chatVRange p xContactId_ welcomeMsgId_ requestMsg_ pqSupport
XMember p joiningMemberId joiningMemberKey -> memberJoinRequestViaRelay invId chatVRange p joiningMemberId joiningMemberKey
XMember p joiningMemberId joiningMemberKey viaRelay -> memberJoinRequestViaRelay invId chatVRange signedMsg_ p joiningMemberId joiningMemberKey viaRelay
XInfo p -> profileContactRequest invId chatVRange p Nothing Nothing Nothing pqSupport
XGrpRelayInv groupRelayInv -> xGrpRelayInv invId chatVRange groupRelayInv
XGrpRelayTest challenge _ -> xGrpRelayTest invId chatVRange challenge
@@ -1364,13 +1400,13 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
CFSetShortLink ->
case (ucGroupId_, auData) of
(Just groupId, UserContactLinkData UserContactData {relays = relayLinks}) -> do
(gInfo, gLink, relays, relaysChanged, newlyActiveLinks) <- withStore $ \db -> do
(gInfo, gLink, relays, relaysChanged, newlyActiveLinks, newlyActiveGMIds) <- withStore $ \db -> do
gInfo <- getGroupInfo db cxt user groupId
gLink <- getGroupLink db user gInfo
relays <- liftIO $ getGroupRelays db gInfo
(relays', changed, newlyActive) <- liftIO $ foldrM (updateRelay db) ([], False, []) relays
(relays', changed, newlyActiveLinks, newlyActiveGMIds) <- liftIO $ foldrM (updateRelay db) ([], False, [], []) relays
liftIO $ setGroupInProgressDone db gInfo
pure (gInfo, gLink, relays', changed, newlyActive)
pure (gInfo, gLink, relays', changed, newlyActiveLinks, newlyActiveGMIds)
toView $ CEvtGroupLinkDataUpdated user gInfo gLink relays relaysChanged
let GroupSummary {publicMemberCount} = groupSummary gInfo
-- Owner is counted in publicMemberCount; > 1 means at least one subscriber.
@@ -1388,14 +1424,16 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
unless (null recipients) $
void $ sendGroupMessages user gInfo Nothing False recipients events
where
updateRelay :: DB.Connection -> GroupRelay -> ([GroupRelay], Bool, [ShortLinkContact]) -> IO ([GroupRelay], Bool, [ShortLinkContact])
updateRelay db relay@GroupRelay {relayLink, relayStatus} (acc, changed, newlyActive) =
updateRelay :: DB.Connection -> GroupRelay -> ([GroupRelay], Bool, [ShortLinkContact], [GroupMemberId]) -> IO ([GroupRelay], Bool, [ShortLinkContact], [GroupMemberId])
updateRelay db relay@GroupRelay {groupMemberId, relayLink, relayStatus} (acc, changed, newlyActiveLinks, newlyActiveGMIds) =
case relayLink of
Just rLink
| rLink `elem` relayLinks && relayStatus == RSAccepted -> do
-- version is gated upstream at publish (getPublishableGroupRelays): an RSAccepted relay
-- whose link is in the published data is necessarily pre-roster, so activate it too
| rLink `elem` relayLinks && (relayStatus == RSAcknowledgedRoster || relayStatus == RSAccepted) -> do
relay' <- updateRelayStatus db relay RSActive
pure (relay' : acc, True, rLink : newlyActive)
| rLink `elem` relayLinks -> pure (relay : acc, changed, newlyActive)
pure (relay' : acc, True, rLink : newlyActiveLinks, groupMemberId : newlyActiveGMIds)
| rLink `elem` relayLinks -> pure (relay : acc, changed, newlyActiveLinks, newlyActiveGMIds)
| relayStatus == RSActive -> do
-- Relay link absent from link data — deactivate.
-- RSAccepted relays are not deactivated: their own link data update
@@ -1404,8 +1442,8 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
-- TODO the SMP server, but this owner won't receive a LINK callback for it
-- TODO (LINK only fires in response to own setConnShortLink calls).
relay' <- updateRelayStatus db relay RSInactive
pure (relay' : acc, True, newlyActive)
_ -> pure (relay : acc, changed, newlyActive)
pure (relay' : acc, True, newlyActiveLinks, newlyActiveGMIds)
_ -> pure (relay : acc, changed, newlyActiveLinks, newlyActiveGMIds)
_ -> throwChatError $ CECommandError "LINK event expected for a group link only"
_ -> throwChatError $ CECommandError "unexpected cmdFunction"
MERR _ err -> do
@@ -1446,12 +1484,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
@@ -1476,13 +1514,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
@@ -1546,7 +1584,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)
@@ -1574,7 +1612,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
messageError "processContactConnMessage: chat version range incompatible for accepting group join request"
| otherwise -> do
let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p xContactId_ Nothing welcomeMsgId_ acceptance useRole profileMode Nothing
mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p xContactId_ Nothing welcomeMsgId_ acceptance useRole profileMode Nothing Nothing
(gInfo', mem', scopeInfo) <- mkGroupChatScope gInfo mem
createInternalChatItem user (CDGroupRcv gInfo' scopeInfo mem') (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
toView $ CEvtAcceptingGroupJoinRequestMember user gInfo' mem'
@@ -1613,19 +1651,37 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
where
User {userChatRelay} = user
-- TODO [relays] owner, relays: TBC how to communicate member rejection rules from owner to relays
-- TODO [relays] relay: TBC communicate rejection when memberId already exists (currently checked in createJoiningMember)
memberJoinRequestViaRelay :: InvitationId -> VersionRangeChat -> Profile -> MemberId -> MemberKey -> CM ()
memberJoinRequestViaRelay invId chatVRange p joiningMemberId joiningMemberKey = do
memberJoinRequestViaRelay :: InvitationId -> VersionRangeChat -> Maybe SignedMsg -> Profile -> MemberId -> MemberKey -> Maybe MemberId -> CM ()
memberJoinRequestViaRelay invId chatVRange signedMsg_ p joiningMemberId joiningMemberKey@(MemberKey joiningKey) viaRelay = do
(_ucl, gLinkInfo_) <- withStore $ \db -> getUserContactLinkById db userId uclId
case gLinkInfo_ of
Just GroupLinkInfo {groupId, memberRole = gLinkMemRole} -> do
gInfo <- withStore $ \db -> getGroupInfo db cxt user groupId
mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p Nothing (Just joiningMemberId) Nothing GAAccepted gLinkMemRole Nothing (Just joiningMemberKey)
existing_ <- withStore' $ \db -> eitherToMaybe <$> runExceptT (getGroupMemberByMemberId db cxt user gInfo joiningMemberId)
case existing_ of
Just rosterMem
-- a privileged memberId's key is owner-authoritative (the roster); the joiner must prove
-- possession of that exact key, otherwise this is an attempt to impersonate it
| isRosterRole (memberRole' rosterMem) ->
if verifyKey gInfo rosterMem
then acceptJoin gInfo (Just rosterMem) (memberRole' rosterMem)
else messageError "memberJoinRequestViaRelay: rejected join claiming privileged memberId (key mismatch or invalid signature)"
_ -> acceptJoin gInfo Nothing gLinkMemRole
Nothing ->
messageError "memberJoinRequestViaRelay: no group link info for relay link"
where
-- replay defense: the viaRelay == own memberId check (viaRelay is in the signed body); without it a sibling relay could replay a privileged member's signed join
verifyKey gInfo rosterMem = case (signedMsg_, groupKeys gInfo) of
(Just SignedMsg {chatBinding = CBGroup, signatures, signedBody}, Just GroupKeys {publicGroupId}) ->
memberPubKey rosterMem == Just joiningKey
&& verifyGroupSig joiningKey publicGroupId joiningMemberId signatures signedBody
&& viaRelay == Just (memberId' (membership gInfo))
_ -> False
acceptJoin gInfo existingMem_ acceptRole = do
mem <- acceptGroupJoinRequestAsync user uclId gInfo invId chatVRange p Nothing (Just joiningMemberId) Nothing GAAccepted acceptRole Nothing (Just joiningMemberKey) existingMem_
(gInfo', mem', scopeInfo) <- mkGroupChatScope gInfo mem
createInternalChatItem user (CDGroupRcv gInfo' scopeInfo mem') (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
toView $ CEvtAcceptingGroupJoinRequestMember user gInfo' mem'
Nothing ->
messageError "memberJoinRequestViaRelay: no group link info for relay link"
muteEventInChannel :: GroupInfo -> GroupMember -> Bool
muteEventInChannel gInfo@GroupInfo {membership} m =
@@ -2157,7 +2213,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'
@@ -2365,7 +2421,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
ChatConfig {fileChunkSize} <- asks config
fInv'@FileInvitation {fileName, fileSize} <- validateFileInvitation fInv
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 ""
@@ -2461,10 +2517,17 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
ft <- withStore $ \db -> getDirectFileIdBySharedMsgId db user ct sharedMsgId >>= getRcvFileTransfer db user
receiveInlineChunk ft chunk meta
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
-- 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 -> GroupMember -> SharedMsgId -> FileChunk -> MsgMeta -> CM ()
bFileChunkGroup gInfo@GroupInfo {groupId} fromMember sharedMsgId chunk meta = do
fileId_ <- withStore' $ \db -> getGroupRcvFileId db userId groupId (groupMemberId' fromMember) 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} _
@@ -2474,7 +2537,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
@@ -2532,7 +2606,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
@@ -2996,40 +3070,63 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
_ -> pure (conn', Nothing)
xGrpMemNew :: GroupInfo -> GroupMember -> MemberInfo -> Maybe MsgScope -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope)
xGrpMemNew gInfo m memInfo@(MemberInfo memId memRole _ _ _) msgScope_ msg brokerTs = do
if useRelays' gInfo && isRelay m
then when (memRole > GRMember) $ throwChatError $ CEException "x.grp.mem.new: relay cannot introduce role above member in channel"
else checkHostRole m memRole
xGrpMemNew gInfo m memInfo@(MemberInfo memId memRole _ _ assertedKey_) msgScope_ msg brokerTs = do
let fromRelay = useRelays' gInfo && isRelay m
unless fromRelay $ checkHostRole m memRole
if sameMemberId memId (membership gInfo)
then pure Nothing
else do
else
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memId) >>= \case
Right unknownMember@GroupMember {memberStatus = GSMemUnknown} -> do
(updatedMember, gInfo') <- withStore $ \db -> do
updatedMember <- updateUnknownMemberAnnounced db cxt user m unknownMember memInfo initialStatus
gInfo' <-
if memberPending updatedMember
then liftIO $ increaseGroupMembersRequireAttention db user gInfo
else pure gInfo
pure (updatedMember, gInfo')
gInfo'' <- updatePublicGroupData user gInfo'
toView $ CEvtUnknownMemberAnnounced user gInfo'' m unknownMember updatedMember
memberAnnouncedToView updatedMember gInfo''
pure $ deliveryJobScope updatedMember
Right unknownMember@GroupMember {memberStatus = GSMemUnknown}
-- roster-established privileged member: the relay may update the profile only,
-- never the role or key (those are owner-authoritative via the roster, and
-- XGrpMemNew is unsigned)
| fromRelay && isRosterRole (memberRole' unknownMember) -> do
-- a member's key is immutable per memberId and identical across relays; mismatch
-- is unambiguous relay misbehavior (role can legitimately differ across relays
-- under multi-relay skew, so we deliberately don't warn on role)
let assertedKey = (\(MemberKey k) -> k) <$> assertedKey_
-- TODO [relays] member: surface relay-key-mismatch as a dedicated event / chat item / relay state
when (assertedKey /= memberPubKey unknownMember) $
messageWarning $ "x.grp.mem.new: relay asserted key differs from roster-established key, keeping roster key, memberId=" <> safeDecodeUtf8 (strEncode memId)
updatedMember <- withStore $ \db -> updateRosterMemberAnnounced db cxt user m unknownMember memInfo initialStatus
-- roster members can't be pending, so no members-require-attention update
gInfo' <- updatePublicGroupData user gInfo
toView $ CEvtUnknownMemberAnnounced user gInfo' m unknownMember updatedMember
memberAnnouncedToView updatedMember gInfo'
pure $ deliveryJobScope updatedMember
-- asserted privileged but NOT roster-established: relay conjuring a moderator
| fromRelay && isRosterRole memRole ->
messageError "x.grp.mem.new: privileged role not established by roster" $> Nothing
| otherwise -> do
(updatedMember, gInfo') <- withStore $ \db -> do
updatedMember <- updateUnknownMemberAnnounced db cxt user m unknownMember memInfo initialStatus
gInfo' <-
if memberPending updatedMember
then liftIO $ increaseGroupMembersRequireAttention db user gInfo
else pure gInfo
pure (updatedMember, gInfo')
gInfo'' <- updatePublicGroupData user gInfo'
toView $ CEvtUnknownMemberAnnounced user gInfo'' m unknownMember updatedMember
memberAnnouncedToView updatedMember gInfo''
pure $ deliveryJobScope updatedMember
Right _
| useRelays' gInfo -> logInfo "x.grp.mem.new: member already created via another relay" $> Nothing
| otherwise -> messageError "x.grp.mem.new error: member already exists" $> Nothing
Left _ -> do
(newMember, gInfo') <- withStore $ \db -> do
newMember <- createNewGroupMember db cxt user gInfo m memInfo GCPostMember initialStatus
gInfo' <-
if memberPending newMember
then liftIO $ increaseGroupMembersRequireAttention db user gInfo
else pure gInfo
pure (newMember, gInfo')
gInfo'' <- updatePublicGroupData user gInfo'
memberAnnouncedToView newMember gInfo''
pure $ deliveryJobScope newMember
Left _
-- a privileged member absent from the roster is a relay conjuring a moderator
| fromRelay && isRosterRole memRole -> messageError "x.grp.mem.new: privileged member not established by roster" $> Nothing
| otherwise -> do
(newMember, gInfo') <- withStore $ \db -> do
newMember <- createNewGroupMember db cxt user gInfo m memInfo GCPostMember initialStatus
gInfo' <-
if memberPending newMember
then liftIO $ increaseGroupMembersRequireAttention db user gInfo
else pure gInfo
pure (newMember, gInfo')
gInfo'' <- updatePublicGroupData user gInfo'
memberAnnouncedToView newMember gInfo''
pure $ deliveryJobScope newMember
where
initialStatus = case msgScope_ of
Just (MSMember _) -> GSMemPendingReview
@@ -3068,10 +3165,12 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
messageError "x.grp.mem.intro ignored: member already exists"
Left _
| useRelays' gInfo -> do
-- owner key must only come from link data, not from relay intro
-- 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 == GROwner -> MemberInfo mId mRole v p Nothing
| mRole >= GRMember -> MemberInfo mId defaultRole v p Nothing
_ -> memInfo
void $ withStore $ \db -> createIntroReMember db cxt user gInfo memInfo' memRestrictions
| otherwise -> do
@@ -3141,28 +3240,241 @@ 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.
-- Only an owner sender may advance it: a non-owner signed event is rejected by the action that follows,
-- but must not bump roster_version first, or every later owner roster at a lower version is dropped.
applyAtRosterVersion :: GroupInfo -> GroupMember -> Maybe VersionRoster -> CM (Maybe DeliveryJobScope) -> CM (Maybe DeliveryJobScope)
applyAtRosterVersion gInfo sender rosterVer_ action
| not (useRelays' gInfo) = action
| otherwise = case rosterVer_ of
Nothing -> action
Just _ | memberRole' sender /= GROwner -> 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
Left _ -> messageError "x.grp.mem.role with unknown member ID" $> Nothing
applyAtRosterVersion gInfo m rosterVer_ $
let gInfo' = gInfo {membership = membership {memberRole = memRole}}
in changeMemberRole gInfo' membership False (\db -> updateGroupMemberRole db user membership memRole) $ RGEUserRole memRole
| otherwise = applyAtRosterVersion gInfo m 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 created (\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 created (\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} created applyMember gEvent
| senderRole < maximum ([GRAdmin, fromRole, memRole] :: [GroupMemberRole]) =
messageError "x.grp.mem.role with insufficient member permissions" $> Nothing
| useRelays' gInfo && (isRosterRole memRole || isRosterRole fromRole) && senderRole /= GROwner =
messageError "x.grp.mem.role: only the owner can change member, moderator and admin roles in relay groups" $> Nothing
-- a forwarded role event the roster already applied is a no-op; suppress it.
-- a just-created member is keyless here, so fall through to pin its owner-attested key.
| useRelays' gInfo && not created && 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
-- 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.
-- fromMember is the relay that delivered THIS roster copy (the owner on a relay receiving directly,
-- a relay on a member receiving a forward); author is the owner who signed it.
xGrpRoster :: GroupInfo -> GroupMember -> GroupMember -> GroupRoster -> VerifiedMsg e -> Maybe SharedMsgId -> UTCTime -> CM (Maybe DeliveryJobScope)
xGrpRoster gInfo fromMember 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
| 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
-- per-source pending version (THIS relay's own in-flight transfer), not a single group slot
pendingVer_ <- withStore' $ \db -> getRosterTransferVersion db gInfo (groupMemberId' fromMember)
-- accept a version not below BOTH applied and this source's 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 `notBelowRoster` rosterVersion gInfo && newVer `notBelowRoster` pendingVer_
then startRosterTransfer sm sharedMsgId
else pure Nothing
where
startRosterTransfer sm sharedMsgId = do
-- supersede THIS source's own in-flight transfer (older version or a restart); other relays' transfers are independent
cleanupRosterTransfer gInfo (groupMemberId' fromMember)
let relayHdr = if isUserGrpFwdRelay gInfo then Just sm else Nothing
chSize <- asks $ fileChunkSize . config
let rosterFInv = FileInvitation {fileName = "roster", fileSize, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Just IFMSent, fileDescr = Nothing}
-- transfer record + its scratch file in one transaction (file owned by the transfer, keyed per source)
rft@RcvFileTransfer {fileId} <- withStore $ \db -> do
transferId <- liftIO $ createRosterTransfer db gInfo (groupMemberId' fromMember) newVer fileDigest (groupMemberId' author) brokerTs relayHdr
createRosterRcvFile db userId gInfo fromMember transferId 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 <> "_" <> show (groupMemberId' fromMember) <> "_" <> 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.
notBelowRoster :: VersionRoster -> Maybe VersionRoster -> Bool
notBelowRoster 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 {fileId, fileStatus} =
withStore' (\db -> getRosterTransfer db fileId) >>= \case
-- defensive: the file always has its transfer (created together, deleted together)
Nothing -> lift (closeFileHandle fileId rcvFiles) >> forM_ (rosterFilePath fileStatus) removeFsFile
Just RcvRosterTransfer {rosterTransferId = transferId, rosterTransferVersion = pendingVer, rosterTransferDigest = pendingDigest, rosterTransferOwnerGMId = ownerGMId, rosterTransferBrokerTs = rosterBrokerTs, rosterTransferHeader = header_} -> do
owner_ <- withStore' $ \db -> eitherToMaybe <$> runExceptT (getGroupMemberById db cxt user ownerGMId)
blob <- readAssembledRoster
let isRelay = isUserGrpFwdRelay gInfo
ackErr err = do
cleanupRosterTransferById transferId
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 -> cleanupRosterTransferById transferId
Just author -> do
defaultRole <- unknownMemberRole gInfo
-- gate against the persisted roster_version inside the apply transaction: a roster from another
-- relay (or a preceding signed event) may already have advanced it past this one; a stale
-- completion (e.g. relay1 sent v5 then v6, relay2's v5 completes after v6) 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 $ setGroupLiveRoster db gInfo pendingVer ownerGMId rosterBrokerTs header_ blob
pure (Just res)
cleanupRosterTransferById transferId
forM_ results_ $ \results -> do
emitRosterResults gInfo author rosterBrokerTs results
-- ack while setting up (own status accepted/acknowledged); a serving (active) relay must not ack broadcasts.
when (isRelay && (relayOwnStatus gInfo == Just RSAccepted || relayOwnStatus gInfo == Just RSAcknowledgedRoster)) $ do
sendRosterAck gInfo author pendingVer Nothing
withStore' $ \db -> void $ updateRelayOwnStatusFromTo db gInfo RSAccepted RSAcknowledgedRoster
where
rosterFilePath = \case
RFSAccepted p -> Just p
RFSConnected p -> Just p
RFSComplete p -> Just p
_ -> Nothing
readAssembledRoster = case rosterFilePath fileStatus of
Just fp -> readAt fp
Nothing -> 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
createItems member fromRole = do
let toRole = memberRole' member
gEvent = RGEMemberRole (groupMemberId' member) (fromLocalProfile $ memberProfile member) toRole
(gInfo', author', scopeInfo) <- mkGroupChatScope gInfo author
ci <- createChatItem user (CDGroupRcv gInfo' scopeInfo author') False (CIRcvGroupEvent gEvent) Nothing (Just MSSVerified) (Just rosterBrokerTs)
toView $ CEvtNewChatItems user [ci]
toView CEvtMemberRole {user, groupInfo = gInfo', byMember = author', member, fromRole, toRole, msgSigned = Just MSSVerified}
sendRosterAck :: GroupInfo -> GroupMember -> VersionRoster -> Maybe Text -> CM ()
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
relay_ <- withStore' $ \db -> eitherToMaybe <$> runExceptT (getGroupRelayByGMId db (groupMemberId' m))
case relay_ of
Just relay@GroupRelay {relayStatus = RSAccepted} -> case err of
Nothing
| rosterVersion gInfo == Just ackVer -> do
(relay', gLink) <- withStore $ \db -> do
relay' <- liftIO $ updateRelayStatus db relay RSAcknowledgedRoster
gLink <- getGroupLink db user gInfo
pure (relay', gLink)
setGroupLinkDataAsync user gInfo gLink
toView $ CEvtGroupRelayUpdated user gInfo m relay'
| otherwise -> messageWarning "x.grp.roster.ack: stale version, awaiting ack for the current roster"
Just e -> do
relay' <- withStore' $ \db -> updateRelayStatusFromTo db relay RSAccepted RSRejected
toView $ CEvtGroupRelayUpdated user gInfo m relay'
messageError $ "x.grp.roster.ack: relay could not save roster, marked rejected: " <> e
_ -> pure ()
checkHostRole :: GroupMember -> GroupMemberRole -> CM ()
checkHostRole GroupMember {memberRole, localDisplayName} memRole =
when (memberRole < GRAdmin || memberRole < memRole) $ throwChatError (CEGroupContactRole localDisplayName)
@@ -3207,11 +3519,11 @@ 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
then applyAtRosterVersion gInfo m rosterVer_ $ checkRole membership $ do
deleteGroupLinkIfExists user gInfo
-- TODO [relays] possible improvement is to immediately delete rcv queues if isUserGrpFwdRelay
unless (isUserGrpFwdRelay gInfo) $ deleteGroupConnections user gInfo False
@@ -3223,7 +3535,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 m rosterVer_ $
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memId) >>= \case
Left _ -> do
messageError "x.grp.mem.del with unknown member ID"
@@ -3474,7 +3786,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
@@ -3489,13 +3801,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 m 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 ()
@@ -3515,12 +3828,12 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
Just sm@SignedMsg {chatBinding, signatures, signedBody}
| GroupMember {memberPubKey = Just pubKey, memberId} <- member ->
case chatBinding of
CBGroup ->
let prefix = smpEncode chatBinding <> bindingData
bindingData = case groupKeys gInfo of
Just GroupKeys {publicGroupId} -> smpEncode (publicGroupId, memberId)
Nothing -> smpEncode (memberId, pubKey) -- forward compatibility for verifying signed messages in p2p groups
in signed MSSVerified <$ guard (all (\(MsgSignature KRMember sig) -> C.verify (C.APublicVerifyKey C.SEd25519 pubKey) sig (prefix <> signedBody)) signatures)
CBGroup
| Just GroupKeys {publicGroupId} <- groupKeys gInfo ->
signed MSSVerified <$ guard (verifyGroupSig pubKey publicGroupId memberId signatures signedBody)
| otherwise ->
let prefix = smpEncode chatBinding <> smpEncode (memberId, pubKey) -- forward compatibility for verifying signed messages in p2p groups
in signed MSSVerified <$ guard (all (\case (MsgSignature KRMember sig) -> C.verify (C.APublicVerifyKey C.SEd25519 pubKey) sig (prefix <> signedBody)) signatures)
_ -> signed MSSSignedNoKey <$ guard signatureOptional
| otherwise -> signed MSSSignedNoKey <$ guard (signatureOptional || unverifiedAllowed membership member tag)
where
@@ -3782,10 +4095,15 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
bucketSize <- asks $ deliveryBucketSize . config
senders <- withStore' $ \db ->
fmap catMaybes . forM senderGMIds $ \sId ->
fmap eitherToMaybe . runExceptT $ do
fmap (join . eitherToMaybe) . runExceptT $ do
sender <- getNonRemovedMemberById db cxt user sId
vec <- getMemberRelationsVector db sender
pure (sender, vec)
-- owners are already known to every member (group link + owner-intro in introduceInChannel),
-- so we never disseminate their profile (redundant, and races with joins re-announcing the owner)
if memberRole' sender == GROwner
then pure Nothing
else do
vec <- getMemberRelationsVector db sender
pure $ Just (sender, vec)
let missingSenders = length senderGMIds - length senders
when (missingSenders > 0) $
logInfo $ "delivery job " <> tshow jobId <> ": " <> tshow missingSenders <> " senders missing; skipping their profile prepend"
@@ -3795,13 +4113,8 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
if null senders
then pure (body, [], [], [])
else do
-- Skip role > GRMember (mirrors xGrpMemNew gate).
-- TODO [relays] public groups: revisit if mods/admins are introduced via this sidecar.
let (encoderErrs, validLabeled) =
partitionEithers
[ (\bs -> (s, bs)) <$> encodeMemberNew (vr cxt) gInfo s
| (s, _) <- senders, memberRole' s <= GRMember
]
-- all members' profiles disseminate; privileged key/role come from the roster, not here
let (encoderErrs, validLabeled) = partitionEithers [(\bs -> (s, bs)) <$> encodeMemberNew (vr cxt) gInfo s | (s, _) <- senders]
(extBody', inBody, overflowLabeled, large1) = batchProfilesWithBody maxEncodedMsgLength body validLabeled
(overflowBatches', large2) = batchProfiles maxEncodedMsgLength overflowLabeled
packerErrs = [ChatError (CEInternalError $ "oversized profile element for member " <> show (groupMemberId' s)) | s <- large1 <> large2]
src/Simplex/Chat/Protocol.hs
+94 -12
View File
@@ -48,13 +48,14 @@ 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.Badges (LocalBadge)
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)
@@ -84,12 +85,13 @@ import Simplex.Messaging.Version hiding (version)
-- 16 - support short link data (2025-06-10)
-- 17 - allow host voice messages during member approval regardless of group voice setting (2026-02-10)
-- 18 - relay web capabilities (2026-05-31)
-- 19 - group roster (2026-06-18)
-- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig.
-- This indirection is needed for backward/forward compatibility testing.
-- Testing with real app versions is still needed, as tests use the current code with different version ranges, not the old code.
currentChatVersion :: VersionChat
currentChatVersion = VersionChat 18
currentChatVersion = VersionChat 19
-- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above)
supportedChatVRange :: VersionRangeChat
@@ -160,6 +162,11 @@ memberSupportVoiceVersion = VersionChat 17
relayWebCapVersion :: VersionChat
relayWebCapVersion = VersionChat 18
-- owner-signed roster (promoted members/moderators/admins) and the relay roster-ack handshake;
-- a relay below this version is published without the handshake (it can't ack a roster)
groupRosterVersion :: VersionChat
groupRosterVersion = VersionChat 19
agentToChatVersion :: VersionSMPA -> VersionChat
agentToChatVersion v
| v < pqdrSMPAgentVersion = initialChatVersion
@@ -373,6 +380,36 @@ data GrpMsgForward = GrpMsgForward
}
deriving (Eq, Show)
-- | 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,
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,
key :: MemberKey, -- trust-on-first-use pinned per memberId
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
@@ -439,6 +476,11 @@ data MsgSigning = MsgSigning
encodeChatBinding :: ChatBinding -> ByteString -> ByteString
encodeChatBinding cb bindingData = smpEncode cb <> bindingData
signChatMsgBody :: MsgSigning -> ByteString -> SignedMsg
signChatMsgBody MsgSigning {bindingTag, bindingData, keyRef, privKey} msgBody =
let sig = C.ASignature C.SEd25519 $ C.sign' privKey (encodeChatBinding bindingTag bindingData <> msgBody)
in SignedMsg {chatBinding = bindingTag, signatures = MsgSignature keyRef sig L.:| [], signedBody = msgBody}
data ChatMsgEvent (e :: MsgEncoding) where
XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
XMsgFileDescr :: {msgId :: SharedMsgId, fileDescr :: FileDescr} -> ChatMsgEvent 'Json
@@ -452,7 +494,7 @@ data ChatMsgEvent (e :: MsgEncoding) where
XFileCancel :: SharedMsgId -> ChatMsgEvent 'Json
XInfo :: Profile -> ChatMsgEvent 'Json
XContact :: {profile :: Profile, contactReqId :: Maybe XContactId, welcomeMsgId :: Maybe SharedMsgId, requestMsg :: Maybe (SharedMsgId, MsgContent)} -> ChatMsgEvent 'Json
XMember :: {profile :: Profile, newMemberId :: MemberId, newMemberKey :: MemberKey} -> ChatMsgEvent 'Json
XMember :: {profile :: Profile, newMemberId :: MemberId, newMemberKey :: MemberKey, viaRelay :: Maybe MemberId} -> ChatMsgEvent 'Json
XDirectDel :: ChatMsgEvent 'Json
XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json
XGrpAcpt :: MemberId -> ChatMsgEvent 'Json
@@ -471,16 +513,18 @@ 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
XGrpPrefs :: GroupPreferences -> ChatMsgEvent 'Json
XGrpDirectInv :: ConnReqInvitation -> Maybe MsgContent -> Maybe MsgScope -> ChatMsgEvent 'Json
XGrpRoster :: GroupRoster -> ChatMsgEvent 'Json
XGrpRosterAck :: VersionRoster -> Maybe Text -> ChatMsgEvent 'Json
XGrpMsgForward :: GrpMsgForward -> ChatMessage 'Json -> ChatMsgEvent 'Json
XInfoProbe :: Probe -> ChatMsgEvent 'Json
XInfoProbeCheck :: ProbeHash -> ChatMsgEvent 'Json
@@ -524,6 +568,7 @@ isForwardedGroupMsg ev = case ev of
XGrpDel -> True
XGrpInfo _ -> True
XGrpPrefs _ -> True
XGrpRoster _ -> True
_ -> False
data MsgReaction = MREmoji {emoji :: MREmojiChar} | MRUnknown {tag :: Text, json :: J.Object}
@@ -792,6 +837,8 @@ data MsgMention = MsgMention {memberId :: MemberId}
newtype MsgMentions = MsgMentions (Map MemberName MsgMention)
deriving (Eq, Show)
$(JQ.deriveJSON defaultJSON ''InlineFileInvitation)
$(JQ.deriveJSON (taggedObjectJSON $ dropPrefix "MCL") ''MsgChatLink)
$(JQ.deriveJSON defaultJSON ''LinkOwnerSig)
@@ -892,6 +939,28 @@ maxCompressedMsgLength = 13380
maxDecompressedMsgLength :: Int
maxDecompressedMsgLength = 65536
-- Defensive entry-count bound for the roster blob parser (rosterBlobP) and the
-- promotion cap over the promoted (member/moderator/admin) set.
maxGroupRosterSize :: Int
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
maxEncodedInfoLength :: Int
@@ -1028,6 +1097,8 @@ data CMEventTag (e :: MsgEncoding) where
XGrpInfo_ :: CMEventTag 'Json
XGrpPrefs_ :: CMEventTag 'Json
XGrpDirectInv_ :: CMEventTag 'Json
XGrpRoster_ :: CMEventTag 'Json
XGrpRosterAck_ :: CMEventTag 'Json
XGrpMsgForward_ :: CMEventTag 'Json
XInfoProbe_ :: CMEventTag 'Json
XInfoProbeCheck_ :: CMEventTag 'Json
@@ -1088,6 +1159,8 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
XGrpInfo_ -> "x.grp.info"
XGrpPrefs_ -> "x.grp.prefs"
XGrpDirectInv_ -> "x.grp.direct.inv"
XGrpRoster_ -> "x.grp.roster"
XGrpRosterAck_ -> "x.grp.roster.ack"
XGrpMsgForward_ -> "x.grp.msg.forward"
XInfoProbe_ -> "x.info.probe"
XInfoProbeCheck_ -> "x.info.probe.check"
@@ -1149,6 +1222,8 @@ instance StrEncoding ACMEventTag where
"x.grp.info" -> XGrpInfo_
"x.grp.prefs" -> XGrpPrefs_
"x.grp.direct.inv" -> XGrpDirectInv_
"x.grp.roster" -> XGrpRoster_
"x.grp.roster.ack" -> XGrpRosterAck_
"x.grp.msg.forward" -> XGrpMsgForward_
"x.info.probe" -> XInfoProbe_
"x.info.probe.check" -> XInfoProbeCheck_
@@ -1196,7 +1271,7 @@ toCMEventTag msg = case msg of
XGrpMemInv _ _ -> XGrpMemInv_
XGrpMemFwd _ _ -> XGrpMemFwd_
XGrpMemInfo _ _ -> XGrpMemInfo_
XGrpMemRole _ _ -> XGrpMemRole_
XGrpMemRole {} -> XGrpMemRole_
XGrpMemRestrict _ _ -> XGrpMemRestrict_
XGrpMemCon _ -> XGrpMemCon_
XGrpMemConAll _ -> XGrpMemConAll_
@@ -1206,6 +1281,8 @@ toCMEventTag msg = case msg of
XGrpInfo _ -> XGrpInfo_
XGrpPrefs _ -> XGrpPrefs_
XGrpDirectInv {} -> XGrpDirectInv_
XGrpRoster _ -> XGrpRoster_
XGrpRosterAck {} -> XGrpRosterAck_
XGrpMsgForward {} -> XGrpMsgForward_
XInfoProbe _ -> XInfoProbe_
XInfoProbeCheck _ -> XInfoProbeCheck_
@@ -1264,6 +1341,7 @@ requiresSignature = \case
XGrpMemRestrict_ -> True
XGrpLeave_ -> True
XGrpRelayNew_ -> True
XGrpRoster_ -> True
XInfo_ -> True
_ -> False
@@ -1332,7 +1410,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
reqContent <- opt "content"
let requestMsg = (,) <$> reqMsgId <*> reqContent
pure XContact {profile, contactReqId, welcomeMsgId, requestMsg}
XMember_ -> XMember <$> p "profile" <*> p "newMemberId" <*> p "newMemberKey"
XMember_ -> XMember <$> p "profile" <*> p "newMemberId" <*> p "newMemberKey" <*> opt "viaRelay"
XDirectDel_ -> pure XDirectDel
XGrpInv_ -> XGrpInv <$> p "groupInvitation"
XGrpAcpt_ -> XGrpAcpt <$> p "memberId"
@@ -1354,16 +1432,18 @@ 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 "fileInv")
XGrpRosterAck_ -> XGrpRosterAck <$> p "version" <*> opt "error"
XGrpMsgForward_ -> do
fwdSender <- opt "memberId" >>= \case
Just memberId -> FwdMember memberId . fromMaybe "" <$> opt "memberName"
@@ -1405,7 +1485,7 @@ chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case en
XFileCancel sharedMsgId -> o ["msgId" .= sharedMsgId]
XInfo profile -> o ["profile" .= profile]
XContact {profile, contactReqId, welcomeMsgId, requestMsg} -> o $ ("contactReqId" .=? contactReqId) $ ("welcomeMsgId" .=? welcomeMsgId) $ ("msgId" .=? (fst <$> requestMsg)) $ ("content" .=? (snd <$> requestMsg)) $ ["profile" .= profile]
XMember {profile, newMemberId, newMemberKey} -> o ["profile" .= profile, "newMemberId" .= newMemberId, "newMemberKey" .= newMemberKey]
XMember {profile, newMemberId, newMemberKey, viaRelay} -> o $ ("viaRelay" .=? viaRelay) ["profile" .= profile, "newMemberId" .= newMemberId, "newMemberKey" .= newMemberKey]
XDirectDel -> JM.empty
XGrpInv groupInv -> o ["groupInvitation" .= groupInv]
XGrpAcpt memId -> o ["memberId" .= memId]
@@ -1426,16 +1506,18 @@ 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, 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
encodeFwdSender = \case
src/Simplex/Chat/Store/Connections.hs
+1 -1
View File
@@ -149,7 +149,7 @@ getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.use_relays, g.relay_own_status,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.roster_version, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.root_priv_key, g.root_pub_key, g.member_priv_key,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.index_in_group, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
src/Simplex/Chat/Store/Files.hs
+103 -11
View File
@@ -31,12 +31,19 @@ module Simplex.Chat.Store.Files
getSharedMsgIdByFileId,
getFileIdBySharedMsgId,
getGroupFileIdBySharedMsgId,
getGroupRcvFileId,
getGroupRosterFileInfo,
deleteGroupRosterFile,
getRosterTransferFile,
deleteRosterTransferFile,
getRcvFileLastChunkNo,
getDirectFileIdBySharedMsgId,
getChatRefByFileId,
lookupChatRefByFileId,
updateSndFileStatus,
createRcvFileTransfer,
createRcvGroupFileTransfer,
createRosterRcvFile,
createRcvStandaloneFileTransfer,
appendRcvFD,
getRcvFileDescrByRcvFileId,
@@ -321,6 +328,64 @@ getGroupFileIdBySharedMsgId db userId groupId sharedMsgId =
|]
(userId, groupId, sharedMsgId)
-- Resolve the in-flight received group inline file for a chunk: read its file_type by shared_msg_id
-- (LIMIT 1 is safe -- all files sharing a shared_msg_id share a type), then look up by type: a roster
-- file is scoped to its source relay (every relay re-serves the owner's same shared_msg_id, so the source
-- disambiguates), a normal file is by shared_msg_id. Nothing => no in-flight transfer (orphaned chunk).
getGroupRcvFileId :: DB.Connection -> UserId -> Int64 -> GroupMemberId -> SharedMsgId -> IO (Maybe Int64)
getGroupRcvFileId db userId groupId fromMemberId sharedMsgId = do
fileType_ <- getFileType
case fileType_ of
Just FTRoster ->
maybeFirstRow fromOnly $
DB.query db (rcvFileIdQ <> " AND r.group_member_id = ?") (userId, groupId, sharedMsgId, FTRoster, fromMemberId)
Just FTNormal ->
maybeFirstRow fromOnly $
DB.query db rcvFileIdQ (userId, groupId, sharedMsgId, FTNormal)
Nothing -> pure Nothing
where
getFileType =
maybeFirstRow fromOnly $
DB.query db "SELECT file_type FROM files WHERE user_id = ? AND group_id = ? AND shared_msg_id = ? LIMIT 1" (userId, groupId, sharedMsgId)
rcvFileIdQ =
[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 = ? AND f.file_type = ?
|]
-- The roster scratch file for a transfer (for fs/handle cleanup before deleting the transfer).
-- A transfer owns exactly one file (created together in one transaction), so this is single-valued.
getRosterTransferFile :: DB.Connection -> Int64 -> IO (Maybe (Int64, Maybe FilePath))
getRosterTransferFile db transferId =
maybeFirstRow id $ DB.query db "SELECT file_id, file_path FROM files WHERE roster_transfer_id = ?" (Only transferId)
-- Deletes a transfer's file row; rcv_files and rcv_file_chunks cascade on the FK.
deleteRosterTransferFile :: DB.Connection -> Int64 -> IO ()
deleteRosterTransferFile db transferId =
DB.execute db "DELETE FROM files WHERE roster_transfer_id = ?" (Only transferId)
-- 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) $
@@ -379,10 +444,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_
@@ -394,15 +459,34 @@ 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}
-- Roster scratch file owned by a per-source transfer: group_member_id is the delivering relay (so chunk
-- streams from different relays are distinct files), roster_transfer_id links to the metadata record.
createRosterRcvFile :: DB.Connection -> UserId -> GroupInfo -> GroupMember -> Int64 -> SharedMsgId -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer
createRosterRcvFile db userId GroupInfo {groupId} src@GroupMember {localDisplayName = senderName} transferId sharedMsgId f@FileInvitation {fileName, fileSize, fileConnReq, fileInline} rcvFileInline chunkSize = do
currentTs <- liftIO getCurrentTime
let grpMemberId_ = groupMemberId' src
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, file_type, shared_msg_id, roster_transfer_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)"
((userId, groupId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, FPSMP, FTRoster) :. (sharedMsgId, transferId, 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, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
(fileId, FSNew, fileConnReq, fileInline, rcvFileInline, grpMemberId_, currentTs, currentTs)
pure RcvFileTransfer {fileId, xftpRcvFile = Nothing, fileInvitation = f, fileStatus = RFSNew, fileType = FTRoster, rcvFileInline, senderDisplayName = senderName, chunkSize, cancelled = False, grpMemberId = Just grpMemberId_, cryptoArgs = Nothing}
createRcvStandaloneFileTransfer :: DB.Connection -> UserId -> CryptoFile -> Int64 -> Word32 -> ExceptT StoreError IO Int64
createRcvStandaloneFileTransfer db userId (CryptoFile filePath cfArgs_) fileSize chunkSize = do
@@ -548,7 +632,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
@@ -562,9 +646,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 ->
@@ -582,7 +666,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
@@ -678,7 +762,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
src/Simplex/Chat/Store/Groups.hs
+258 -30
View File
@@ -67,6 +67,9 @@ module Simplex.Chat.Store.Groups
getGroupMembersByIndexes,
getSupportScopeMembersByIndexes,
getGroupModerators,
getGroupRosterMembers,
getGroupAdminsMods,
getGroupOnlyMembers,
getGroupOwners,
getGroupRelayMembers,
getGroupMembersForExpiration,
@@ -84,7 +87,19 @@ module Simplex.Chat.Store.Groups
getGroupRelayById,
getGroupRelayByGMId,
getGroupRelays,
getConnectedGroupRelays,
getPublishableGroupRelays,
setGroupRosterVersion,
getGroupRosterVersion,
getGroupRoster,
RcvRosterTransfer (..),
createRosterTransfer,
getRosterTransferVersion,
getRosterTransferId,
getRosterTransfer,
setGroupLiveRoster,
deleteRosterTransfer,
deleteGroupRosterTransfers,
setGroupMemberKeyRole,
createRelayForOwner,
getCreateRelayForMember,
createRelayConnection,
@@ -173,6 +188,7 @@ module Simplex.Chat.Store.Groups
createLinkOwnerMember,
updatePreparedChannelMember,
updateUnknownMemberAnnounced,
updateRosterMemberAnnounced,
updateUserMemberProfileSentAt,
setGroupCustomData,
setGroupUIThemes,
@@ -216,6 +232,8 @@ 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)
import qualified Simplex.Messaging.Agent.Store.DB as DB
@@ -359,6 +377,7 @@ createNewGroup db cxt user@User {userId} groupProfile incognitoProfile useRelays
Just PublicGroupProfile {groupType, groupLink, publicGroupId} -> (Just groupType, Just groupLink, Just publicGroupId)
Nothing -> (Nothing, Nothing, Nothing)
fullGroupPreferences = mergeGroupPreferences groupPreferences
rosterVersion0 = if useRelays then Just (VersionRoster 0) else Nothing
currentTs <- getCurrentTime
customUserProfileId <- mapM (createIncognitoProfile_ db userId currentTs) incognitoProfile
withLocalDisplayName db userId displayName $ \ldn -> runExceptT $ do
@@ -389,11 +408,11 @@ createNewGroup db cxt user@User {userId} groupProfile incognitoProfile useRelays
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 (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (BI useRelays, BI useRelays, ldn, userId, profileId, BI True, currentTs, currentTs, currentTs, currentTs)
:. (rootPrivKey_, rootPubKey_, memberPrivKey_, publicMemberCount_)
:. (rootPrivKey_, rootPubKey_, memberPrivKey_, publicMemberCount_, rosterVersion0)
)
insertedRowId db
let memberPubKey = C.publicKey . memberPrivKey <$> groupKeys
@@ -420,6 +439,7 @@ createNewGroup db cxt user@User {userId} groupProfile incognitoProfile useRelays
chatItemTTL = Nothing,
uiThemes = Nothing,
groupSummary = GroupSummary {currentMembers = 1, publicMemberCount = publicMemberCount_},
rosterVersion = rosterVersion0,
customData = Nothing,
membersRequireAttention = 0,
viaGroupLinkUri = Nothing,
@@ -497,6 +517,7 @@ createGroupInvitation db cxt user@User {userId} contact@Contact {contactId, acti
chatItemTTL = Nothing,
uiThemes = Nothing,
groupSummary = GroupSummary {currentMembers = 2, publicMemberCount = Nothing},
rosterVersion = Nothing,
customData = Nothing,
membersRequireAttention = 0,
viaGroupLinkUri = Nothing,
@@ -1215,10 +1236,42 @@ 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)
-- 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
currentTs <- getCurrentTime
filter memberCurrent . map (toContactMember currentTs 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
currentTs <- getCurrentTime
filter memberCurrent . map (toContactMember currentTs 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
currentTs <- getCurrentTime
filter memberCurrent . map (toContactMember currentTs 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
ts <- getCurrentTime
map (toContactMember ts cxt user)
currentTs <- getCurrentTime
filter memberCurrent . map (toContactMember currentTs 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 = ?")
@@ -1373,21 +1426,30 @@ getGroupRelays db GroupInfo {groupId} =
(groupRelayQuery <> " WHERE gr.group_id = ?")
(Only groupId)
getConnectedGroupRelays :: DB.Connection -> GroupInfo -> IO [GroupRelay]
getConnectedGroupRelays db GroupInfo {groupId} =
map toGroupRelay
<$> DB.query
db
( groupRelayQuery
<> " "
<> [sql|
JOIN group_members m ON m.group_member_id = gr.group_member_id
WHERE gr.group_id = ?
AND m.member_status = ?
AND gr.relay_status IN (?,?)
|]
)
(groupId, GSMemConnected, RSAccepted, RSActive)
-- Relays whose link is published to subscribers: acked relays (RSAcknowledgedRoster/RSActive) plus
-- pre-roster relays at RSAccepted (below groupRosterVersion, they can't ack a roster), gated by the
-- relay's negotiated version read from its member connection.
getPublishableGroupRelays :: DB.Connection -> StoreCxt -> User -> GroupInfo -> IO [GroupRelay]
getPublishableGroupRelays db cxt user gInfo@GroupInfo {groupId} = do
relays <-
map toGroupRelay
<$> DB.query
db
( groupRelayQuery
<> " "
<> [sql|
JOIN group_members m ON m.group_member_id = gr.group_member_id
WHERE gr.group_id = ?
AND m.member_status = ?
AND gr.relay_status IN (?,?,?)
|]
)
(groupId, GSMemConnected, RSAccepted, RSAcknowledgedRoster, RSActive)
members <- getGroupRelayMembers db cxt user gInfo
pure [gr | gr@GroupRelay {groupMemberId} <- relays, m <- members, groupMemberId' m == groupMemberId, publishable gr m]
where
publishable GroupRelay {relayStatus} m =
relayStatus /= RSAccepted || not (m `supportsVersion` groupRosterVersion)
groupRelayQuery :: Query
groupRelayQuery =
@@ -1405,6 +1467,149 @@ toGroupRelay ((groupRelayId, groupMemberId, chatRelayId, address, displayName, f
relayCap = RelayCapabilities {webDomain}
in GroupRelay {groupRelayId, groupMemberId, userChatRelay, relayStatus, relayLink, relayCap}
setGroupRosterVersion :: DB.Connection -> GroupInfo -> VersionRoster -> IO ()
setGroupRosterVersion db GroupInfo {groupId} v = do
currentTs <- getCurrentTime
DB.execute db "UPDATE groups SET roster_version = ?, updated_at = ? WHERE group_id = ?" (v, 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)
-- 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, roster_blob FROM groups WHERE group_id = ?"
(Only groupId)
)
where
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
-- A per-source in-flight roster transfer, keyed (group_id, from_member_id): replaces the single
-- roster_pending_* slot, so two relays serving one member can't share a chunk stream. The signed-header
-- columns are relay-only (NULL on members), promoted to the live roster_msg_* on groups at completion.
createRosterTransfer :: DB.Connection -> GroupInfo -> GroupMemberId -> VersionRoster -> FD.FileDigest -> GroupMemberId -> UTCTime -> Maybe SignedMsg -> IO Int64
createRosterTransfer db GroupInfo {groupId} fromMemberId v digest ownerGMId brokerTs sm_ = do
-- one in-flight transfer per (group, source): drop any prior row from this source so the INSERT can't hit
-- the UNIQUE constraint even if the caller's fs/handle cleanup was skipped (the scratch file would then leak
-- until group delete, but the transfer never gets stuck). Normally cleanupRosterTransfer ran first.
DB.execute db "DELETE FROM rcv_roster_transfers WHERE group_id = ? AND from_member_id = ?" (groupId, fromMemberId)
DB.execute
db
[sql|
INSERT INTO rcv_roster_transfers
(group_id, from_member_id, roster_version, roster_digest, sending_owner_gm_id, broker_ts,
roster_msg_chat_binding, roster_msg_signatures, roster_msg_body)
VALUES (?,?,?,?,?,?,?,?,?)
|]
( (groupId, fromMemberId, v, Binary (FD.unFileDigest digest), ownerGMId, brokerTs)
:. ((\SignedMsg {chatBinding} -> chatBinding) <$> sm_, (\SignedMsg {signatures} -> Binary (smpEncode signatures)) <$> sm_, (\SignedMsg {signedBody} -> Binary signedBody) <$> sm_)
)
insertedRowId db
getRosterTransferVersion :: DB.Connection -> GroupInfo -> GroupMemberId -> IO (Maybe VersionRoster)
getRosterTransferVersion db GroupInfo {groupId} fromMemberId =
maybeFirstRow fromOnly $
DB.query db "SELECT roster_version FROM rcv_roster_transfers WHERE group_id = ? AND from_member_id = ?" (groupId, fromMemberId)
getRosterTransferId :: DB.Connection -> GroupInfo -> GroupMemberId -> IO (Maybe Int64)
getRosterTransferId db GroupInfo {groupId} fromMemberId =
maybeFirstRow fromOnly $
DB.query db "SELECT roster_transfer_id FROM rcv_roster_transfers WHERE group_id = ? AND from_member_id = ?" (groupId, fromMemberId)
-- An in-flight received roster transfer (a rcv_roster_transfers row joined to its scratch file), read at
-- completion. The header is the relay's re-serve SignedMsg -- present only on a serving relay (NULL on a
-- member, whose live roster_msg_* stay NULL so it never re-serves).
data RcvRosterTransfer = RcvRosterTransfer
{ rosterTransferId :: Int64,
rosterTransferVersion :: VersionRoster,
rosterTransferDigest :: FD.FileDigest,
rosterTransferOwnerGMId :: GroupMemberId,
rosterTransferBrokerTs :: UTCTime,
rosterTransferHeader :: Maybe SignedMsg
}
deriving (Show)
-- The in-flight transfer for a received roster file (joined via files.roster_transfer_id), with its
-- relay-only signed header. Read at completion to apply, promote into the live roster, and ack.
getRosterTransfer :: DB.Connection -> Int64 -> IO (Maybe RcvRosterTransfer)
getRosterTransfer db fileId =
(>>= toTransfer)
<$> maybeFirstRow
id
( DB.query
db
[sql|
SELECT t.roster_transfer_id, t.roster_version, t.roster_digest, t.sending_owner_gm_id, t.broker_ts,
t.roster_msg_chat_binding, t.roster_msg_signatures, t.roster_msg_body
FROM rcv_roster_transfers t
JOIN files f ON f.roster_transfer_id = t.roster_transfer_id
WHERE f.file_id = ?
|]
(Only fileId)
)
where
toTransfer (tId, v, Binary d, ownerGMId, brokerTs, cb_, sigs_, body_) =
Just
RcvRosterTransfer
{ rosterTransferId = tId,
rosterTransferVersion = v,
rosterTransferDigest = FD.FileDigest d,
rosterTransferOwnerGMId = ownerGMId,
rosterTransferBrokerTs = brokerTs,
rosterTransferHeader = 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
-- Write the single live roster on groups from a completed transfer's values (header NULL on a member,
-- so its live roster_msg_* stay NULL and it never re-serves; only relays re-serve).
setGroupLiveRoster :: DB.Connection -> GroupInfo -> VersionRoster -> GroupMemberId -> UTCTime -> Maybe SignedMsg -> ByteString -> IO ()
setGroupLiveRoster db GroupInfo {groupId} v ownerGMId brokerTs sm_ blob = do
currentTs <- getCurrentTime
DB.execute
db
[sql|
UPDATE groups SET
roster_version = ?, roster_blob = ?,
roster_sending_owner_gm_id = ?, roster_broker_ts = ?,
roster_msg_chat_binding = ?, roster_msg_signatures = ?, roster_msg_body = ?,
updated_at = ?
WHERE group_id = ?
|]
( (v, Binary blob, ownerGMId, brokerTs)
:. ((\SignedMsg {chatBinding} -> chatBinding) <$> sm_, (\SignedMsg {signatures} -> Binary (smpEncode signatures)) <$> sm_, (\SignedMsg {signedBody} -> Binary signedBody) <$> sm_, currentTs, groupId)
)
-- Delete one in-flight transfer row (its files/rcv_files/rcv_file_chunks are removed separately, with
-- the on-disk file). Caller removes the fs file + cached handle first.
deleteRosterTransfer :: DB.Connection -> Int64 -> IO ()
deleteRosterTransfer db transferId =
DB.execute db "DELETE FROM rcv_roster_transfers WHERE roster_transfer_id = ?" (Only transferId)
-- All in-flight transfers for a group (group delete).
deleteGroupRosterTransfers :: DB.Connection -> Int64 -> IO ()
deleteGroupRosterTransfers db groupId =
DB.execute db "DELETE FROM rcv_roster_transfers WHERE group_id = ?" (Only groupId)
setGroupMemberKeyRole :: DB.Connection -> GroupMember -> C.PublicKeyEd25519 -> GroupMemberRole -> IO ()
setGroupMemberKeyRole db GroupMember {groupMemberId} pubKey role = do
currentTs <- getCurrentTime
DB.execute db "UPDATE group_members SET member_pub_key = ?, member_role = ?, updated_at = ? WHERE group_member_id = ?" (pubKey, role, currentTs, groupMemberId)
createRelayForOwner :: DB.Connection -> StoreCxt -> TVar ChaChaDRG -> User -> GroupInfo -> UserChatRelay -> ExceptT StoreError IO GroupMember
createRelayForOwner db cxt gVar user@User {userId, userContactId} GroupInfo {groupId, membership} UserChatRelay {relayProfile = RelayProfile {displayName}} = do
currentTs <- liftIO getCurrentTime
@@ -1713,9 +1918,9 @@ getRelayServedGroups db cxt User {userId, userContactId} = do
<$> DB.query
db
( groupInfoQuery
<> " WHERE g.user_id = ? AND mu.contact_id = ? AND g.relay_own_status IN (?, ?)"
<> " WHERE g.user_id = ? AND mu.contact_id = ? AND g.relay_own_status IN (?, ?, ?)"
)
(userId, userContactId, RSAccepted, RSActive)
(userId, userContactId, RSAccepted, RSAcknowledgedRoster, RSActive)
getRelayPublishableGroups :: DB.Connection -> User -> IO [(Int64, B64UrlByteString, Maybe PublicGroupAccess)]
getRelayPublishableGroups db User {userId, userContactId} =
@@ -3182,11 +3387,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 cxt user member profile
currentTs <- liftIO getCurrentTime
liftIO $
@@ -3194,14 +3399,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
@@ -3233,6 +3437,30 @@ updateUnknownMemberAnnounced db cxt user@User {userId} invitingMember unknownMem
VersionRange minV maxV = maybe memberChatVRange fromChatVRange v
memberPubKey_ = (\(MemberKey k) -> k) <$> memberKey
-- Like updateUnknownMemberAnnounced but preserves member_role and member_pub_key
-- (roster-established for moderators/admins; the dissemination carries only the profile).
updateRosterMemberAnnounced :: DB.Connection -> StoreCxt -> User -> GroupMember -> GroupMember -> MemberInfo -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
updateRosterMemberAnnounced db cxt user@User {userId} invitingMember unknownMember@GroupMember {groupMemberId, memberChatVRange} MemberInfo {v, profile} status = do
_ <- updateMemberProfile db cxt user unknownMember profile
currentTs <- liftIO getCurrentTime
liftIO $
DB.execute
db
[sql|
UPDATE group_members
SET member_category = ?,
member_status = ?,
invited_by_group_member_id = ?,
peer_chat_min_version = ?,
peer_chat_max_version = ?,
updated_at = ?
WHERE user_id = ? AND group_member_id = ?
|]
((GCPostMember, status, groupMemberId' invitingMember) :. (minV, maxV, currentTs, userId, groupMemberId))
getGroupMemberById db cxt user groupMemberId
where
VersionRange minV maxV = maybe memberChatVRange fromChatVRange v
updateUserMemberProfileSentAt :: DB.Connection -> User -> GroupInfo -> UTCTime -> IO ()
updateUserMemberProfileSentAt db User {userId} GroupInfo {groupId} sentTs =
DB.execute
src/Simplex/Chat/Store/Messages.hs
+4 -7
View File
@@ -238,10 +238,7 @@ createNewSndMessage db gVar connOrGroupId chatMsgEvent msgSigning_ encodeMessage
case encodeMessage (SharedMsgId sharedMsgId) of
ECMLarge -> pure $ Left SELargeMsg
ECMEncoded msgBody -> do
let signedMsg_ = signBody <$> msgSigning_
signBody MsgSigning {bindingTag, bindingData, keyRef, privKey} =
let sig = C.ASignature C.SEd25519 $ C.sign' privKey (encodeChatBinding bindingTag bindingData <> msgBody)
in SignedMsg {chatBinding = bindingTag, signatures = MsgSignature keyRef sig :| [], signedBody = msgBody}
let signedMsg_ = (`signChatMsgBody` msgBody) <$> msgSigning_
createdAt <- getCurrentTime
DB.execute
db
@@ -584,9 +581,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)
src/Simplex/Chat/Store/Postgres/Migrations.hs
+3 -1
View File
@@ -37,6 +37,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20260529_delivery_job_senders
import Simplex.Chat.Store.Postgres.Migrations.M20260530_client_services
import Simplex.Chat.Store.Postgres.Migrations.M20260531_member_removed_at
import Simplex.Chat.Store.Postgres.Migrations.M20260601_relay_sent_web_domain
import Simplex.Chat.Store.Postgres.Migrations.M20260602_group_roster
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Text, Maybe Text)]
@@ -73,7 +74,8 @@ schemaMigrations =
("20260529_delivery_job_senders", m20260529_delivery_job_senders, Just down_m20260529_delivery_job_senders),
("20260530_client_services", m20260530_client_services, Just down_m20260530_client_services),
("20260531_member_removed_at", m20260531_member_removed_at, Just down_m20260531_member_removed_at),
("20260601_relay_sent_web_domain", m20260601_relay_sent_web_domain, Just down_m20260601_relay_sent_web_domain)
("20260601_relay_sent_web_domain", m20260601_relay_sent_web_domain, Just down_m20260601_relay_sent_web_domain),
("20260602_group_roster", m20260602_group_roster, Just down_m20260602_group_roster)
]
-- | The list of migrations in ascending order by date
src/Simplex/Chat/Store/Postgres/Migrations/M20260602_group_roster.hs
+64
View File
@@ -0,0 +1,64 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.Postgres.Migrations.M20260602_group_roster where
import Data.Text (Text)
import Text.RawString.QQ (r)
m20260602_group_roster :: Text
m20260602_group_roster =
[r|
ALTER TABLE groups ADD COLUMN roster_version BIGINT;
ALTER TABLE groups ADD COLUMN roster_msg_body BYTEA;
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;
CREATE TABLE rcv_roster_transfers(
roster_transfer_id BIGINT PRIMARY KEY GENERATED ALWAYS AS IDENTITY,
group_id BIGINT NOT NULL REFERENCES groups ON DELETE CASCADE,
from_member_id BIGINT NOT NULL REFERENCES group_members ON DELETE CASCADE,
roster_version BIGINT NOT NULL,
roster_digest BYTEA NOT NULL,
sending_owner_gm_id BIGINT NOT NULL,
broker_ts TIMESTAMPTZ NOT NULL,
roster_msg_body BYTEA,
roster_msg_chat_binding TEXT,
roster_msg_signatures BYTEA,
created_at TEXT NOT NULL DEFAULT (now()),
updated_at TEXT NOT NULL DEFAULT (now())
);
CREATE UNIQUE INDEX idx_rcv_roster_transfers_group_id_from_member_id ON rcv_roster_transfers(group_id, from_member_id);
CREATE INDEX idx_rcv_roster_transfers_from_member_id ON rcv_roster_transfers(from_member_id);
ALTER TABLE files ADD COLUMN shared_msg_id BYTEA;
ALTER TABLE files ADD COLUMN file_type TEXT NOT NULL DEFAULT 'normal';
ALTER TABLE files ADD COLUMN roster_transfer_id BIGINT;
CREATE INDEX idx_files_group_id_shared_msg_id ON files(group_id, shared_msg_id);
CREATE INDEX idx_files_roster_transfer_id ON files(roster_transfer_id);
|]
down_m20260602_group_roster :: Text
down_m20260602_group_roster =
[r|
DROP INDEX idx_files_roster_transfer_id;
DROP INDEX idx_files_group_id_shared_msg_id;
ALTER TABLE files DROP COLUMN roster_transfer_id;
ALTER TABLE files DROP COLUMN file_type;
ALTER TABLE files DROP COLUMN shared_msg_id;
DROP INDEX idx_rcv_roster_transfers_from_member_id;
DROP INDEX idx_rcv_roster_transfers_group_id_from_member_id;
DROP TABLE rcv_roster_transfers;
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;
ALTER TABLE groups DROP COLUMN roster_msg_chat_binding;
ALTER TABLE groups DROP COLUMN roster_msg_body;
ALTER TABLE groups DROP COLUMN roster_version;
|]
src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql
+72 -3
View File
@@ -752,7 +752,10 @@ 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,
roster_transfer_id bigint
);
@@ -977,9 +980,16 @@ 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,
relay_sent_web_domain text
relay_sent_web_domain text,
roster_version bigint,
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_blob bytea
);
@@ -1206,6 +1216,34 @@ CREATE TABLE test_chat_schema.rcv_files (
CREATE TABLE test_chat_schema.rcv_roster_transfers (
roster_transfer_id bigint NOT NULL,
group_id bigint NOT NULL,
from_member_id bigint NOT NULL,
roster_version bigint NOT NULL,
roster_digest bytea NOT NULL,
sending_owner_gm_id bigint NOT NULL,
broker_ts timestamp with time zone NOT NULL,
roster_msg_body bytea,
roster_msg_chat_binding text,
roster_msg_signatures bytea,
created_at text DEFAULT now() NOT NULL,
updated_at text DEFAULT now() NOT NULL
);
ALTER TABLE test_chat_schema.rcv_roster_transfers ALTER COLUMN roster_transfer_id ADD GENERATED ALWAYS AS IDENTITY (
SEQUENCE NAME test_chat_schema.rcv_roster_transfers_roster_transfer_id_seq
START WITH 1
INCREMENT BY 1
NO MINVALUE
NO MAXVALUE
CACHE 1
);
CREATE TABLE test_chat_schema.received_probes (
received_probe_id bigint NOT NULL,
contact_id bigint,
@@ -1739,6 +1777,11 @@ ALTER TABLE ONLY test_chat_schema.rcv_files
ALTER TABLE ONLY test_chat_schema.rcv_roster_transfers
ADD CONSTRAINT rcv_roster_transfers_pkey PRIMARY KEY (roster_transfer_id);
ALTER TABLE ONLY test_chat_schema.received_probes
ADD CONSTRAINT received_probes_pkey PRIMARY KEY (received_probe_id);
@@ -2272,10 +2315,18 @@ 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);
CREATE INDEX idx_files_roster_transfer_id ON test_chat_schema.files USING btree (roster_transfer_id);
CREATE INDEX idx_files_user_id ON test_chat_schema.files USING btree (user_id);
@@ -2448,6 +2499,14 @@ CREATE INDEX idx_rcv_files_group_member_id ON test_chat_schema.rcv_files USING b
CREATE INDEX idx_rcv_roster_transfers_from_member_id ON test_chat_schema.rcv_roster_transfers USING btree (from_member_id);
CREATE UNIQUE INDEX idx_rcv_roster_transfers_group_id_from_member_id ON test_chat_schema.rcv_roster_transfers USING btree (group_id, from_member_id);
CREATE INDEX idx_received_probes_contact_id ON test_chat_schema.received_probes USING btree (contact_id);
@@ -3133,6 +3192,16 @@ ALTER TABLE ONLY test_chat_schema.rcv_files
ALTER TABLE ONLY test_chat_schema.rcv_roster_transfers
ADD CONSTRAINT rcv_roster_transfers_from_member_id_fkey FOREIGN KEY (from_member_id) REFERENCES test_chat_schema.group_members(group_member_id) ON DELETE CASCADE;
ALTER TABLE ONLY test_chat_schema.rcv_roster_transfers
ADD CONSTRAINT rcv_roster_transfers_group_id_fkey FOREIGN KEY (group_id) REFERENCES test_chat_schema.groups(group_id) ON DELETE CASCADE;
ALTER TABLE ONLY test_chat_schema.received_probes
ADD CONSTRAINT received_probes_contact_id_fkey FOREIGN KEY (contact_id) REFERENCES test_chat_schema.contacts(contact_id) ON DELETE CASCADE;
src/Simplex/Chat/Store/SQLite/Migrations.hs
+3 -1
View File
@@ -160,6 +160,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20260529_delivery_job_senders
import Simplex.Chat.Store.SQLite.Migrations.M20260530_client_services
import Simplex.Chat.Store.SQLite.Migrations.M20260531_member_removed_at
import Simplex.Chat.Store.SQLite.Migrations.M20260601_relay_sent_web_domain
import Simplex.Chat.Store.SQLite.Migrations.M20260602_group_roster
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -319,7 +320,8 @@ schemaMigrations =
("20260529_delivery_job_senders", m20260529_delivery_job_senders, Just down_m20260529_delivery_job_senders),
("20260530_client_services", m20260530_client_services, Just down_m20260530_client_services),
("20260531_member_removed_at", m20260531_member_removed_at, Just down_m20260531_member_removed_at),
("20260601_relay_sent_web_domain", m20260601_relay_sent_web_domain, Just down_m20260601_relay_sent_web_domain)
("20260601_relay_sent_web_domain", m20260601_relay_sent_web_domain, Just down_m20260601_relay_sent_web_domain),
("20260602_group_roster", m20260602_group_roster, Just down_m20260602_group_roster)
]
-- | The list of migrations in ascending order by date
src/Simplex/Chat/Store/SQLite/Migrations/M20260602_group_roster.hs
+63
View File
@@ -0,0 +1,63 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.SQLite.Migrations.M20260602_group_roster where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20260602_group_roster :: Query
m20260602_group_roster =
[sql|
ALTER TABLE groups ADD COLUMN roster_version INTEGER;
ALTER TABLE groups ADD COLUMN roster_msg_body BLOB;
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;
CREATE TABLE rcv_roster_transfers(
roster_transfer_id INTEGER PRIMARY KEY,
group_id INTEGER NOT NULL REFERENCES groups ON DELETE CASCADE,
from_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
roster_version INTEGER NOT NULL,
roster_digest BLOB NOT NULL,
sending_owner_gm_id INTEGER NOT NULL,
broker_ts TEXT NOT NULL,
roster_msg_body BLOB,
roster_msg_chat_binding TEXT,
roster_msg_signatures BLOB,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
) STRICT;
CREATE UNIQUE INDEX idx_rcv_roster_transfers_group_id_from_member_id ON rcv_roster_transfers(group_id, from_member_id);
CREATE INDEX idx_rcv_roster_transfers_from_member_id ON rcv_roster_transfers(from_member_id);
ALTER TABLE files ADD COLUMN shared_msg_id BLOB;
ALTER TABLE files ADD COLUMN file_type TEXT NOT NULL DEFAULT 'normal';
ALTER TABLE files ADD COLUMN roster_transfer_id INTEGER;
CREATE INDEX idx_files_group_id_shared_msg_id ON files(group_id, shared_msg_id);
CREATE INDEX idx_files_roster_transfer_id ON files(roster_transfer_id);
|]
down_m20260602_group_roster :: Query
down_m20260602_group_roster =
[sql|
DROP INDEX idx_files_roster_transfer_id;
DROP INDEX idx_files_group_id_shared_msg_id;
ALTER TABLE files DROP COLUMN roster_transfer_id;
ALTER TABLE files DROP COLUMN file_type;
ALTER TABLE files DROP COLUMN shared_msg_id;
DROP INDEX idx_rcv_roster_transfers_from_member_id;
DROP INDEX idx_rcv_roster_transfers_group_id_from_member_id;
DROP TABLE rcv_roster_transfers;
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;
ALTER TABLE groups DROP COLUMN roster_msg_chat_binding;
ALTER TABLE groups DROP COLUMN roster_msg_body;
ALTER TABLE groups DROP COLUMN roster_version;
|]
src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt
+223 -15
View File
@@ -30,6 +30,7 @@ Query:
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -82,6 +83,7 @@ Query:
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -148,7 +150,7 @@ Query:
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.use_relays, g.relay_own_status,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.roster_version, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.root_priv_key, g.root_pub_key, g.member_priv_key,
-- GroupInfo {membership}
mu.group_member_id, mu.group_id, mu.index_in_group, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
@@ -286,6 +288,7 @@ Query:
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -320,6 +323,7 @@ Query:
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -354,6 +358,7 @@ Query:
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -537,6 +542,7 @@ Query:
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -570,6 +576,7 @@ Query:
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -604,6 +611,7 @@ Query:
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -638,6 +646,7 @@ Query:
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -1082,6 +1091,17 @@ SEARCH m USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
SEARCH g USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
SEARCH h USING INDEX idx_sent_probe_hashes_sent_probe_id (sent_probe_id=?)
Query:
SELECT t.roster_transfer_id, t.roster_version, t.roster_digest, t.sending_owner_gm_id, t.broker_ts,
t.roster_msg_chat_binding, t.roster_msg_signatures, t.roster_msg_body
FROM rcv_roster_transfers t
JOIN files f ON f.roster_transfer_id = t.roster_transfer_id
WHERE f.file_id = ?
Plan:
SEARCH f USING INTEGER PRIMARY KEY (rowid=?)
SEARCH t USING INTEGER PRIMARY KEY (rowid=?)
Query:
UPDATE chat_items
SET user_id = ?, updated_at = ?
@@ -1182,6 +1202,7 @@ Query:
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -1217,6 +1238,7 @@ Query:
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -1266,8 +1288,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:
@@ -1669,7 +1691,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
@@ -1865,6 +1887,7 @@ Query:
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -1899,6 +1922,7 @@ Query:
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -1946,6 +1970,17 @@ Query:
Plan:
Query:
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
Plan:
Query:
INSERT INTO remote_hosts
(host_device_name, store_path, bind_addr, bind_iface, bind_port, ca_key, ca_cert, id_key, host_fingerprint, host_dh_pub)
@@ -3708,6 +3743,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 = ? AND f.file_type = ?
AND r.group_member_id = ?
Plan:
SEARCH f USING INDEX idx_files_group_id_shared_msg_id (group_id=? AND shared_msg_id=?)
SEARCH r USING COVERING INDEX idx_rcv_files_group_member_id (group_member_id=? AND rowid=?)
Query:
SELECT file_id, contact_id, group_id, note_folder_id
FROM files
@@ -4059,6 +4103,19 @@ Query:
Plan:
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
Query:
UPDATE group_members
SET member_category = ?,
member_status = ?,
invited_by_group_member_id = ?,
peer_chat_min_version = ?,
peer_chat_max_version = ?,
updated_at = ?
WHERE user_id = ? AND group_member_id = ?
Plan:
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
Query:
UPDATE group_members
SET member_id = ?, member_pub_key = ?, updated_at = ?
@@ -4077,8 +4134,7 @@ SCAN group_members
Query:
UPDATE group_members
SET member_role = ?,
member_status = ?,
SET member_status = ?,
peer_chat_min_version = ?,
peer_chat_max_version = ?,
updated_at = ?
@@ -4783,6 +4839,14 @@ Query:
Plan:
Query:
INSERT INTO rcv_roster_transfers
(group_id, from_member_id, roster_version, roster_digest, sending_owner_gm_id, broker_ts,
roster_msg_chat_binding, roster_msg_signatures, roster_msg_body)
VALUES (?,?,?,?,?,?,?,?,?)
Plan:
Query:
INSERT INTO remote_controllers
(ctrl_device_name, ca_key, ca_cert, ctrl_fingerprint, id_pub, dh_priv_key, prev_dh_priv_key)
@@ -5259,6 +5323,17 @@ Query:
Plan:
SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
Query:
UPDATE groups SET
roster_version = ?, roster_blob = ?,
roster_sending_owner_gm_id = ?, roster_broker_ts = ?,
roster_msg_chat_binding = ?, roster_msg_signatures = ?, roster_msg_body = ?,
updated_at = ?
WHERE group_id = ?
Plan:
SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
Query:
UPDATE msg_deliveries
SET delivery_status = ?, updated_at = ?
@@ -5276,6 +5351,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 = ?
@@ -5391,7 +5474,7 @@ Query:
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.use_relays, g.relay_own_status,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.roster_version, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.root_priv_key, g.root_pub_key, g.member_priv_key,
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.index_in_group, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
@@ -5429,7 +5512,7 @@ Query:
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.use_relays, g.relay_own_status,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.roster_version, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.root_priv_key, g.root_pub_key, g.member_priv_key,
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.index_in_group, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
@@ -5460,7 +5543,7 @@ Query:
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.use_relays, g.relay_own_status,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.roster_version, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.root_priv_key, g.root_pub_key, g.member_priv_key,
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.index_in_group, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
@@ -5742,6 +5825,26 @@ SEARCH m USING INDEX idx_group_members_group_id (user_id=? AND group_id=?)
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
Query:
SELECT
m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx,
m.created_at, m.updated_at,
m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.relay_link,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
LEFT JOIN connections c ON c.group_member_id = m.group_member_id
WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?)
Plan:
SEARCH m USING INDEX idx_group_members_group_id (user_id=? AND group_id=?)
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
Query:
SELECT
m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
@@ -5872,11 +5975,11 @@ Query:
FROM group_relays gr
JOIN chat_relays cr ON cr.chat_relay_id = gr.chat_relay_id
JOIN group_members m ON m.group_member_id = gr.group_member_id
WHERE gr.group_id = ?
AND m.member_status = ?
AND gr.relay_status IN (?,?)
JOIN group_members m ON m.group_member_id = gr.group_member_id
WHERE gr.group_id = ?
AND m.member_status = ?
AND gr.relay_status IN (?,?,?)
Plan:
SEARCH gr USING INDEX idx_group_relays_group_id (group_id=?)
SEARCH cr USING INTEGER PRIMARY KEY (rowid=?)
@@ -6491,6 +6594,14 @@ SEARCH groups USING COVERING INDEX sqlite_autoindex_groups_1 (user_id=? AND loca
SEARCH contacts USING COVERING INDEX sqlite_autoindex_contacts_1 (user_id=? AND local_display_name=?)
SEARCH users USING INTEGER PRIMARY KEY (rowid=?)
Query: DELETE FROM files WHERE roster_transfer_id = ?
Plan:
SEARCH files USING COVERING INDEX idx_files_roster_transfer_id (roster_transfer_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 files WHERE user_id = ? AND contact_id = ?
Plan:
SEARCH files USING INDEX idx_files_contact_id (contact_id=?)
@@ -6499,9 +6610,18 @@ 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=?)
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -6531,6 +6651,7 @@ SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (conta
Query: DELETE FROM group_members WHERE user_id = ? AND group_member_id = ?
Plan:
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_from_member_id (from_member_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_member_id (group_member_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_job_scope_support_gm_id (job_scope_support_gm_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_sender_group_member_id (sender_group_member_id=?)
@@ -6560,6 +6681,7 @@ SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (conta
Query: DELETE FROM groups WHERE user_id = ? AND group_id = ?
Plan:
SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_group_id_from_member_id (group_id=?)
SEARCH group_relays USING COVERING INDEX idx_group_relays_group_id (group_id=?)
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_group_id (group_id=?)
SEARCH delivery_tasks USING COVERING INDEX idx_delivery_tasks_group_id (group_id=?)
@@ -6632,6 +6754,18 @@ Query: DELETE FROM rcv_file_chunks WHERE file_id = ?
Plan:
SEARCH rcv_file_chunks USING COVERING INDEX idx_rcv_file_chunks_file_id (file_id=?)
Query: DELETE FROM rcv_roster_transfers WHERE group_id = ?
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_group_id_from_member_id (group_id=?)
Query: DELETE FROM rcv_roster_transfers WHERE group_id = ? AND from_member_id = ?
Plan:
SEARCH rcv_roster_transfers USING INDEX idx_rcv_roster_transfers_group_id_from_member_id (group_id=? AND from_member_id=?)
Query: DELETE FROM rcv_roster_transfers WHERE roster_transfer_id = ?
Plan:
SEARCH rcv_roster_transfers USING INTEGER PRIMARY KEY (rowid=?)
Query: DELETE FROM received_probes WHERE created_at <= ?
Plan:
SEARCH received_probes USING COVERING INDEX idx_received_probes_created_at (created_at<?)
@@ -6755,7 +6889,10 @@ 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 files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, protocol, file_type, shared_msg_id, roster_transfer_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 (?,?,?,?,?,?,?,?,?,?)
@@ -6776,6 +6913,9 @@ Plan:
Query: INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, file_descr_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)
Plan:
Query: INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)
Plan:
Query: 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 (?,?,?,?,?,?,?,?,?)
Plan:
@@ -6945,6 +7085,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=?)
@@ -7009,6 +7153,18 @@ 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 roster_transfer_id = ?
Plan:
SEARCH files USING INDEX idx_files_roster_transfer_id (roster_transfer_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 file_type FROM files WHERE user_id = ? AND group_id = ? AND shared_msg_id = ? LIMIT 1
Plan:
SEARCH files USING INDEX idx_files_group_id_shared_msg_id (group_id=? AND shared_msg_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=?)
@@ -7077,6 +7233,14 @@ Query: SELECT max(active_order) FROM users
Plan:
SEARCH users
Query: SELECT member_pub_key FROM group_members WHERE local_display_name = ?
Plan:
SCAN group_members
Query: SELECT member_pub_key FROM group_members WHERE member_role = 'moderator'
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=?)
@@ -7085,6 +7249,10 @@ Query: SELECT member_relations_vector FROM group_members WHERE group_member_id =
Plan:
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
Query: SELECT member_role FROM group_members WHERE local_display_name = ?
Plan:
SCAN group_members
Query: SELECT member_status FROM group_members WHERE local_display_name = ?
Plan:
SCAN group_members
@@ -7129,6 +7297,30 @@ Query: SELECT relay_status FROM group_relays WHERE group_relay_id = ?
Plan:
SEARCH group_relays USING INTEGER PRIMARY KEY (rowid=?)
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_transfer_id FROM rcv_roster_transfers WHERE group_id = ? AND from_member_id = ?
Plan:
SEARCH rcv_roster_transfers USING COVERING INDEX idx_rcv_roster_transfers_group_id_from_member_id (group_id=? AND from_member_id=?)
Query: SELECT roster_version FROM groups
Plan:
SCAN groups
Query: SELECT roster_version FROM groups WHERE group_id = ?
Plan:
SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
Query: SELECT roster_version FROM rcv_roster_transfers WHERE group_id = ? AND from_member_id = ?
Plan:
SEARCH rcv_roster_transfers USING INDEX idx_rcv_roster_transfers_group_id_from_member_id (group_id=? AND from_member_id=?)
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=?)
@@ -7357,6 +7549,10 @@ Query: UPDATE group_members SET member_profile_id = ?, updated_at = ? WHERE grou
Plan:
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
Query: UPDATE group_members SET member_pub_key = ?, member_role = ?, updated_at = ? WHERE group_member_id = ?
Plan:
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
Query: UPDATE group_members SET member_pub_key = ?, updated_at = ? WHERE group_member_id = ?
Plan:
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
@@ -7369,6 +7565,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=?)
@@ -7449,6 +7649,14 @@ 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=?)
Query: UPDATE groups SET send_rcpts = NULL
Plan:
SCAN groups
src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql
+38 -2
View File
@@ -192,7 +192,14 @@ CREATE TABLE groups(
relay_request_delay INTEGER NOT NULL DEFAULT 0,
relay_request_execute_at TEXT NOT NULL DEFAULT '1970-01-01 00:00:00',
relay_inactive_at TEXT,
relay_sent_web_domain TEXT, -- received
relay_sent_web_domain TEXT,
roster_version INTEGER,
roster_msg_body BLOB,
roster_msg_chat_binding TEXT,
roster_msg_signatures BLOB,
roster_sending_owner_gm_id INTEGER,
roster_broker_ts TEXT,
roster_blob BLOB, -- received
FOREIGN KEY(user_id, local_display_name)
REFERENCES display_names(user_id, local_display_name)
ON DELETE CASCADE
@@ -278,7 +285,10 @@ 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',
roster_transfer_id INTEGER
) STRICT;
CREATE TABLE snd_files(
file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE,
@@ -798,6 +808,20 @@ CREATE TABLE group_relays(
,
base_web_url TEXT
) STRICT;
CREATE TABLE rcv_roster_transfers(
roster_transfer_id INTEGER PRIMARY KEY,
group_id INTEGER NOT NULL REFERENCES groups ON DELETE CASCADE,
from_member_id INTEGER NOT NULL REFERENCES group_members ON DELETE CASCADE,
roster_version INTEGER NOT NULL,
roster_digest BLOB NOT NULL,
sending_owner_gm_id INTEGER NOT NULL,
broker_ts TEXT NOT NULL,
roster_msg_body BLOB,
roster_msg_chat_binding TEXT,
roster_msg_signatures BLOB,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
) STRICT;
CREATE INDEX contact_profiles_index ON contact_profiles(
display_name,
full_name
@@ -1317,6 +1341,18 @@ ON groups(
relay_request_group_link
)
WHERE relay_request_group_link IS NOT NULL;
CREATE UNIQUE INDEX idx_rcv_roster_transfers_group_id_from_member_id ON rcv_roster_transfers(
group_id,
from_member_id
);
CREATE INDEX idx_rcv_roster_transfers_from_member_id ON rcv_roster_transfers(
from_member_id
);
CREATE INDEX idx_files_group_id_shared_msg_id ON files(
group_id,
shared_msg_id
);
CREATE INDEX idx_files_roster_transfer_id ON files(roster_transfer_id);
CREATE TRIGGER on_group_members_insert_update_summary
AFTER INSERT ON group_members
FOR EACH ROW
src/Simplex/Chat/Store/Shared.hs
+4 -4
View File
@@ -670,7 +670,7 @@ type BusinessChatInfoRow = (Maybe BusinessChatType, Maybe MemberId, Maybe Member
type GroupKeysRow = (Maybe C.PrivateKeyEd25519, Maybe C.PublicKeyEd25519, Maybe C.PrivateKeyEd25519)
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData, Maybe GroupType, Maybe ShortLinkContact, Maybe B64UrlByteString) :. PublicGroupAccessRow :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (BoolInt, Maybe RelayStatus, Maybe UIThemeEntityOverrides, Int64, Maybe Int64, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupKeysRow :. GroupMemberRow
type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe Text, Maybe ImageData, Maybe GroupType, Maybe ShortLinkContact, Maybe B64UrlByteString) :. PublicGroupAccessRow :. (Maybe MsgFilter, Maybe BoolInt, BoolInt, Maybe GroupPreferences, Maybe GroupMemberAdmission) :. (UTCTime, UTCTime, Maybe UTCTime, Maybe UTCTime) :. PreparedGroupRow :. BusinessChatInfoRow :. (BoolInt, Maybe RelayStatus, Maybe UIThemeEntityOverrides, Int64, Maybe Int64, Maybe VersionRoster, Maybe CustomData, Maybe Int64, Int, Maybe ConnReqContact) :. GroupKeysRow :. GroupMemberRow
type PublicGroupAccessRow = (Maybe Text, Maybe Text, Maybe BoolInt, Maybe BoolInt)
@@ -679,7 +679,7 @@ type GroupMemberRow = (GroupMemberId, GroupId, Int64, MemberId, VersionChat, Ver
type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences) :. BadgeRow
toGroupInfo :: UTCTime -> StoreCxt -> Int64 -> [ChatTagId] -> GroupInfoRow -> GroupInfo
toGroupInfo now cxt userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. userMemberRow) =
toGroupInfo now cxt userContactId chatTags ((groupId, localDisplayName, displayName, fullName, shortDescr, localAlias, description, image, groupType_, groupLink_, publicGroupId_) :. accessRow :. (enableNtfs_, sendRcpts, BI favorite, groupPreferences, memberAdmission) :. (createdAt, updatedAt, chatTs, userMemberProfileSentAt) :. preparedGroupRow :. businessRow :. (BI useRelays, relayOwnStatus, uiThemes, currentMembers, publicMemberCount, rosterVersion, customData, chatItemTTL, membersRequireAttention, viaGroupLinkUri) :. groupKeysRow :. userMemberRow) =
let membership = (toGroupMember now userContactId userMemberRow) {memberChatVRange = vr cxt}
chatSettings = ChatSettings {enableNtfs = fromMaybe MFAll enableNtfs_, sendRcpts = unBI <$> sendRcpts, favorite}
fullGroupPreferences = mergeGroupPreferences groupPreferences
@@ -689,7 +689,7 @@ toGroupInfo now cxt userContactId chatTags ((groupId, localDisplayName, displayN
businessChat = toBusinessChatInfo businessRow
preparedGroup = toPreparedGroup preparedGroupRow
groupSummary = GroupSummary {currentMembers, publicMemberCount}
in GroupInfo {groupId, useRelays = BoolDef useRelays, relayOwnStatus, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, preparedGroup, chatTags, chatItemTTL, uiThemes, groupSummary, customData, membersRequireAttention, viaGroupLinkUri, groupKeys}
in GroupInfo {groupId, useRelays = BoolDef useRelays, relayOwnStatus, localDisplayName, groupProfile, localAlias, businessChat, fullGroupPreferences, membership, chatSettings, createdAt, updatedAt, chatTs, userMemberProfileSentAt, preparedGroup, chatTags, chatItemTTL, uiThemes, groupSummary, rosterVersion, customData, membersRequireAttention, viaGroupLinkUri, groupKeys}
toPreparedGroup :: PreparedGroupRow -> Maybe PreparedGroup
toPreparedGroup = \case
@@ -789,7 +789,7 @@ groupInfoQueryFields =
g.conn_full_link_to_connect, g.conn_short_link_to_connect, g.conn_link_prepared_connection, g.conn_link_started_connection, g.welcome_shared_msg_id, g.request_shared_msg_id,
g.business_chat, g.business_member_id, g.customer_member_id,
g.use_relays, g.relay_own_status,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.ui_themes, g.summary_current_members_count, g.public_member_count, g.roster_version, g.custom_data, g.chat_item_ttl, g.members_require_attention, g.via_group_link_uri,
g.root_priv_key, g.root_pub_key, g.member_priv_key,
-- GroupMember - membership
mu.group_member_id, mu.group_id, mu.index_in_group, mu.member_id, mu.peer_chat_min_version, mu.peer_chat_max_version, mu.member_role, mu.member_category,
src/Simplex/Chat/Types.hs
+39
View File
@@ -490,6 +490,7 @@ data GroupInfo = GroupInfo
uiThemes :: Maybe UIThemeEntityOverrides,
customData :: Maybe CustomData,
groupSummary :: GroupSummary,
rosterVersion :: Maybe VersionRoster,
membersRequireAttention :: Int,
viaGroupLinkUri :: Maybe ConnReqContact,
groupKeys :: Maybe GroupKeys
@@ -1021,6 +1022,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"
@@ -1542,11 +1548,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,
@@ -2091,6 +2124,12 @@ data StoreCxt = StoreCxt {vr :: VersionRangeChat, badgeKeys :: Map Int BBSPublic
pattern VersionChat :: Word16 -> VersionChat
pattern VersionChat v = Version v
-- A monotonic per-change counter, not a negotiated protocol version: Int64 rather than the Word16 of
-- Version, so a long-lived high-churn channel cannot wrap and be permanently rejected by relays (v >= cur).
newtype VersionRoster = VersionRoster Int64
deriving (Eq, Ord, Show)
deriving newtype (FromJSON, ToJSON, FromField, ToField)
-- this newtype exists to have a concise JSON encoding of version ranges in chat protocol messages in the form of "1-2" or just "1"
newtype ChatVersionRange = ChatVersionRange {fromChatVRange :: VersionRangeChat} deriving (Eq, Show)
src/Simplex/Chat/Types/Shared.hs
+11
View File
@@ -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
@@ -82,6 +89,7 @@ data RelayStatus
= RSNew -- only for owner
| RSInvited
| RSAccepted
| RSAcknowledgedRoster
| RSActive
| RSInactive
| RSRejected
@@ -92,6 +100,7 @@ relayStatusText = \case
RSNew -> "new"
RSInvited -> "invited"
RSAccepted -> "accepted"
RSAcknowledgedRoster -> "acknowledged_roster"
RSActive -> "active"
RSInactive -> "inactive"
RSRejected -> "rejected"
@@ -101,6 +110,7 @@ instance TextEncoding RelayStatus where
RSNew -> "new"
RSInvited -> "invited"
RSAccepted -> "accepted"
RSAcknowledgedRoster -> "acknowledged_roster"
RSActive -> "active"
RSInactive -> "inactive"
RSRejected -> "rejected"
@@ -108,6 +118,7 @@ instance TextEncoding RelayStatus where
"new" -> Just RSNew
"invited" -> Just RSInvited
"accepted" -> Just RSAccepted
"acknowledged_roster" -> Just RSAcknowledgedRoster
"active" -> Just RSActive
"inactive" -> Just RSInactive
"rejected" -> Just RSRejected