wip

src/Simplex/Chat/Library/Commands.hs

@@ -2743,8 +2743,9 @@ processChatCommand vr nm = \case
       unless (null acis) $ toView $ CEvtNewChatItems user acis
       let errs = errs1 <> errs2
       unless (null errs) $ toView $ CEvtChatErrors errs
-      let rosterSetChanged = useRelays' gInfo && not (null (changed1 <> changed2)) && (isRosterRole newRole || anyPrivilegedTarget)
-      when rosterSetChanged $ bumpAndBroadcastRoster user gInfo `catchAllErrors` eToView
+      let rosterSetChanged = not (null (changed1 <> changed2)) && (isRosterRole newRole || anyPrivilegedTarget)
+      when (useRelays' gInfo && memberRole' (membership gInfo) == GROwner && rosterSetChanged) $
+        bumpAndBroadcastRoster user gInfo `catchAllErrors` eToView
       pure $ CRMembersRoleUser {user, groupInfo = gInfo, members = changed1 <> changed2, toRole = newRole, msgSigned} -- same order is not guaranteed
     where
       selfSelected GroupInfo {membership} = elem (groupMemberId' membership) memberIds
@@ -2884,7 +2885,8 @@ processChatCommand vr nm = \case
       unless (null acis') $ toView $ CEvtNewChatItems user acis'
       unless (null errs) $ toView $ CEvtChatErrors errs
       -- refresh the roster so the relay drops a removed privileged member for future joiners
-      when (useRelays' gInfo && anyPrivilegedRemoved) $ bumpAndBroadcastRoster user gInfo `catchAllErrors` eToView
+      when (useRelays' gInfo && memberRole' (membership gInfo) == GROwner && anyPrivilegedRemoved) $
+        bumpAndBroadcastRoster user gInfo `catchAllErrors` eToView
       pure $ CRUserDeletedMembers user gInfo' deleted withMessages msgSigned -- same order is not guaranteed
     where
       selectMembers :: S.Set GroupMemberId -> [GroupMember] -> (Int, [GroupMember], [GroupMember], [GroupMember], [GroupMember], GroupMemberRole, Bool, Bool)

src/Simplex/Chat/Library/Internal.hs

@@ -2136,19 +2136,19 @@ 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)
 bumpAndBroadcastRoster :: User -> GroupInfo -> CM ()
-bumpAndBroadcastRoster user gInfo
-  | memberRole' (membership gInfo) /= GROwner = pure ()
-  | otherwise = do
-      vr <- chatVersionRange
-      let rosterVer = maybe 0 (+ 1) (rosterVersion gInfo)
-      (relays, roster) <- withStore' $ \db -> do
-        relays <- getGroupRelayMembers db vr user gInfo
-        mods <- getGroupRosterMembers db vr user gInfo
-        setGroupRosterVersion db gInfo rosterVer
-        pure (relays, buildGroupRoster rosterVer mods)
-      forM_ (L.nonEmpty relays) $ \relays' ->
-        void $ sendGroupMessage' user gInfo (L.toList relays') (XGrpRoster roster)
+bumpAndBroadcastRoster user gInfo = do
+  vr <- chatVersionRange
+  let rosterVer = maybe 0 (+ 1) (rosterVersion gInfo)
+  (relays, roster) <- withStore' $ \db -> do
+    relays <- getGroupRelayMembers db vr user gInfo
+    mods <- getGroupRosterMembers db vr user gInfo
+    setGroupRosterVersion db gInfo rosterVer
+    pure (relays, buildGroupRoster rosterVer mods)
+  forM_ (L.nonEmpty relays) $ \relays' ->
+    void $ sendGroupMessage' user gInfo (L.toList relays') (XGrpRoster roster)
 
 -- Send the current roster (no version bump) to a newly added relay so it can serve joiners.
 sendGroupRosterToRelay :: User -> GroupInfo -> GroupMember -> CM ()

src/Simplex/Chat/Library/Subscriber.hs

@@ -3150,18 +3150,23 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
     xGrpRoster gInfo author roster verifiedMsg brokerTs
       -- only an owner may sign a roster; otherwise a relay could route it as a member whose key it controls
       | memberRole' author /= GROwner = messageError "x.grp.roster: not signed by an owner" $> Nothing
+      | length entries > maxGroupRosterSize = messageError ("x.grp.roster: too many entries, max " <> tshow maxGroupRosterSize) $> Nothing
       | isUserGrpFwdRelay gInfo = relayApplyRoster
       | otherwise = Nothing <$ memberApplyRoster
       where
-        GroupRoster {version = newVer} = validRoster
+        GroupRoster {version = newVer, roster = entries} = validRoster
         validRoster = validateGroupRoster roster
         relayApplyRoster :: CM (Maybe DeliveryJobScope)
         relayApplyRoster
           | maybe False (newVer <=) (rosterVersion gInfo) = Nothing <$ messageWarning "x.grp.roster: not newer than cached version"
           | otherwise = case verifiedMsg of
               VMSigned _ sm _ -> do
