core: request roster (#7121)

src/Simplex/Chat/Store/Groups.hs

@@ -92,7 +92,12 @@ module Simplex.Chat.Store.Groups
     getPublishableGroupRelays,
     setGroupRosterVersion,
     getGroupRosterVersion,
-    getGroupRoster,
+    getStoredRosterVersion,
+    setMemberRosterServedVersion,
+    getMemberRosterServedVersion,
+    setCompleteRosterVersion,
+    getCompleteRosterVersion,
+    getStoredGroupRoster,
     RcvRosterTransfer (..),
     createRosterTransfer,
     getRosterTransferVersion,
@@ -1499,21 +1504,57 @@ 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} =
+-- The version of the roster blob actually stored (written with the blob in setGroupLiveRoster), as opposed to
+-- roster_version (the acceptance gate). The owner sends the blob before the delta, so these normally match; a
+-- failed blob send leaves the gate (advanced by the delta) ahead of the stored blob until a later roster completes.
+getStoredRosterVersion :: DB.Connection -> GroupInfo -> IO (Maybe VersionRoster)
+getStoredRosterVersion db GroupInfo {groupId} =
+  fmap join . maybeFirstRow fromOnly $
+    DB.query db "SELECT stored_roster_version FROM groups WHERE group_id = ?" (Only groupId)
+
+-- The newest roster version a relay re-served to this member on its catch-up request: bounds reflected
+-- amplification, so a member can't re-trigger a full serve at a version it was already served.
+setMemberRosterServedVersion :: DB.Connection -> GroupMember -> VersionRoster -> IO ()
+setMemberRosterServedVersion db GroupMember {groupMemberId} v = do
+  currentTs <- getCurrentTime
+  DB.execute db "UPDATE group_members SET roster_served_version = ?, updated_at = ? WHERE group_member_id = ?" (v, currentTs, groupMemberId)
+
+getMemberRosterServedVersion :: DB.Connection -> GroupMember -> IO (Maybe VersionRoster)
+getMemberRosterServedVersion db GroupMember {groupMemberId} =
+  fmap join . maybeFirstRow fromOnly $
+    DB.query db "SELECT roster_served_version FROM group_members WHERE group_member_id = ?" (Only groupMemberId)
+
+-- The highest version up to which the subscriber holds a complete, contiguous picture: advances by 1 on a
+-- contiguous delta and to the roster's version on a roster apply, but stays put on a gapped delta (so a stuck
+-- value re-triggers the catch-up request on every following delta until a roster fills the gap). This is the
+-- subscriber's "what I have" for both gap detection and the request - as opposed to roster_version (highest seen,
+-- the revert gate) and stored_roster_version (the blob a relay holds).
+setCompleteRosterVersion :: DB.Connection -> GroupInfo -> VersionRoster -> IO ()
+setCompleteRosterVersion db GroupInfo {groupId} v = do
+  currentTs <- getCurrentTime
+  DB.execute db "UPDATE groups SET applied_complete_roster_version = ?, updated_at = ? WHERE group_id = ?" (v, currentTs, groupId)
+
+getCompleteRosterVersion :: DB.Connection -> GroupInfo -> IO (Maybe VersionRoster)
+getCompleteRosterVersion db GroupInfo {groupId} =
+  fmap join . maybeFirstRow fromOnly $
+    DB.query db "SELECT applied_complete_roster_version FROM groups WHERE group_id = ?" (Only groupId)
+
+-- The live roster header a relay re-serves to joiners, with the completed blob and its stored version
+-- (all written together at completion, so the blob and version are present whenever the header is).
+-- Returns the stored version, not roster_version (the gate), so callers serve/record exactly what they hold.
+getStoredGroupRoster :: DB.Connection -> GroupInfo -> IO (Maybe (GroupMemberId, UTCTime, SignedMsg, Maybe ByteString, Maybe VersionRoster))
+getStoredGroupRoster 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 = ?"
+          "SELECT roster_sending_owner_gm_id, roster_broker_ts, roster_msg_chat_binding, roster_msg_signatures, roster_msg_body, roster_blob, stored_roster_version 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 (Just ownerGMId, Just brokerTs, Just cb, Just (Binary sigsBs), Just (Binary body), blob_, storedVer_) =
+      (\sigs -> (ownerGMId, brokerTs, SignedMsg cb sigs body, (\(Binary b) -> b) <$> blob_, storedVer_)) <$> eitherToMaybe (smpDecode sigsBs)
     toRoster _ = Nothing
 
 -- A per-source in-flight roster transfer, keyed (group_id, from_member_id): replaces the single
@@ -1598,6 +1639,10 @@ getRosterTransfer db fileId =
 
 -- 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).
+-- Sets all three versions to the completed blob's version: the gate (roster_version - refuse anything older),
+-- the stored version (stored_roster_version - the blob actually held and re-served), and the complete frontier
+-- (applied_complete_roster_version - a snapshot makes the picture complete up to its version). Deltas advance the
+-- gate always and the complete frontier only when contiguous, so complete <= stored <= roster_version normally.
 setGroupLiveRoster :: DB.Connection -> GroupInfo -> VersionRoster -> GroupMemberId -> UTCTime -> Maybe SignedMsg -> ByteString -> IO ()
 setGroupLiveRoster db GroupInfo {groupId} v ownerGMId brokerTs sm_ blob = do
   currentTs <- getCurrentTime
@@ -1605,13 +1650,13 @@ setGroupLiveRoster db GroupInfo {groupId} v ownerGMId brokerTs sm_ blob = do
     db
     [sql|
       UPDATE groups SET
-        roster_version = ?, roster_blob = ?,
+        roster_version = ?, stored_roster_version = ?, applied_complete_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)
+    ( (v, v, v, Binary blob, ownerGMId, brokerTs)
         :. ((\SignedMsg {chatBinding} -> chatBinding) <$> sm_, (\SignedMsg {signatures} -> Binary (smpEncode signatures)) <$> sm_, (\SignedMsg {signedBody} -> Binary signedBody) <$> sm_, currentTs, groupId)
     )