diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index ff79cfa01e..96727f7d3a 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -1240,7 +1240,7 @@ validateGroupRoster GroupRoster {version = ver, roster = entries} = | otherwise = rm : dedup (memberId : seen) rms -- Privileged members without a known key are skipped (recipients can't verify them). -buildGroupRoster :: Int -> [GroupMember] -> GroupRoster +buildGroupRoster :: VersionRoster -> [GroupMember] -> GroupRoster buildGroupRoster ver mods = GroupRoster {version = ver, roster = mapMaybe rosterMember mods} where rosterMember m@GroupMember {memberId, memberPubKey, memberRole} @@ -2144,7 +2144,7 @@ sendGroupMessage' user gInfo members chatMsgEvent = bumpAndBroadcastRoster :: User -> GroupInfo -> CM () bumpAndBroadcastRoster user gInfo = do vr <- chatVersionRange - let rosterVer = maybe 0 (+ 1) (rosterVersion gInfo) + let rosterVer = maybe (VersionRoster 0) (\(VersionRoster n) -> VersionRoster (n + 1)) (rosterVersion gInfo) (relays, roster) <- withStore' $ \db -> do relays <- getGroupRelayMembers db vr user gInfo mods <- getGroupRosterMembers db vr user gInfo diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 6346979412..8943834234 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -356,7 +356,7 @@ data GrpMsgForward = GrpMsgForward -- | Owner-signed snapshot of the privileged (moderator/admin) set; owners are -- not included, their keys come from the link. data GroupRoster = GroupRoster - { version :: Int, + { version :: VersionRoster, roster :: [RosterMember] } deriving (Eq, Show) diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index f697014143..11c4fd0798 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -1401,13 +1401,13 @@ 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 -> GroupInfo -> Int -> IO () +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) -- Relay caches the verbatim signed roster (parts + sending owner + broker ts) to re-forward to joiners. -setCachedGroupRoster :: DB.Connection -> GroupInfo -> Int -> GroupMemberId -> UTCTime -> SignedMsg -> IO () +setCachedGroupRoster :: DB.Connection -> GroupInfo -> VersionRoster -> GroupMemberId -> UTCTime -> SignedMsg -> IO () setCachedGroupRoster db GroupInfo {groupId} v ownerGMId brokerTs SignedMsg {chatBinding, signatures, signedBody} = do currentTs <- getCurrentTime DB.execute diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index ccb871ae90..1e2ae342c6 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -665,7 +665,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) :. (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 Int, 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) :. (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 GroupMemberRow = (GroupMemberId, GroupId, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId) :. ProfileRow :. (UTCTime, UTCTime) :. (Maybe UTCTime, Int64, Int64, Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe ShortLinkContact) diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 8aea4951ee..1d4189173c 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -487,7 +487,7 @@ data GroupInfo = GroupInfo uiThemes :: Maybe UIThemeEntityOverrides, customData :: Maybe CustomData, groupSummary :: GroupSummary, - rosterVersion :: Maybe Int, + rosterVersion :: Maybe VersionRoster, membersRequireAttention :: Int, viaGroupLinkUri :: Maybe ConnReqContact, groupKeys :: Maybe GroupKeys @@ -2030,6 +2030,17 @@ type VersionRangeChat = VersionRange ChatVersion pattern VersionChat :: Word16 -> VersionChat pattern VersionChat v = Version v +data RosterVersion + +instance VersionScope RosterVersion + +type VersionRoster = Version RosterVersion + +pattern VersionRoster :: Word16 -> VersionRoster +pattern VersionRoster v = Version v + +{-# COMPLETE VersionRoster #-} + -- 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)