-                withStore' $ \db -> setCachedGroupRoster db gInfo newVer (groupMemberId' author) brokerTs sm
-                applyRosterRecords
+                defaultRole <- unknownMemberRole gInfo
+                results <- withStore $ \db -> do
+                  res <- processRoster db defaultRole
+                  liftIO $ setCachedGroupRoster db gInfo newVer (groupMemberId' author) brokerTs sm
+                  pure res
+                emitRosterResults results
                 -- always broadcast on a bump: self-healing, and demotions must reach members
                 pure $ Just DJSGroup {jobSpec = DJDeliveryJob {includePending = False}}
               VMUnsigned _ -> Nothing <$ messageWarning "x.grp.roster: unsigned roster"
@@ -3170,37 +3175,41 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           | maybe False (newVer <) (rosterVersion gInfo) = messageWarning "x.grp.roster: older than accepted version"
           | maybe False (newVer ==) (rosterVersion gInfo) = pure ()
           | otherwise = do
-              applyRosterRecords
-              withStore' $ \db -> setGroupRosterVersion db gInfo newVer
-        applyRosterRecords :: CM ()
-        applyRosterRecords = do
-          let GroupRoster {roster = entries} = validRoster
-              rosterIds = map (\RosterMember {memberId} -> memberId) entries
-          defaultRole <- unknownMemberRole gInfo
-          (conflicts, applied) <- withStore $ \db -> do
-            acc <- foldrM (applyRosterEntry db defaultRole) ([], []) entries
-            -- absent privileged members revert to the joiner default
-            currentPriv <- liftIO $ getGroupRosterMembers db vr user gInfo
-            liftIO $ forM_ currentPriv $ \m ->
-              when (memberId' m `notElem` rosterIds) $
-                updateGroupMemberRole db user m defaultRole
-            pure acc
+              defaultRole <- unknownMemberRole gInfo
+              results <- withStore $ \db -> do
+                res <- processRoster db defaultRole
+                liftIO $ setGroupRosterVersion db gInfo newVer
+                pure res
+              emitRosterResults results
+        processRoster :: DB.Connection -> GroupMemberRole -> ExceptT StoreError IO ([MemberId], [(GroupMember, GroupMemberRole)])
+        processRoster db defaultRole = do
+          let rosterIds = map (\RosterMember {memberId} -> memberId) entries
+          acc <- foldrM applyRosterEntry ([], []) entries
+          -- absent privileged members revert to the joiner default
+          currentPriv <- liftIO $ getGroupRosterMembers db vr user gInfo
+          liftIO $ forM_ currentPriv $ \m ->
+            when (memberId' m `notElem` rosterIds) $
+              updateGroupMemberRole db user m defaultRole
+          pure acc
+          where
+            -- entry-level failure (StoreError or IO exception) is muted; the entry is dropped
+            applyRosterEntry RosterMember {memberId, name, key = MemberKey pubKey, role} (cs, as) =
+              apply `catchAllErrors` \_ -> pure (cs, as)
+              where
+                applied m = (cs, ((m :: GroupMember) {memberRole = role}, memberRole' m) : as)
+                apply = getCreateUnknownGMByMemberId db vr user gInfo memberId name defaultRole True >>= \case
+                  Nothing -> pure (cs, as)
+                  Just (m, _) -> case memberPubKey m of
+                    Just k
+                      | k /= pubKey -> pure (memberId : cs, as)
+                      | memberRole' m == role -> pure (cs, as)
+                      | otherwise -> liftIO (updateGroupMemberRole db user m role) $> applied m
+                    Nothing -> liftIO (setGroupMemberKeyRole db m pubKey role) $> applied m
+        emitRosterResults :: ([MemberId], [(GroupMember, GroupMemberRole)]) -> CM ()
+        emitRosterResults (conflicts, applied) = do
           forM_ conflicts $ \mid' ->
             messageWarning $ "x.grp.roster: member key conflict, keeping trusted key, memberId=" <> safeDecodeUtf8 (strEncode mid')
           forM_ applied $ \(member, fromRole) -> createItems member fromRole
-        applyRosterEntry :: DB.Connection -> GroupMemberRole -> RosterMember -> ([MemberId], [(GroupMember, GroupMemberRole)]) -> ExceptT StoreError IO ([MemberId], [(GroupMember, GroupMemberRole)])
-        applyRosterEntry db defaultRole RosterMember {memberId, name, key = MemberKey pubKey, role} (cs, as) =
-          applyEntry `catchAllErrors` \_ -> pure (cs, as)
-          where
-            applied m = (cs, ((m :: GroupMember) {memberRole = role}, memberRole' m) : as)
-            applyEntry = getCreateUnknownGMByMemberId db vr user gInfo memberId name defaultRole True >>= \case
-              Nothing -> pure (cs, as)
-              Just (m, _) -> case memberPubKey m of
-                Just k
-                  | k /= pubKey -> pure (memberId : cs, as)
-                  | memberRole' m == role -> pure (cs, as)
-                  | otherwise -> liftIO (updateGroupMemberRole db user m role) $> applied m
-                Nothing -> liftIO (setGroupMemberKeyRole db m pubKey role) $> applied m
         createItems :: GroupMember -> GroupMemberRole -> CM ()
         createItems member fromRole = do
           let toRole = memberRole' member
@@ -3348,8 +3357,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
         (ci, cInfo) <- saveRcvChatItemNoParse user (CDGroupRcv gInfo''' scopeInfo m') msg brokerTs (CIRcvGroupEvent RGEMemberLeft)
         groupMsgToView cInfo ci
         toView $ CEvtLeftMember user gInfo''' m' {memberStatus = GSMemLeft} msgSigned
-      -- a privileged leaver drops out of the roster; bumpAndBroadcastRoster is owner-guarded
-      when (useRelays' gInfo'' && isRosterRole (memberRole' m)) $
+      -- a privileged leaver drops out of the roster
+      when (useRelays' gInfo'' && memberRole' (membership gInfo'') == GROwner && isRosterRole (memberRole' m)) $
         bumpAndBroadcastRoster user gInfo'' `catchAllErrors` eToView
       pure $ memberEventDeliveryScope m
 

src/Simplex/Chat/Store/Groups.hs

@@ -197,7 +197,6 @@ import Data.Char (toLower)
 import Data.Either (rights)
 import Data.Functor (($>))
 import Data.Int (Int64)
-import Data.Word (Word32)
 import Data.List (partition, sortOn)
 import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
 import Data.Ord (Down (..))