wip

2026-07-02 04:51:49 +00:00 · 2026-06-29 15:20:52 +04:00
parent 3bc22dd3b9
commit 252b1e90dc
2 changed files with 46 additions and 17 deletions
@@ -1089,11 +1089,11 @@ 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 memberKey rosterVer -> fmap ctx <$> xGrpMemRole gInfo' m'' memId memRole memberKey rosterVer msg brokerTs
+              XGrpMemRole memId memRole memberKey rosterVer -> fmap ctx <$> xGrpMemRole gInfo' Nothing 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 rosterVer -> case encoding @e of
-                SJson -> fmap ctx <$> xGrpMemDel gInfo' m'' memId withMessages rosterVer verifiedMsg msg brokerTs False
+                SJson -> fmap ctx <$> xGrpMemDel gInfo' Nothing 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
@@ -1101,6 +1101,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
              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
+              XGrpRosterRequest reqVer -> Nothing <$ xGrpRosterRequest gInfo' m'' reqVer
              -- 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
@@ -3244,29 +3245,41 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
    -- 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
+    applyAtRosterVersion :: GroupInfo -> Maybe GroupMember -> GroupMember -> Maybe VersionRoster -> CM (Maybe DeliveryJobScope) -> CM (Maybe DeliveryJobScope)
+    applyAtRosterVersion gInfo fwdRelay_ 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
+            (accept, cur) <- withStore' $ \db -> do
              cur <- getGroupRosterVersion db gInfo
              let fresh = maybe True (v >=) cur
              when fresh $ setGroupRosterVersion db gInfo v
-              pure fresh
+              pure (fresh, cur)
            if accept
-              then action
+              then (requestRosterOnGap gInfo fwdRelay_ cur v `catchAllErrors` eToView) >> 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
+    -- A subscriber that skipped versions (cur known and v > cur+1) asks the relay that forwarded this delta
+    -- to re-serve the full roster, recovering the privileged set and keys carried by the missed versions.
+    -- The request carries the pre-gap cur (the relay serves only what it holds newer). Best-effort: a failed
+    -- request must not block applying the delta. Relays and the direct path don't request (fwdRelay_ is Nothing).
+    requestRosterOnGap :: GroupInfo -> Maybe GroupMember -> Maybe VersionRoster -> VersionRoster -> CM ()
+    requestRosterOnGap gInfo fwdRelay_ cur_ v
+      | isUserGrpFwdRelay gInfo = pure ()
+      | otherwise = case (fwdRelay_, cur_) of
+          (Just relay, Just cur@(VersionRoster c))
+            | v > VersionRoster (c + 1) -> void $ sendGroupMessage' user gInfo [relay] (XGrpRosterRequest cur)
+          _ -> pure ()
+
+    xGrpMemRole :: GroupInfo -> Maybe GroupMember -> GroupMember -> MemberId -> GroupMemberRole -> Maybe MemberKey -> Maybe VersionRoster -> RcvMessage -> UTCTime -> CM (Maybe DeliveryJobScope)
+    xGrpMemRole gInfo@GroupInfo {membership} fwdRelay_ m@GroupMember {memberRole = senderRole} memId memRole memberKey_ rosterVer_ msg@RcvMessage {msgSigned} brokerTs
      | membershipMemId == memId =
-          applyAtRosterVersion gInfo m rosterVer_ $
+          applyAtRosterVersion gInfo fwdRelay_ m rosterVer_ $
            let gInfo' = gInfo {membership = membership {memberRole = memRole}}
             in changeMemberRole gInfo' membership False (\db -> updateGroupMemberRole db user membership memRole) (RGEUserRole memRole) True
-      | otherwise = applyAtRosterVersion gInfo m rosterVer_ $ do
+      | otherwise = applyAtRosterVersion gInfo fwdRelay_ 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_
@@ -3483,6 +3496,15 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage =
            messageError $ "x.grp.roster.ack: relay could not save roster, marked rejected: " <> e
        _ -> pure ()

+    -- A relay re-serves the full roster to a subscriber that detected a version gap, but only when it holds
+    -- something newer than the requester's pre-gap version (rate-limiting same-version requests). serveRoster
+    -- is the join/resume path: signed header + inline blob chunks to the one requester; a no-op without a roster.
+    xGrpRosterRequest :: GroupInfo -> GroupMember -> VersionRoster -> CM ()
+    xGrpRosterRequest gInfo m reqVer =
+      when (isUserGrpFwdRelay gInfo) $ do
+        cur <- withStore' $ \db -> getGroupRosterVersion db gInfo
+        when (maybe True (> reqVer) cur) $ serveRoster user gInfo m
+
    checkHostRole :: GroupMember -> GroupMemberRole -> CM ()
    checkHostRole GroupMember {memberRole, localDisplayName} memRole =
      when (memberRole < GRAdmin || memberRole < memRole) $ throwChatError (CEGroupContactRole localDisplayName)
@@ -3527,11 +3549,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 -> 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
+    xGrpMemDel :: GroupInfo -> Maybe GroupMember -> GroupMember -> MemberId -> Bool -> Maybe VersionRoster -> VerifiedMsg 'Json -> RcvMessage -> UTCTime -> Bool -> CM (Maybe DeliveryJobScope)
+    xGrpMemDel gInfo@GroupInfo {membership} fwdRelay_ m@GroupMember {memberRole = senderRole} memId withMessages rosterVer_ verifiedMsg msg@RcvMessage {msgSigned} brokerTs forwarded = do
      let GroupMember {memberId = membershipMemId} = membership
      if membershipMemId == memId
