wip

src/Simplex/Chat/Library/Internal.hs

@@ -1164,7 +1164,7 @@ memberIntroEvt gInfo reMember =
 forwardCachedRoster :: User -> GroupInfo -> GroupMember -> CM ()
 forwardCachedRoster user gInfo subscriber = do
   vr <- chatVersionRange
-  withStore' (\db -> getCachedGroupRoster db (groupId' gInfo)) >>= \case
+  withStore' (\db -> getCachedGroupRoster db gInfo) >>= \case
     Nothing -> pure ()
     Just (ownerGMId, brokerTs, sm@SignedMsg {signedBody}) ->
       forM_ (eitherToMaybe (J.eitherDecodeStrict' signedBody) :: Maybe (ChatMessage 'Json)) $ \chatMsg ->
@@ -2144,7 +2144,7 @@ bumpAndBroadcastRoster user gInfo
       (relays, roster) <- withStore' $ \db -> do
         relays <- getGroupRelayMembers db vr user gInfo
         mods <- getGroupModerators db vr user gInfo
-        setGroupRosterVersion db (groupId' gInfo) rosterVer
+        setGroupRosterVersion db gInfo rosterVer
         pure (relays, buildGroupRoster rosterVer mods)
       forM_ (L.nonEmpty relays) $ \relays' ->
         void $ sendGroupMessage' user gInfo (L.toList relays') (XGrpRoster roster)

src/Simplex/Chat/Library/Subscriber.hs

@@ -3152,13 +3152,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
       where
         GroupRoster {version = newVer} = validRoster
         validRoster = validateGroupRoster roster
-        groupId = groupId' gInfo
         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 groupId newVer (groupMemberId' author) brokerTs sm
+                withStore' $ \db -> setCachedGroupRoster db gInfo newVer (groupMemberId' author) brokerTs sm
                 applyRosterRecords
                 -- always broadcast on a bump: self-healing, and demotions must reach members
                 pure $ Just DJSGroup {jobSpec = DJDeliveryJob {includePending = False}}
@@ -3168,28 +3167,35 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           | maybe False (newVer <=) (rosterVersion gInfo) = pure ()
           | otherwise = do
               applyRosterRecords
-              withStore' $ \db -> setGroupRosterVersion db groupId newVer
+              withStore' $ \db -> setGroupRosterVersion db gInfo newVer
         applyRosterRecords :: CM ()
         applyRosterRecords = do
           let GroupRoster {roster = entries} = validRoster
               rosterIds = map (\RosterMember {memberId} -> memberId) entries
-          mapM_ applyRosterEntry entries
-          -- absent privileged members revert to the joiner default
           defaultRole <- unknownMemberRole gInfo