-        then applyAtRosterVersion gInfo m rosterVer_ $ checkRole membership $ do
+        then applyAtRosterVersion gInfo fwdRelay_ 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
@@ -3543,7 +3565,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 applyAtRosterVersion gInfo m rosterVer_ $
+        else applyAtRosterVersion gInfo fwdRelay_ m rosterVer_ $
          withStore' (\db -> runExceptT $ getGroupMemberByMemberId db cxt user gInfo memId) >>= \case
            Left _ -> do
              messageError "x.grp.mem.del with unknown member ID"
@@ -3809,9 +3831,9 @@ 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 memberKey rosterVer -> withAuthor XGrpMemRole_ $ \author -> void $ xGrpMemRole gInfo author memId memRole memberKey rosterVer rcvMsg msgTs
+            XGrpMemRole memId memRole memberKey rosterVer -> withAuthor XGrpMemRole_ $ \author -> void $ xGrpMemRole gInfo (Just m) author memId memRole memberKey rosterVer rcvMsg msgTs
            XGrpMemRestrict memId memRestrictions -> withAuthor XGrpMemRestrict_ $ \author -> void $ xGrpMemRestrict gInfo author memId memRestrictions rcvMsg msgTs
-            XGrpMemDel memId withMessages rosterVer -> withAuthor XGrpMemDel_ $ \author -> void $ xGrpMemDel gInfo author memId withMessages rosterVer verifiedMsg rcvMsg msgTs True
+            XGrpMemDel memId withMessages rosterVer -> withAuthor XGrpMemDel_ $ \author -> void $ xGrpMemDel gInfo (Just m) 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
@@ -525,6 +525,7 @@ data ChatMsgEvent (e :: MsgEncoding) where
  XGrpDirectInv :: ConnReqInvitation -> Maybe MsgContent -> Maybe MsgScope -> ChatMsgEvent 'Json
  XGrpRoster :: GroupRoster -> ChatMsgEvent 'Json
  XGrpRosterAck :: VersionRoster -> Maybe Text -> ChatMsgEvent 'Json
+  XGrpRosterRequest :: VersionRoster -> ChatMsgEvent 'Json
  XGrpMsgForward :: GrpMsgForward -> ChatMessage 'Json -> ChatMsgEvent 'Json
  XInfoProbe :: Probe -> ChatMsgEvent 'Json
  XInfoProbeCheck :: ProbeHash -> ChatMsgEvent 'Json
@@ -1099,6 +1100,7 @@ data CMEventTag (e :: MsgEncoding) where
  XGrpDirectInv_ :: CMEventTag 'Json
  XGrpRoster_ :: CMEventTag 'Json
  XGrpRosterAck_ :: CMEventTag 'Json
+  XGrpRosterRequest_ :: CMEventTag 'Json
  XGrpMsgForward_ :: CMEventTag 'Json
  XInfoProbe_ :: CMEventTag 'Json
  XInfoProbeCheck_ :: CMEventTag 'Json
@@ -1161,6 +1163,7 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
    XGrpDirectInv_ -> "x.grp.direct.inv"
    XGrpRoster_ -> "x.grp.roster"
    XGrpRosterAck_ -> "x.grp.roster.ack"
+    XGrpRosterRequest_ -> "x.grp.roster.request"
    XGrpMsgForward_ -> "x.grp.msg.forward"
    XInfoProbe_ -> "x.info.probe"
    XInfoProbeCheck_ -> "x.info.probe.check"
@@ -1224,6 +1227,7 @@ instance StrEncoding ACMEventTag where
        "x.grp.direct.inv" -> XGrpDirectInv_
        "x.grp.roster" -> XGrpRoster_
        "x.grp.roster.ack" -> XGrpRosterAck_
+        "x.grp.roster.request" -> XGrpRosterRequest_
        "x.grp.msg.forward" -> XGrpMsgForward_
        "x.info.probe" -> XInfoProbe_
        "x.info.probe.check" -> XInfoProbeCheck_
@@ -1283,6 +1287,7 @@ toCMEventTag msg = case msg of
  XGrpDirectInv {} -> XGrpDirectInv_
  XGrpRoster _ -> XGrpRoster_
  XGrpRosterAck {} -> XGrpRosterAck_
+  XGrpRosterRequest _ -> XGrpRosterRequest_
  XGrpMsgForward {} -> XGrpMsgForward_
  XInfoProbe _ -> XInfoProbe_
  XInfoProbeCheck _ -> XInfoProbeCheck_
@@ -1444,6 +1449,7 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
      XGrpDirectInv_ -> XGrpDirectInv <$> p "connReq" <*> opt "content" <*> opt "scope"
      XGrpRoster_ -> XGrpRoster <$> (GroupRoster <$> p "version" <*> p "fileInv")
      XGrpRosterAck_ -> XGrpRosterAck <$> p "version" <*> opt "error"
+      XGrpRosterRequest_ -> XGrpRosterRequest <$> p "version"
      XGrpMsgForward_ -> do
        fwdSender <- opt "memberId" >>= \case
          Just memberId -> FwdMember memberId . fromMaybe "" <$> opt "memberName"
@@ -1518,6 +1524,7 @@ chatToAppMessage chatMsg@ChatMessage {chatVRange, msgId, chatMsgEvent} = case en
      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]
+      XGrpRosterRequest version -> o ["version" .= version]
      XGrpMsgForward GrpMsgForward {fwdSender, fwdBrokerTs} msg -> o $ encodeFwdSender fwdSender ["msg" .= msg, "msgTs" .= fwdBrokerTs]
        where
          encodeFwdSender = \case