-          currentPriv <- withStore' $ \db -> getGroupModerators db vr user gInfo
-          forM_ currentPriv $ \m ->
-            when (isRosterRole (memberRole' m) && memberId' m `notElem` rosterIds) $
-              withStore' $ \db -> updateGroupMemberRole db user m defaultRole
-        applyRosterEntry :: RosterMember -> CM ()
-        applyRosterEntry RosterMember {memberId, name, key = MemberKey pubKey, role} =
-          withStore' (\db -> runExceptT $ getCreateUnknownGMByMemberId db vr user gInfo memberId name role True) >>= \case
-            Right (Just (m@GroupMember {groupMemberId}, _created)) ->
+          warnings <- withStore' $ \db -> do
+            warnings <- forM entries (applyRosterEntryDB db)
+            -- absent privileged members revert to the joiner default
+            currentPriv <- getGroupModerators db vr user gInfo
+            forM_ currentPriv $ \m ->
+              when (isRosterRole (memberRole' m) && memberId' m `notElem` rosterIds) $
+                updateGroupMemberRole db user m defaultRole
+            pure warnings
+          sequence_ warnings
+        applyRosterEntryDB :: DB.Connection -> RosterMember -> IO (CM ())
+        applyRosterEntryDB db RosterMember {memberId, name, key = MemberKey pubKey, role} =
+          runExceptT (getCreateUnknownGMByMemberId db vr user gInfo memberId name role True) >>= \case
+            Right (Just (m, _created)) ->
               case memberPubKey m of
                 Just k
-                  | k == pubKey -> unless (memberRole' m == role) $ withStore' $ \db -> updateGroupMemberRole db user m role
-                  | otherwise -> messageWarning "x.grp.roster: member key conflict, keeping trusted key"
-                Nothing -> withStore' $ \db -> setGroupMemberKeyRole db groupMemberId pubKey role
-            _ -> messageError "x.grp.roster: could not get or create member record"
+                  | k == pubKey -> do
+                      unless (memberRole' m == role) $ updateGroupMemberRole db user m role
+                      pure (pure ())
+                  | otherwise -> pure (messageWarning $ "x.grp.roster: member key conflict, keeping trusted key, memberId=" <> safeDecodeUtf8 (strEncode memberId))
+                Nothing -> do
+                  setGroupMemberKeyRole db m pubKey role
+                  pure (pure ())
+            _ -> pure (messageError $ "x.grp.roster: could not get or create member record, memberId=" <> safeDecodeUtf8 (strEncode memberId))
         signedMsgBytes :: Maybe ByteString
         signedMsgBytes = case verifiedMsg of
           VMSigned _ sm _ -> Just $ smpEncode sm

src/Simplex/Chat/Store/Groups.hs

@@ -1381,14 +1381,14 @@ toGroupRelay ((groupRelayId, groupMemberId, chatRelayId, address, displayName, f
   let userChatRelay = UserChatRelay {chatRelayId, address, relayProfile = toRelayProfile (displayName, fullName, shortDescr, image), domains = T.splitOn "," domains, preset, tested = unBI <$> tested, enabled, deleted}
    in GroupRelay {groupRelayId, groupMemberId, userChatRelay, relayStatus, relayLink}
 
-setGroupRosterVersion :: DB.Connection -> GroupId -> Int -> IO ()
-setGroupRosterVersion db groupId v = do
+setGroupRosterVersion :: DB.Connection -> GroupInfo -> Int -> 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)
 
 -- Relay caches the verbatim signed roster (parts + sending owner + broker ts) to re-forward to joiners.
-setCachedGroupRoster :: DB.Connection -> GroupId -> Int -> GroupMemberId -> UTCTime -> SignedMsg -> IO ()
-setCachedGroupRoster db groupId v ownerGMId brokerTs SignedMsg {chatBinding, signatures, signedBody} = do
+setCachedGroupRoster :: DB.Connection -> GroupInfo -> Int -> GroupMemberId -> UTCTime -> SignedMsg -> IO ()
+setCachedGroupRoster db GroupInfo {groupId} v ownerGMId brokerTs SignedMsg {chatBinding, signatures, signedBody} = do
   currentTs <- getCurrentTime
   DB.execute
     db
@@ -1400,8 +1400,8 @@ setCachedGroupRoster db groupId v ownerGMId brokerTs SignedMsg {chatBinding, sig
     |]
     ((v, ownerGMId, brokerTs, chatBinding) :. (Binary (smpEncode signatures), Binary signedBody, currentTs, groupId))
 
-getCachedGroupRoster :: DB.Connection -> GroupId -> IO (Maybe (GroupMemberId, UTCTime, SignedMsg))
-getCachedGroupRoster db groupId =
+getCachedGroupRoster :: DB.Connection -> GroupInfo -> IO (Maybe (GroupMemberId, UTCTime, SignedMsg))
+getCachedGroupRoster db GroupInfo {groupId} =
   (>>= toRoster)
     <$> maybeFirstRow
       id
@@ -1415,10 +1415,10 @@ getCachedGroupRoster db groupId =
       (\sigs -> (ownerGMId, brokerTs, SignedMsg cb sigs body)) <$> eitherToMaybe (smpDecode sigsBs)
     toRoster _ = Nothing
 
-setGroupMemberKeyRole :: DB.Connection -> GroupMemberId -> C.PublicKeyEd25519 -> GroupMemberRole -> IO ()
-setGroupMemberKeyRole db gmId pubKey role = do
+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, gmId)
+  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 -> VersionRangeChat -> TVar ChaChaDRG -> User -> GroupInfo -> UserChatRelay -> ExceptT StoreError IO GroupMember
 createRelayForOwner db vr gVar user@User {userId, userContactId} GroupInfo {groupId, membership} UserChatRelay {relayProfile = RelayProfile {displayName}} = do