diff --git a/apps/simplex-directory-service/src/Directory/Store/Migrate.hs b/apps/simplex-directory-service/src/Directory/Store/Migrate.hs
index ad37eba6d7..e22f4ed470 100644
--- a/apps/simplex-directory-service/src/Directory/Store/Migrate.hs
+++ b/apps/simplex-directory-service/src/Directory/Store/Migrate.hs
@@ -46,7 +46,7 @@ runDirectoryMigrations :: DirectoryOpts -> ChatConfig -> DBStore -> IO ()
runDirectoryMigrations opts ChatConfig {confirmMigrations} chatStore =
migrateDBSchema
chatStore
- (toDBOpts dbOptions chatSuffix False)
+ (toDBOpts dbOptions chatSuffix False [])
(Just "sx_directory_migrations")
directorySchemaMigrations
MigrationConfig {confirm, backupPath = Nothing}
diff --git a/bots/api/TYPES.md b/bots/api/TYPES.md
index 9140f3b164..62c5dff3b5 100644
--- a/bots/api/TYPES.md
+++ b/bots/api/TYPES.md
@@ -3349,6 +3349,14 @@ GroupMemberNotFound:
- type: "groupMemberNotFound"
- groupMemberId: int64
+GroupMemberNotFoundByIndex:
+- type: "groupMemberNotFoundByIndex"
+- groupMemberIndex: int64
+
+MemberRelationsVectorNotFound:
+- type: "memberRelationsVectorNotFound"
+- groupMemberId: int64
+
GroupHostMemberNotFound:
- type: "groupHostMemberNotFound"
- groupId: int64
@@ -3361,6 +3369,9 @@ MemberContactGroupMemberNotFound:
- type: "memberContactGroupMemberNotFound"
- contactId: int64
+InvalidMemberRelationUpdate:
+- type: "invalidMemberRelationUpdate"
+
GroupWithoutUser:
- type: "groupWithoutUser"
@@ -3447,9 +3458,6 @@ PendingConnectionNotFound:
- type: "pendingConnectionNotFound"
- connId: int64
-IntroNotFound:
-- type: "introNotFound"
-
UniqueID:
- type: "uniqueID"
diff --git a/cabal.project b/cabal.project
index df5ac1ba24..9f8d821a2e 100644
--- a/cabal.project
+++ b/cabal.project
@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
- tag: 3016b929b48d3116f8ee60169c06383ca57f78e0
+ tag: 92a9579e6958026e42a45e32c0e62fca243b4b0f
source-repository-package
type: git
diff --git a/docs/rfcs/2025-11-24-member-relations-vector.md b/docs/rfcs/2025-11-24-member-relations-vector.md
index c4e8cf7224..087541fda3 100644
--- a/docs/rfcs/2025-11-24-member-relations-vector.md
+++ b/docs/rfcs/2025-11-24-member-relations-vector.md
@@ -72,10 +72,11 @@ note over A, B: Vectors (only Dan/Cath relation interests us
- we want to avo
note left of A: Alice vectors
For Cath: Dan - MRNew
For Dan: Cath - MRNew
note right of B: Bob vectors
For Cath: Dan - MRIntroduced
For Dan: Cath - MRIntroducedTo
note over A, B: Only Bob forwards between Cath and Dan
+C <<->> D: connect
C ->> B: x.grp.mem.con (connected to Dan)
D ->> B: or: x.grp.mem.con (connected to Cath)
(x.grp.mem.con from either is enough)
note right of B: Bob vectors
For Cath: Dan - MRConnected
For Dan: Cath - MRConnected
-note over A, B: Only Bob forwards between Cath and Dan
+note over A, B: Bob stops forwarding between Cath and Dan
```
### Avoid duplicate introductions
diff --git a/packages/simplex-chat-client/types/typescript/src/types.ts b/packages/simplex-chat-client/types/typescript/src/types.ts
index e67eae39a0..5e3309238b 100644
--- a/packages/simplex-chat-client/types/typescript/src/types.ts
+++ b/packages/simplex-chat-client/types/typescript/src/types.ts
@@ -3735,9 +3735,12 @@ export type StoreError =
| StoreError.GroupNotFoundByName
| StoreError.GroupMemberNameNotFound
| StoreError.GroupMemberNotFound
+ | StoreError.GroupMemberNotFoundByIndex
+ | StoreError.MemberRelationsVectorNotFound
| StoreError.GroupHostMemberNotFound
| StoreError.GroupMemberNotFoundByMemberId
| StoreError.MemberContactGroupMemberNotFound
+ | StoreError.InvalidMemberRelationUpdate
| StoreError.GroupWithoutUser
| StoreError.DuplicateGroupMember
| StoreError.GroupAlreadyJoined
@@ -3761,7 +3764,6 @@ export type StoreError =
| StoreError.ConnectionNotFoundById
| StoreError.ConnectionNotFoundByMemberId
| StoreError.PendingConnectionNotFound
- | StoreError.IntroNotFound
| StoreError.UniqueID
| StoreError.LargeMsg
| StoreError.InternalError
@@ -3820,9 +3822,12 @@ export namespace StoreError {
| "groupNotFoundByName"
| "groupMemberNameNotFound"
| "groupMemberNotFound"
+ | "groupMemberNotFoundByIndex"
+ | "memberRelationsVectorNotFound"
| "groupHostMemberNotFound"
| "groupMemberNotFoundByMemberId"
| "memberContactGroupMemberNotFound"
+ | "invalidMemberRelationUpdate"
| "groupWithoutUser"
| "duplicateGroupMember"
| "groupAlreadyJoined"
@@ -3846,7 +3851,6 @@ export namespace StoreError {
| "connectionNotFoundById"
| "connectionNotFoundByMemberId"
| "pendingConnectionNotFound"
- | "introNotFound"
| "uniqueID"
| "largeMsg"
| "internalError"
@@ -3988,6 +3992,16 @@ export namespace StoreError {
groupMemberId: number // int64
}
+ export interface GroupMemberNotFoundByIndex extends Interface {
+ type: "groupMemberNotFoundByIndex"
+ groupMemberIndex: number // int64
+ }
+
+ export interface MemberRelationsVectorNotFound extends Interface {
+ type: "memberRelationsVectorNotFound"
+ groupMemberId: number // int64
+ }
+
export interface GroupHostMemberNotFound extends Interface {
type: "groupHostMemberNotFound"
groupId: number // int64
@@ -4003,6 +4017,10 @@ export namespace StoreError {
contactId: number // int64
}
+ export interface InvalidMemberRelationUpdate extends Interface {
+ type: "invalidMemberRelationUpdate"
+ }
+
export interface GroupWithoutUser extends Interface {
type: "groupWithoutUser"
}
@@ -4112,10 +4130,6 @@ export namespace StoreError {
connId: number // int64
}
- export interface IntroNotFound extends Interface {
- type: "introNotFound"
- }
-
export interface UniqueID extends Interface {
type: "uniqueID"
}
diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix
index 7acb51e97c..406ef76cc5 100644
--- a/scripts/nix/sha256map.nix
+++ b/scripts/nix/sha256map.nix
@@ -1,5 +1,5 @@
{
- "https://github.com/simplex-chat/simplexmq.git"."3016b929b48d3116f8ee60169c06383ca57f78e0" = "1gvv96w1ag8xh19an5j50isjw0yq1cbsywii5s1adaplr6fw34mb";
+ "https://github.com/simplex-chat/simplexmq.git"."92a9579e6958026e42a45e32c0e62fca243b4b0f" = "0hacyi4hsbca55l4n2n4pcsmsfvh2jaw681j6106y5mkillmb3fv";
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
"https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
"https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";
diff --git a/simplex-chat.cabal b/simplex-chat.cabal
index 24ccf24ded..bc49fc0b45 100644
--- a/simplex-chat.cabal
+++ b/simplex-chat.cabal
@@ -123,6 +123,7 @@ library
Simplex.Chat.Store.Postgres.Migrations.M20251007_connections_sync
Simplex.Chat.Store.Postgres.Migrations.M20251017_chat_tags_cascade
Simplex.Chat.Store.Postgres.Migrations.M20251117_member_relations_vector
+ Simplex.Chat.Store.Postgres.Migrations.M20251128_member_relations_vector_stage_2
else
exposed-modules:
Simplex.Chat.Archive
@@ -269,6 +270,7 @@ library
Simplex.Chat.Store.SQLite.Migrations.M20251007_connections_sync
Simplex.Chat.Store.SQLite.Migrations.M20251017_chat_tags_cascade
Simplex.Chat.Store.SQLite.Migrations.M20251117_member_relations_vector
+ Simplex.Chat.Store.SQLite.Migrations.M20251128_member_relations_vector_stage_2
other-modules:
Paths_simplex_chat
hs-source-dirs:
diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs
index 9b711c2b50..93132fb413 100644
--- a/src/Simplex/Chat.hs
+++ b/src/Simplex/Chat.hs
@@ -118,8 +118,8 @@ logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
createChatDatabase :: ChatDbOpts -> MigrationConfig -> IO (Either MigrationError ChatDatabase)
createChatDatabase chatDbOpts migrationConfig = runExceptT $ do
- chatStore <- ExceptT $ createChatStore (toDBOpts chatDbOpts chatSuffix False) migrationConfig
- agentStore <- ExceptT $ createAgentStore (toDBOpts chatDbOpts agentSuffix False) migrationConfig
+ chatStore <- ExceptT $ createChatStore (toDBOpts chatDbOpts chatSuffix False chatDBFunctions) migrationConfig
+ agentStore <- ExceptT $ createAgentStore (toDBOpts chatDbOpts agentSuffix False []) migrationConfig
pure ChatDatabase {chatStore, agentStore}
newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Bool -> IO ChatController
diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs
index 630cad4e70..7f4ee238b1 100644
--- a/src/Simplex/Chat/Library/Commands.hs
+++ b/src/Simplex/Chat/Library/Commands.hs
@@ -167,6 +167,9 @@ startChatController mainApp enableSndFiles = do
runExceptT (syncConnections' users) >>= \case
Left e -> liftIO $ putStrLn $ "Error synchronizing connections: " <> show e
Right _ -> pure ()
+ runExceptT migrateMemberRelations >>= \case
+ Left e -> liftIO $ putStrLn $ "Error migrating member relations: " <> show e
+ Right _ -> pure ()
restoreCalls
s <- asks agentAsync
readTVarIO s >>= maybe (start s users) (pure . fst)
@@ -178,6 +181,10 @@ startChatController mainApp enableSndFiles = do
(userDiff, connDiff) <- withAgent (\a -> syncConnections a aUserIds connIds)
withFastStore' setConnectionsSyncTs
toView $ CEvtConnectionsDiff (AgentUserId <$> userDiff) (AgentConnId <$> connDiff)
+ migrateMemberRelations =
+ when mainApp $
+ whenM (withStore' hasMembersWithoutVector) $
+ void $ forkIO runRelationsVectorMigration
start s users = do
a1 <- async agentSubscriber
a2 <-
@@ -4163,6 +4170,21 @@ agentSubscriber = do
type AgentSubResult = Map ConnId (Either AgentErrorType (Maybe ClientServiceId))
+runRelationsVectorMigration :: CM ()
+runRelationsVectorMigration = do
+ liftIO $ threadDelay' 5000000 -- 5 seconds (initial delay)
+ migrateMembers
+ where
+ stepDelay = 1000000 -- 1 second
+ migrateMembers = flip catchAllErrors eToView $ do
+ lift waitChatStartedAndActivated
+ gmIds <- withStore' getGMsWithoutVectorIds
+ forM_ gmIds $ \gmId -> do
+ lift waitChatStartedAndActivated
+ withStore' (`migrateMemberRelationsVector'` gmId) `catchAllErrors` eToView
+ liftIO $ threadDelay' stepDelay
+ unless (null gmIds) migrateMembers
+
cleanupManager :: CM ()
cleanupManager = do
interval <- asks (cleanupManagerInterval . config)
diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs
index 711a24c79e..523224c76d 100644
--- a/src/Simplex/Chat/Library/Internal.hs
+++ b/src/Simplex/Chat/Library/Internal.hs
@@ -73,6 +73,7 @@ import Simplex.Chat.Store.Messages
import Simplex.Chat.Store.Profiles
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
+import Simplex.Chat.Types.MemberRelations
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Util (encryptFile, shuffle)
@@ -1024,65 +1025,84 @@ introduceToModerators :: VersionRangeChat -> User -> GroupInfo -> GroupMember ->
introduceToModerators vr user gInfo@GroupInfo {groupId} m@GroupMember {memberRole, memberId} = do
forM_ (memberConn m) $ \mConn -> do
let msg =
- if (maxVersion (memberChatVRange m) >= groupKnockingVersion)
+ if maxVersion (memberChatVRange m) >= groupKnockingVersion
then XGrpLinkAcpt GAPendingReview memberRole memberId
else XMsgNew $ MCSimple $ extMsgContent (MCText pendingReviewMessage) Nothing
void $ sendDirectMemberMessage mConn msg groupId
modMs <- withStore' $ \db -> getGroupModerators db vr user gInfo
- let rcpModMs = filter (\mem -> memberCurrent mem && maxVersion (memberChatVRange mem) >= groupKnockingVersion) modMs
+ let rcpModMs = filter shouldIntroduce modMs
introduceMember vr user gInfo m rcpModMs (Just $ MSMember $ memberId' m)
+ where
+ shouldIntroduce :: GroupMember -> Bool
+ shouldIntroduce mem =
+ memberCurrent mem
+ && groupMemberId' mem /= groupMemberId' m
+ && maxVersion (memberChatVRange mem) >= groupKnockingVersion
introduceToAll :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
introduceToAll vr user gInfo m = do
- members <- withStore' $ \db -> getGroupMembersForIntroduction db vr user gInfo m
- let recipients = filter memberCurrent members
+ members <- withStore' $ \db -> getGroupMembers db vr user gInfo
+ vector_ <- withStore' (`getMemberRelationsVector_` m)
+ let recipients = filter (shouldIntroduce vector_) members
introduceMember vr user gInfo m recipients Nothing
+ where
+ shouldIntroduce :: Maybe ByteString -> GroupMember -> Bool
+ shouldIntroduce vector_ m' =
+ memberCurrent m'
+ && groupMemberId' m' /= groupMemberId' m
+ && maybe True (\v -> getRelation (indexInGroup m') v == MRNew) vector_
introduceToRemaining :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
introduceToRemaining vr user gInfo m = do
- (members, introducedGMIds) <-
- withStore' $ \db -> (,) <$> getGroupMembersForIntroduction db vr user gInfo m <*> getIntroducedGroupMemberIds db m
- let recipients = filter (introduceMemP introducedGMIds) members
+ members <- withStore' $ \db -> getGroupMembers db vr user gInfo
+ vector_ <- withStore' (`getMemberRelationsVector_` m)
+ recipients <- filterRecipients vector_ members
introduceMember vr user gInfo m recipients Nothing
where
- introduceMemP introducedGMIds mem =
- memberCurrent mem
- && groupMemberId' mem `notElem` introducedGMIds
- && groupMemberId' mem /= groupMemberId' m
+ filterRecipients :: Maybe ByteString -> [GroupMember] -> CM [GroupMember]
+ filterRecipients vector_ members = do
+ newRelation <- case vector_ of
+ Nothing -> do
+ introducedGMIds <- S.fromList <$> withStore' (`getIntroducedGroupMemberIds` m)
+ pure $ \m' -> groupMemberId' m' `S.notMember` introducedGMIds
+ Just vec -> pure $ \m' -> getRelation (indexInGroup m') vec == MRNew
+ pure $ filter (\m' -> groupMemberId' m' /= groupMemberId' m && memberCurrent m' && newRelation m') members
introduceMember :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> [GroupMember] -> Maybe MsgScope -> CM ()
introduceMember _ _ _ GroupMember {activeConn = Nothing} _ _ = throwChatError $ CEInternalError "member connection not active"
-introduceMember vr user gInfo@GroupInfo {groupId} m@GroupMember {activeConn = Just conn} introduceToMembers msgScope = do
- void . sendGroupMessage' user gInfo introduceToMembers $ XGrpMemNew (memberInfo gInfo m) msgScope
+introduceMember vr user gInfo@GroupInfo {groupId} toMember@GroupMember {activeConn = Just conn} introduceToMembers msgScope = do
+ void . sendGroupMessage' user gInfo introduceToMembers $ XGrpMemNew (memberInfo gInfo toMember) msgScope
sendIntroductions introduceToMembers
where
- sendIntroductions members = do
- intros <- withStore' $ \db -> createIntroductions db (maxVersion vr) members m
- shuffledIntros <- liftIO $ shuffleIntros intros
- if m `supportsVersion` batchSendVersion
+ sendIntroductions reMembers = do
+ updateToMemberVector reMembers
+ reMembers' <- withStore' $ \db -> createIntrosOrUpdateVectors db vr reMembers toMember
+ shuffledReMembers <- liftIO $ shuffleMembers reMembers'
+ if toMember `supportsVersion` batchSendVersion
then do
- let events = map (memberIntro . reMember) shuffledIntros
+ let events = map memberIntro shuffledReMembers
forM_ (L.nonEmpty events) $ \events' ->
sendGroupMemberMessages user conn events' groupId
- else forM_ shuffledIntros $ \intro ->
- processIntro intro `catchAllErrors` eToView
+ else forM_ shuffledReMembers $ \reMember ->
+ void $ sendDirectMemberMessage conn (memberIntro reMember) groupId
+ updateToMemberVector :: [GroupMember] -> CM ()
+ updateToMemberVector reMembers = do
+ let relations = map (\GroupMember {indexInGroup} -> (indexInGroup, (IDReferencedIntroduced, MRIntroduced))) reMembers
+ withStore' $ \db -> setMemberVectorNewRelations db toMember relations
memberIntro :: GroupMember -> ChatMsgEvent 'Json
memberIntro reMember =
let mInfo = memberInfo gInfo reMember
mRestrictions = memberRestrictions reMember
in XGrpMemIntro mInfo mRestrictions
- shuffleIntros :: [GroupMemberIntro] -> IO [GroupMemberIntro]
- shuffleIntros intros = do
- let (admins, others) = partition isAdmin intros
+ shuffleMembers :: [GroupMember] -> IO [GroupMember]
+ shuffleMembers reMembers = do
+ let (admins, others) = partition isAdmin reMembers
(admPics, admNoPics) = partition hasPicture admins
(othPics, othNoPics) = partition hasPicture others
mconcat <$> mapM shuffle [admPics, admNoPics, othPics, othNoPics]
where
- isAdmin GroupMemberIntro {reMember = GroupMember {memberRole}} = memberRole >= GRAdmin
- hasPicture GroupMemberIntro {reMember = GroupMember {memberProfile = LocalProfile {image}}} = isJust image
- processIntro intro@GroupMemberIntro {introId} = do
- void $ sendDirectMemberMessage conn (memberIntro $ reMember intro) groupId
- withStore' $ \db -> updateIntroStatus db introId GMIntroSent
+ isAdmin GroupMember {memberRole} = memberRole >= GRAdmin
+ hasPicture GroupMember {memberProfile = LocalProfile {image}} = isJust image
userProfileInGroup :: User -> GroupInfo -> Maybe Profile -> Profile
userProfileInGroup user = userProfileInGroup' user . groupFeatureUserAllowed SGFSimplexLinks
@@ -2047,8 +2067,8 @@ readyMemberConn GroupMember {groupMemberId, activeConn = Just conn@Connection {c
| otherwise = Nothing
readyMemberConn GroupMember {activeConn = Nothing} = Nothing
-sendGroupMemberMessage :: MsgEncodingI e => GroupInfo -> GroupMember -> ChatMsgEvent e -> Maybe Int64 -> CM () -> CM ()
-sendGroupMemberMessage gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId} chatMsgEvent introId_ postDeliver = do
+sendGroupMemberMessage :: MsgEncodingI e => GroupInfo -> GroupMember -> ChatMsgEvent e -> Maybe GroupMemberIntro -> CM () -> CM ()
+sendGroupMemberMessage gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId} chatMsgEvent intro_ postDeliver = do
msg <- createSndMessage chatMsgEvent (GroupId groupId)
messageMember msg `catchAllErrors` eToView
where
@@ -2056,7 +2076,7 @@ sendGroupMemberMessage gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId} c
messageMember SndMessage {msgId, msgBody} = forM_ (memberSendAction gInfo (chatMsgEvent :| []) [m] m) $ \case
MSASend conn -> deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId >> postDeliver
MSASendBatched conn -> deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId >> postDeliver
- MSAPending -> withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_
+ MSAPending -> withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId (introId <$> intro_)
MSAForwarded -> pure ()
-- TODO ensure order - pending messages interleave with user input messages
diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs
index 5073da9c77..27f3a4f61c 100644
--- a/src/Simplex/Chat/Library/Subscriber.hs
+++ b/src/Simplex/Chat/Library/Subscriber.hs
@@ -28,7 +28,7 @@ import Data.Either (lefts, partitionEithers, rights)
import Data.Foldable (foldr')
import Data.Functor (($>))
import Data.Int (Int64)
-import Data.List (find, foldl')
+import Data.List (find)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
@@ -62,6 +62,7 @@ import Simplex.Chat.Store.Messages
import Simplex.Chat.Store.Profiles
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
+import Simplex.Chat.Types.MemberRelations
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.FileTransfer.Description (ValidFileDescription)
@@ -2615,13 +2616,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case
Left _ -> messageError "x.grp.mem.inv error: referenced member does not exist"
Right reMember -> do
- introId <- withStore $ \db -> do
- GroupMemberIntro {introId} <- getIntroduction db reMember m
- liftIO $ updateIntroStatus db introId GMIntroInvReceived
- pure introId
- sendGroupMemberMessage gInfo reMember (XGrpMemFwd (memberInfo gInfo m) introInv) (Just introId) $
- withStore' $
- \db -> updateIntroStatus db introId GMIntroInvForwarded
+ intro_ <- withStore' $ \db -> getIntroduction db reMember m
+ update intro_ GMIntroInvReceived
+ sendGroupMemberMessage gInfo reMember (XGrpMemFwd (memberInfo gInfo m) introInv) intro_ $
+ update intro_ GMIntroInvForwarded
+ where
+ update (Just GroupMemberIntro {introId}) status = withStore' $ \db -> updateIntroStatus db introId status
+ update Nothing _ = pure ()
_ -> messageError "x.grp.mem.inv can be only sent by invitee member"
xGrpMemFwd :: GroupInfo -> GroupMember -> MemberInfo -> IntroInvitation -> CM ()
@@ -2715,45 +2716,13 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
blocked = mrsBlocked restriction
xGrpMemCon :: GroupInfo -> GroupMember -> MemberId -> CM ()
- xGrpMemCon gInfo sendingMember memId = do
- refMember <- withStore $ \db -> getGroupMemberByMemberId db vr user gInfo memId
- case (memberCategory sendingMember, memberCategory refMember) of
- (GCInviteeMember, GCInviteeMember) ->
- withStore' (\db -> runExceptT $ getIntroduction db refMember sendingMember) >>= \case
- Right intro -> inviteeXGrpMemCon intro
- Left _ ->
- withStore' (\db -> runExceptT $ getIntroduction db sendingMember refMember) >>= \case
- Right intro -> forwardMemberXGrpMemCon intro
- Left _ -> messageWarning "x.grp.mem.con: no introduction"
- (GCInviteeMember, _) ->
- withStore' (\db -> runExceptT $ getIntroduction db refMember sendingMember) >>= \case
- Right intro -> inviteeXGrpMemCon intro
- Left _ -> messageWarning "x.grp.mem.con: no introduction"
- (_, GCInviteeMember) ->
- withStore' (\db -> runExceptT $ getIntroduction db sendingMember refMember) >>= \case
- Right intro -> forwardMemberXGrpMemCon intro
- Left _ -> messageWarning "x.grp.mem.con: no introductiosupportn"
- -- Note: we can allow XGrpMemCon to all member categories if we decide to support broader group forwarding,
- -- deduplication (see saveGroupRcvMsg, saveGroupFwdRcvMsg) already supports sending XGrpMemCon
- -- to any forwarding member, not only host/inviting member;
- -- database would track all members connections then
- -- (currently it's done via group_member_intros for introduced connections only)
- _ ->
- messageWarning "x.grp.mem.con: neither member is invitee"
- where
- inviteeXGrpMemCon :: GroupMemberIntro -> CM ()
- inviteeXGrpMemCon GroupMemberIntro {introId, introStatus} = case introStatus of
- GMIntroReConnected -> updateStatus introId GMIntroConnected
- GMIntroToConnected -> pure ()
- GMIntroConnected -> pure ()
- _ -> updateStatus introId GMIntroToConnected
- forwardMemberXGrpMemCon :: GroupMemberIntro -> CM ()
- forwardMemberXGrpMemCon GroupMemberIntro {introId, introStatus} = case introStatus of
- GMIntroToConnected -> updateStatus introId GMIntroConnected
- GMIntroReConnected -> pure ()
- GMIntroConnected -> pure ()
- _ -> updateStatus introId GMIntroReConnected
- updateStatus introId status = withStore' $ \db -> updateIntroStatus db introId status
+ xGrpMemCon gInfo sendingMem memId = do
+ refMem <- withStore $ \db -> getGroupMemberByMemberId db vr user gInfo memId
+ withStore' (`migrateMemberRelationsVector` sendingMem)
+ withStore' (`migrateMemberRelationsVector` refMem)
+ -- Updating vectors in separate transactions to avoid deadlocks.
+ withStore $ \db -> setMemberVectorRelationConnected db sendingMem refMem MRSubjectConnected
+ withStore $ \db -> setMemberVectorRelationConnected db refMem sendingMem MRReferencedConnected
xGrpMemDel :: GroupInfo -> GroupMember -> MemberId -> Bool -> ChatMessage 'Json -> RcvMessage -> UTCTime -> Bool -> CM (Maybe DeliveryJobScope)
xGrpMemDel gInfo@GroupInfo {membership} m@GroupMember {memberRole = senderRole} memId withMessages chatMsg msg brokerTs forwarded = do
@@ -3238,10 +3207,10 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
DJSMemberSupport scopeGMId -> do
-- for member support scope we just load all recipients in one go, without cursor
modMs <- withStore' $ \db -> getGroupModerators db vr user gInfo
- let moderatorFilter mem =
- memberCurrent mem
- && maxVersion (memberChatVRange mem) >= groupKnockingVersion
- && Just (groupMemberId' mem) /= singleSenderGMId_
+ let moderatorFilter m =
+ memberCurrent m
+ && maxVersion (memberChatVRange m) >= groupKnockingVersion
+ && Just (groupMemberId' m) /= singleSenderGMId_
modMs' = filter moderatorFilter modMs
mems <-
if Just scopeGMId == singleSenderGMId_
@@ -3255,42 +3224,30 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
Nothing -> throwChatError $ CEInternalError "delivery job worker: singleSenderGMId is required when not using relays"
Just singleSenderGMId -> do
sender <- withStore $ \db -> getGroupMemberById db vr user singleSenderGMId
- mems <- buildMemberList sender
- unless (null mems) $ deliver body mems
+ ms <- buildMemberList sender
+ unless (null ms) $ deliver body ms
where
- buildMemberList sender = case jobScope of
- DJSGroup {jobSpec}
- | jobSpecImpliedPending jobSpec ->
- filter memberCurrentOrPending <$> getAllIntroducedAndInvited
- | otherwise ->
- filter memberCurrent <$> getAllIntroducedAndInvited
- DJSMemberSupport scopeGMId -> do
- -- moderators introduced to this invited member
- introducedModMs <-
- if memberCategory sender == GCInviteeMember
- then withStore' $ \db -> getForwardIntroducedModerators db vr user sender
- else pure []
- -- invited moderators to which this member was introduced
- invitedModMs <- withStore' $ \db -> getForwardInvitedModerators db vr user sender
- let modMs = introducedModMs <> invitedModMs
- modMs' = filter (\mem -> memberCurrent mem && maxVersion (memberChatVRange mem) >= groupKnockingVersion) modMs
- if scopeGMId == groupMemberId' sender
- then pure modMs'
- else
- withStore' (\db -> getForwardScopeMember db vr user sender scopeGMId) >>= \case
- Just scopeMem -> pure $ scopeMem : modMs'
- _ -> pure modMs'
- where
- getAllIntroducedAndInvited = do
- ChatConfig {highlyAvailable} <- asks config
- -- members introduced to this invited member
- introducedMembers <-
- if memberCategory sender == GCInviteeMember
- then withStore' $ \db -> getForwardIntroducedMembers db vr user sender highlyAvailable
- else pure []
- -- invited members to which this member was introduced
- invitedMembers <- withStore' $ \db -> getForwardInvitedMembers db vr user sender highlyAvailable
- pure $ introducedMembers <> invitedMembers
+ buildMemberList sender = do
+ vec <- withStore $ \db -> migrateGetMemberRelationsVector db sender
+ -- this excludes the sender
+ let introducedMemsIdxs = getRelationsIndexes MRIntroduced vec
+ case jobScope of
+ DJSGroup {jobSpec} -> do
+ ms <- withStore' $ \db -> getGroupMembersByIndexes db vr user gInfo introducedMemsIdxs
+ pure $ filter shouldForwardTo ms
+ where
+ shouldForwardTo m
+ | jobSpecImpliedPending jobSpec = memberCurrentOrPending m
+ | otherwise = memberCurrent m
+ DJSMemberSupport scopeGMId -> do
+ ms <- withStore' $ \db -> getSupportScopeMembersByIndexes db vr user gInfo scopeGMId introducedMemsIdxs
+ pure $ filter shouldForwardTo ms
+ where
+ shouldForwardTo m = groupMemberId' m == scopeGMId || currentModerator m
+ currentModerator m@GroupMember {memberRole} =
+ memberRole >= GRModerator
+ && memberCurrent m
+ && maxVersion (memberChatVRange m) >= groupKnockingVersion
where
deliver :: ByteString -> [GroupMember] -> CM ()
deliver msgBody mems =
diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs
index b22cfebcdd..3c8f170b0d 100644
--- a/src/Simplex/Chat/Mobile.hs
+++ b/src/Simplex/Chat/Mobile.hs
@@ -295,8 +295,8 @@ chatMigrateInitKey :: ChatDbOpts -> Bool -> String -> Bool -> IO (Either DBMigra
chatMigrateInitKey chatDbOpts keepKey confirm backgroundMode = runExceptT $ do
confirmMigrations <- liftEitherWith (const DBMInvalidConfirmation) $ strDecode $ B.pack confirm
let migrationConfig = MigrationConfig confirmMigrations (Just "")
- chatStore <- migrate createChatStore (toDBOpts chatDbOpts chatSuffix keepKey) migrationConfig
- agentStore <- migrate createAgentStore (toDBOpts chatDbOpts agentSuffix keepKey) migrationConfig
+ chatStore <- migrate createChatStore (toDBOpts chatDbOpts chatSuffix keepKey chatDBFunctions) migrationConfig
+ agentStore <- migrate createAgentStore (toDBOpts chatDbOpts agentSuffix keepKey []) migrationConfig
liftIO $ initialize chatStore ChatDatabase {chatStore, agentStore}
where
opts = mobileChatOpts $ removeDbKey chatDbOpts
diff --git a/src/Simplex/Chat/Options/Postgres.hs b/src/Simplex/Chat/Options/Postgres.hs
index 13af13b20a..c74ae37750 100644
--- a/src/Simplex/Chat/Options/Postgres.hs
+++ b/src/Simplex/Chat/Options/Postgres.hs
@@ -58,8 +58,8 @@ migrationBackupPathP = pure Nothing
dbString :: ChatDbOpts -> String
dbString ChatDbOpts {dbConnstr} = dbConnstr
-toDBOpts :: ChatDbOpts -> String -> Bool -> DBOpts
-toDBOpts ChatDbOpts {dbConnstr, dbSchemaPrefix, dbPoolSize, dbCreateSchema} dbSuffix _keepKey =
+toDBOpts :: ChatDbOpts -> String -> Bool -> [()] -> DBOpts
+toDBOpts ChatDbOpts {dbConnstr, dbSchemaPrefix, dbPoolSize, dbCreateSchema} dbSuffix _keepKey _dbFunctions =
DBOpts
{ connstr = B.pack dbConnstr,
schema = B.pack $ if null dbSchemaPrefix then "simplex_v1" <> dbSuffix else dbSchemaPrefix <> dbSuffix,
@@ -73,6 +73,9 @@ chatSuffix = "_chat_schema"
agentSuffix :: String
agentSuffix = "_agent_schema"
+chatDBFunctions :: [()]
+chatDBFunctions = []
+
mobileDbOpts :: CString -> CString -> IO ChatDbOpts
mobileDbOpts schemaPrefix connstr = do
dbSchemaPrefix <- peekCString schemaPrefix
diff --git a/src/Simplex/Chat/Options/SQLite.hs b/src/Simplex/Chat/Options/SQLite.hs
index 8591f0801c..7e25bb2217 100644
--- a/src/Simplex/Chat/Options/SQLite.hs
+++ b/src/Simplex/Chat/Options/SQLite.hs
@@ -11,7 +11,9 @@ import qualified Data.ByteArray as BA
import qualified Data.ByteString.Char8 as B
import Foreign.C.String
import Options.Applicative
+import Simplex.Chat.Store.SQLite.Migrations.M20251117_member_relations_vector
import Simplex.Messaging.Agent.Store.Interface (DBOpts (..))
+import Simplex.Messaging.Agent.Store.SQLite.Common (SQLiteFuncDef (..), SQLiteFuncPtrs (..))
import Simplex.Messaging.Agent.Store.SQLite.DB (TrackQueries (..))
import System.FilePath (combine)
@@ -70,10 +72,11 @@ migrationBackupPathP =
dbString :: ChatDbOpts -> String
dbString ChatDbOpts {dbFilePrefix} = dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
-toDBOpts :: ChatDbOpts -> String -> Bool -> DBOpts
-toDBOpts ChatDbOpts {dbFilePrefix, dbKey, trackQueries, vacuumOnMigration} dbSuffix keepKey = do
+toDBOpts :: ChatDbOpts -> String -> Bool -> [SQLiteFuncDef] -> DBOpts
+toDBOpts ChatDbOpts {dbFilePrefix, dbKey, trackQueries, vacuumOnMigration} dbSuffix keepKey dbFunctions = do
DBOpts
{ dbFilePath = dbFilePrefix <> dbSuffix,
+ dbFunctions,
dbKey,
keepKey,
vacuum = vacuumOnMigration,
@@ -86,6 +89,12 @@ chatSuffix = "_chat.db"
agentSuffix :: String
agentSuffix = "_agent.db"
+chatDBFunctions :: [SQLiteFuncDef]
+chatDBFunctions =
+ [ SQLiteFuncDef "migrate_relations_vector" 3 (SQLiteAggrPtrs sqliteMemberRelationsStepPtr sqliteMemberRelationsFinalPtr),
+ SQLiteFuncDef "set_member_vector_new_relation" 4 (SQLiteFuncPtr True sqliteSetMemberVectorNewRelationPtr)
+ ]
+
mobileDbOpts :: CString -> CString -> IO ChatDbOpts
mobileDbOpts fp key = do
dbFilePrefix <- peekCString fp
diff --git a/src/Simplex/Chat/Store/Delivery.hs b/src/Simplex/Chat/Store/Delivery.hs
index 30fffac0e7..c1da436f04 100644
--- a/src/Simplex/Chat/Store/Delivery.hs
+++ b/src/Simplex/Chat/Store/Delivery.hs
@@ -185,7 +185,7 @@ getNextDeliveryTasks db gInfo task =
| otherwise =
-- For fully connected groups we guarantee a singleSenderGMId for a delivery job by additionally filtering
-- on sender_group_member_id here, so that the job can then retrieve less members as recipients,
- -- optimizing for this single sender (see processDeliveryJob -> getForwardIntroducedMembers, etc.).
+ -- optimizing for this single sender (see processDeliveryJob -> fully connected group branch).
-- We do this optimization in the job to decrease load on admins using mobile devices for clients.
map fromOnly
<$> DB.query
diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs
index c04a31c0a9..44dcd3c7f9 100644
--- a/src/Simplex/Chat/Store/Groups.hs
+++ b/src/Simplex/Chat/Store/Groups.hs
@@ -58,11 +58,13 @@ module Simplex.Chat.Store.Groups
getMentionedGroupMember,
getMentionedMemberByMemberId,
getGroupMemberById,
+ getGroupMemberByIndex,
getGroupMemberByMemberId,
getGroupMemberIdViaMemberId,
getScopeMemberIdViaMemberId,
getGroupMembers,
- getGroupMembersForIntroduction,
+ getGroupMembersByIndexes,
+ getSupportScopeMembersByIndexes,
getGroupModerators,
getGroupRelays,
getGroupMembersForExpiration,
@@ -98,14 +100,17 @@ module Simplex.Chat.Store.Groups
deleteGroupMemberConnection,
updateGroupMemberRole,
createIntroductions,
+ createIntrosOrUpdateVectors,
+ setMemberVectorNewRelations,
+ setMembersVectorsNewRelation,
+ setMemberVectorRelationConnected,
+ migrateGetMemberRelationsVector,
+ migrateMemberRelationsVector,
+ migrateMemberRelationsVector',
+ getMemberRelationsVector_,
updateIntroStatus,
getIntroduction,
getIntroducedGroupMemberIds,
- getForwardIntroducedMembers,
- getForwardIntroducedModerators,
- getForwardInvitedMembers,
- getForwardInvitedModerators,
- getForwardScopeMember,
createIntroReMember,
createIntroToMemberContact,
getMatchingContacts,
@@ -146,6 +151,8 @@ module Simplex.Chat.Store.Groups
setGroupChatTTL,
getGroupChatTTL,
getUserGroupsToExpire,
+ hasMembersWithoutVector,
+ getGMsWithoutVectorIds,
updateGroupAlias,
)
where
@@ -155,8 +162,11 @@ import Control.Monad.Except
import Control.Monad.IO.Class
import Crypto.Random (ChaChaDRG)
import Data.Bifunctor (second)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
import Data.Char (toLower)
import Data.Either (rights)
+import Data.Foldable (foldrM)
import Data.Int (Int64)
import Data.List (partition, sortOn)
import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)
@@ -170,6 +180,7 @@ import Simplex.Chat.Protocol hiding (Binary)
import Simplex.Chat.Store.Direct
import Simplex.Chat.Store.Shared
import Simplex.Chat.Types
+import Simplex.Chat.Types.MemberRelations (IntroductionDirection (..), MemberRelation (..), setNewRelations, setRelationConnected, toIntroDirInt, toRelationInt)
import Simplex.Chat.Types.Preferences
import Simplex.Chat.Types.Shared
import Simplex.Chat.Types.UITheme
@@ -180,11 +191,12 @@ import qualified Simplex.Messaging.Agent.Store.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff, pattern PQSupportOff)
import Simplex.Messaging.Protocol (SubscriptionMode (..))
-import Simplex.Messaging.Util (eitherToMaybe, firstRow', safeDecodeUtf8, ($>>), ($>>=), (<$$>))
+import Simplex.Messaging.Util (eitherToMaybe, firstRow', safeDecodeUtf8, ($>>=), (<$$>))
import Simplex.Messaging.Version
import UnliftIO.STM
#if defined(dbPostgres)
-import Database.PostgreSQL.Simple (Only (..), Query, (:.) (..))
+import qualified Data.Set as S
+import Database.PostgreSQL.Simple (In (..), Only (..), Query, (:.) (..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
#else
import Database.SQLite.Simple (Only (..), Query, (:.) (..))
@@ -511,12 +523,12 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe
db
[sql|
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
- ( (groupId, indexInGroup, memberId, memberRole, memberCategory, memberStatus, fromInvitedBy userContactId invitedBy, invitedByGroupMemberId)
+ ( (groupId, indexInGroup, memberId, memberRole, memberCategory, memberStatus, Binary B.empty, fromInvitedBy userContactId invitedBy, invitedByGroupMemberId)
:. (userId, localDisplayName' userOrContact, contactId' userOrContact, localProfileId $ profile' userOrContact, createdAt, createdAt)
:. (minV, maxV)
)
@@ -530,12 +542,12 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe
db
[sql|
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, member_profile_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
- ( (groupId, indexInGroup, memberId, memberRole, memberCategory, memberStatus, fromInvitedBy userContactId invitedBy, invitedByGroupMemberId)
+ ( (groupId, indexInGroup, memberId, memberRole, memberCategory, memberStatus, Binary B.empty, fromInvitedBy userContactId invitedBy, invitedByGroupMemberId)
:. (userId, incognitoLdn, contactId' userOrContact, localProfileId $ profile' userOrContact, customUserProfileId, createdAt, createdAt)
:. (minV, maxV)
)
@@ -570,11 +582,11 @@ createPreparedGroup db vr user@User {userId, userContactId} groupProfile busines
db
[sql|
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
- ( (groupId, indexInGroup, memberId, GRAdmin, GCHostMember, GSMemAccepted, fromInvitedBy userContactId IBUnknown)
+ ( (groupId, indexInGroup, memberId, GRAdmin, GCHostMember, GSMemAccepted, Binary B.empty, fromInvitedBy userContactId IBUnknown)
:. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
)
insertedRowId db
@@ -766,11 +778,11 @@ createGroupViaLink'
db
[sql|
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
- ( (groupId, indexInGroup, memberId, memberRole, GCHostMember, GSMemAccepted, fromInvitedBy userContactId IBUnknown)
+ ( (groupId, indexInGroup, memberId, memberRole, GCHostMember, GSMemAccepted, Binary B.empty, fromInvitedBy userContactId IBUnknown)
:. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
)
insertedRowId db
@@ -994,6 +1006,22 @@ getGroupMemberById db vr user@User {userId} groupMemberId =
(groupMemberQuery <> " WHERE m.group_member_id = ? AND m.user_id = ?")
(groupMemberId, userId)
+getGroupMemberByIndex :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> Int64 -> ExceptT StoreError IO GroupMember
+getGroupMemberByIndex db vr user GroupInfo {groupId} indexInGroup =
+ ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFoundByIndex indexInGroup) $
+ DB.query
+ db
+ (groupMemberQuery <> " WHERE m.group_id = ? AND m.index_in_group = ?")
+ (groupId, indexInGroup)
+
+getSupportScopeMemberByIndex :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMemberId -> Int64 -> ExceptT StoreError IO GroupMember
+getSupportScopeMemberByIndex db vr user GroupInfo {groupId} scopeGMId indexInGroup =
+ ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFoundByIndex indexInGroup) $
+ DB.query
+ db
+ (groupMemberQuery <> " WHERE m.group_id = ? AND m.index_in_group = ? AND (m.member_role IN (?,?,?) OR m.group_member_id = ?)")
+ (groupId, indexInGroup, GRModerator, GRAdmin, GROwner, scopeGMId)
+
getGroupMemberByMemberId :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> MemberId -> ExceptT StoreError IO GroupMember
getGroupMemberByMemberId db vr user GroupInfo {groupId} memberId =
ExceptT . firstRow (toContactMember vr user) (SEGroupMemberNotFoundByMemberId memberId) $
@@ -1017,20 +1045,38 @@ getGroupMemberIdViaMemberId db User {userId} GroupInfo {groupId} memberId =
(userId, groupId, memberId)
getGroupMembers :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
-getGroupMembers db vr user@User {userId, userContactId} GroupInfo {groupId} = do
+getGroupMembers db vr user@User {userId, userContactId} GroupInfo {groupId} =
map (toContactMember vr user)
<$> DB.query
db
(groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?)")
(userId, groupId, userContactId)
-getGroupMembersForIntroduction :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMember -> IO [GroupMember]
-getGroupMembersForIntroduction db vr user@User {userId, userContactId} GroupInfo {groupId} _introduced@GroupMember {indexInGroup} = do
- map (toContactMember vr user)
- <$> DB.query
+getGroupMembersByIndexes :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> [Int64] -> IO [GroupMember]
+getGroupMembersByIndexes db vr user gInfo indexesInGroup = do
+#if defined(dbPostgres)
+ let GroupInfo {groupId} = gInfo
+ map (toContactMember vr user) <$>
+ DB.query
db
- (groupMemberQuery <> " WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND index_in_group < ?")
- (userId, groupId, userContactId, indexInGroup)
+ (groupMemberQuery <> " WHERE m.group_id = ? AND m.index_in_group IN ?")
+ (groupId, In indexesInGroup)
+#else
+ rights <$> mapM (runExceptT . getGroupMemberByIndex db vr user gInfo) indexesInGroup
+#endif
+
+getSupportScopeMembersByIndexes :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> GroupMemberId -> [Int64] -> IO [GroupMember]
+getSupportScopeMembersByIndexes db vr user gInfo scopeGMId indexesInGroup = do
+#if defined(dbPostgres)
+ let GroupInfo {groupId} = gInfo
+ map (toContactMember vr user) <$>
+ DB.query
+ db
+ (groupMemberQuery <> " WHERE m.group_id = ? AND m.index_in_group IN ? AND (m.member_role IN (?,?,?) OR m.group_member_id = ?)")
+ (groupId, In indexesInGroup, GRModerator, GRAdmin, GROwner, scopeGMId)
+#else
+ rights <$> mapM (runExceptT . getSupportScopeMemberByIndex db vr user gInfo scopeGMId) indexesInGroup
+#endif
getGroupModerators :: DB.Connection -> VersionRangeChat -> User -> GroupInfo -> IO [GroupMember]
getGroupModerators db vr user@User {userId, userContactId} GroupInfo {groupId} = do
@@ -1141,12 +1187,12 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId,
db
[sql|
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, sent_inv_queue_info, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
- ( (groupId, indexInGroup, memberId, memberRole, GCInviteeMember, GSMemInvited, fromInvitedBy userContactId IBUser, invitedByGroupMemberId)
+ ( (groupId, indexInGroup, memberId, memberRole, GCInviteeMember, GSMemInvited, Binary B.empty, fromInvitedBy userContactId IBUser, invitedByGroupMemberId)
:. (userId, localDisplayName, contactId, localProfileId profile, connRequest, createdAt, createdAt)
:. (minV, maxV)
)
@@ -1169,12 +1215,12 @@ createNewContactMemberAsync db gVar user@User {userId, userContactId} GroupInfo
db
[sql|
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
- ( (groupId, indexInGroup, memberId, memberRole, GCInviteeMember, GSMemInvited, fromInvitedBy userContactId IBUser, groupMemberId' membership)
+ ( (groupId, indexInGroup, memberId, memberRole, GCInviteeMember, GSMemInvited, Binary B.empty, fromInvitedBy userContactId IBUser, groupMemberId' membership)
:. (userId, localDisplayName, contactId, localProfileId profile, createdAt, createdAt)
:. (minV, maxV)
)
@@ -1212,12 +1258,12 @@ createJoiningMember
db
[sql|
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, member_xcontact_id, member_welcome_shared_msg_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
- ( (groupId, indexInGroup, memberId, memberRole, GCInviteeMember, memberStatus, fromInvitedBy userContactId IBUser, groupMemberId' membership)
+ ( (groupId, indexInGroup, memberId, memberRole, GCInviteeMember, memberStatus, Binary B.empty, fromInvitedBy userContactId IBUser, groupMemberId' membership)
:. (userId, ldn, Nothing :: (Maybe Int64), profileId, cReqXContactId_, welcomeMsgId_, currentTs, currentTs)
:. (minV, maxV)
)
@@ -1291,12 +1337,12 @@ createBusinessRequestGroup
db
[sql|
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
- ( (groupId, indexInGroup, MemberId memId, GRMember, GCInviteeMember, GSMemAccepted, fromInvitedBy userContactId IBUser, groupMemberId' membership)
+ ( (groupId, indexInGroup, MemberId memId, GRMember, GCInviteeMember, GSMemAccepted, Binary B.empty, fromInvitedBy userContactId IBUser, groupMemberId' membership)
:. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
:. (minV, maxV)
)
@@ -1497,12 +1543,12 @@ createNewMember_
db
[sql|
INSERT INTO group_members
- (group_id, index_in_group, member_id, member_role, member_category, member_status, member_restriction, invited_by, invited_by_group_member_id,
+ (group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, member_restriction, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
- ( (groupId, indexInGroup, memberId, memberRole, memberCategory, memberStatus, memRestriction, invitedById, memInvitedByGroupMemberId)
+ ( (groupId, indexInGroup, memberId, memberRole, memberCategory, memberStatus, Binary B.empty, memRestriction, invitedById, memInvitedByGroupMemberId)
:. (userId, localDisplayName, memberContactId, memberContactProfileId, createdAt, createdAt)
:. (minV, maxV)
)
@@ -1561,27 +1607,196 @@ updateGroupMemberRole :: DB.Connection -> User -> GroupMember -> GroupMemberRole
updateGroupMemberRole db User {userId} GroupMember {groupMemberId} memRole =
DB.execute db "UPDATE group_members SET member_role = ? WHERE user_id = ? AND group_member_id = ?" (memRole, userId, groupMemberId)
-createIntroductions :: DB.Connection -> VersionChat -> [GroupMember] -> GroupMember -> IO [GroupMemberIntro]
-createIntroductions db chatV members toMember = do
- let reMembers = filter (\m -> memberCurrent m && groupMemberId' m /= groupMemberId' toMember) members
- if null reMembers
- then pure []
- else do
+createIntroductions :: DB.Connection -> VersionChat -> [GroupMember] -> GroupMember -> IO [GroupMember]
+createIntroductions db chatV reMembers toMember
+ | null reMembers = pure []
+ | otherwise = do
currentTs <- getCurrentTime
- mapM (insertIntro_ currentTs) reMembers
+ catMaybes <$> mapM (createIntro_ currentTs) reMembers
where
- insertIntro_ :: UTCTime -> GroupMember -> IO GroupMemberIntro
- insertIntro_ ts reMember = do
- DB.execute
+ createIntro_ :: UTCTime -> GroupMember -> IO (Maybe GroupMember)
+ createIntro_ ts reMember =
+ -- when members connect concurrently, host would try to create introductions between them in both directions;
+ -- this check avoids creating second (redundant) introduction
+ checkInverseIntro >>= \case
+ Just _ -> pure Nothing
+ Nothing -> do
+ DB.execute
+ db
+ [sql|
+ INSERT INTO group_member_intros
+ (re_group_member_id, to_group_member_id, intro_status, intro_chat_protocol_version, created_at, updated_at)
+ VALUES (?,?,?,?,?,?)
+ |]
+ (groupMemberId' reMember, groupMemberId' toMember, GMIntroPending, chatV, ts, ts)
+ pure $ Just reMember
+ where
+ checkInverseIntro :: IO (Maybe Int64)
+ checkInverseIntro =
+ maybeFirstRow fromOnly $
+ DB.query
+ db
+ "SELECT 1 FROM group_member_intros WHERE re_group_member_id = ? AND to_group_member_id = ? LIMIT 1"
+ (groupMemberId' toMember, groupMemberId' reMember)
+
+-- Create introductions for members without vectors and update vectors for members with vectors.
+-- Partitioning and updates happen in same transaction to avoid race conditions.
+createIntrosOrUpdateVectors :: DB.Connection -> VersionRangeChat -> [GroupMember] -> GroupMember -> IO [GroupMember]
+createIntrosOrUpdateVectors db vr reMembers toMember
+ | null reMembers = pure []
+ | otherwise = do
+ (memsWithVec, memsWithoutVec) <- partitionByVector reMembers
+ let GroupMember {indexInGroup} = toMember
+ setMembersVectorsNewRelation db memsWithVec indexInGroup IDSubjectIntroduced MRIntroduced
+ memsWithoutVec' <- createIntroductions db (maxVersion vr) memsWithoutVec toMember
+ pure $ memsWithoutVec' <> memsWithVec
+ where
+ partitionByVector :: [GroupMember] -> IO ([GroupMember], [GroupMember])
+#if defined(dbPostgres)
+ partitionByVector members = do
+ let memberIds = map groupMemberId' members
+ -- Lock rows first to ensure partitioning doesn't change in case of concurrent updates
+ _ :: [Only Int] <-
+ DB.query
+ db
+ "SELECT 1 FROM group_members WHERE group_member_id IN ? FOR UPDATE"
+ (Only $ In memberIds)
+ memberIdsWithVec <- S.fromList . map fromOnly <$>
+ DB.query
+ db
+ "SELECT group_member_id FROM group_members WHERE group_member_id IN ? AND member_relations_vector IS NOT NULL"
+ (Only $ In memberIds)
+ pure $ partition (\m -> groupMemberId' m `S.member` memberIdsWithVec) members
+#else
+ partitionByVector = foldrM checkMember ([], [])
+ where
+ checkMember m (withVec, withoutVec) = do
+ hasVec <- isJust <$> maybeFirstRow fromOnly
+ (DB.query db "SELECT 1 FROM group_members WHERE group_member_id = ? AND member_relations_vector IS NOT NULL" (Only $ groupMemberId' m) :: IO [Only Int64])
+ pure $ if hasVec then (m : withVec, withoutVec) else (withVec, m : withoutVec)
+#endif
+
+setMemberVectorNewRelations :: DB.Connection -> GroupMember -> [(Int64, (IntroductionDirection, MemberRelation))] -> IO ()
+setMemberVectorNewRelations db GroupMember {groupMemberId} relations = do
+ v_ <- maybeFirstRow fromOnly $
+ DB.query
+ db
+#if defined(dbPostgres)
+ "SELECT member_relations_vector FROM group_members WHERE group_member_id = ? FOR UPDATE"
+#else
+ "SELECT member_relations_vector FROM group_members WHERE group_member_id = ?"
+#endif
+ (Only groupMemberId)
+ let v' = setNewRelations relations $ fromMaybe B.empty v_
+ currentTs <- getCurrentTime
+ DB.execute
+ db
+ [sql|
+ UPDATE group_members
+ SET member_relations_vector = ?, updated_at = ?
+ WHERE group_member_id = ?
+ |]
+ (Binary v', currentTs, groupMemberId)
+
+setMembersVectorsNewRelation :: DB.Connection -> [GroupMember] -> Int64 -> IntroductionDirection -> MemberRelation -> IO ()
+setMembersVectorsNewRelation db members idx dir status = do
+ currentTs <- getCurrentTime
+#if defined(dbPostgres)
+ let memberIds = map groupMemberId' members
+ DB.execute
+ db
+ "UPDATE group_members SET member_relations_vector = set_member_vector_new_relation(member_relations_vector, ?, ?, ?), updated_at = ? WHERE group_member_id IN ?"
+ (idx, toIntroDirInt dir, toRelationInt status, currentTs, In memberIds)
+#else
+ forM_ members $ \GroupMember {groupMemberId} ->
+ DB.execute
+ db
+ "UPDATE group_members SET member_relations_vector = set_member_vector_new_relation(member_relations_vector, ?, ?, ?), updated_at = ? WHERE group_member_id = ?"
+ (idx, toIntroDirInt dir, toRelationInt status, currentTs, groupMemberId)
+#endif
+
+setMemberVectorRelationConnected :: DB.Connection -> GroupMember -> GroupMember -> MemberRelation -> ExceptT StoreError IO ()
+setMemberVectorRelationConnected db GroupMember {groupMemberId} GroupMember {indexInGroup} newStatus = do
+ when (newStatus /= MRSubjectConnected && newStatus /= MRReferencedConnected) $
+ throwError SEInvalidMemberRelationUpdate
+ v <- ExceptT $
+ firstRow fromOnly (SEMemberRelationsVectorNotFound groupMemberId) $
+ DB.query
db
- [sql|
- INSERT INTO group_member_intros
- (re_group_member_id, to_group_member_id, intro_status, intro_chat_protocol_version, created_at, updated_at)
- VALUES (?,?,?,?,?,?)
- |]
- (groupMemberId' reMember, groupMemberId' toMember, GMIntroPending, chatV, ts, ts)
- introId <- insertedRowId db
- pure GroupMemberIntro {introId, reMember, toMember, introStatus = GMIntroPending}
+#if defined(dbPostgres)
+ "SELECT member_relations_vector FROM group_members WHERE group_member_id = ? AND member_relations_vector IS NOT NULL FOR UPDATE"
+#else
+ "SELECT member_relations_vector FROM group_members WHERE group_member_id = ? AND member_relations_vector IS NOT NULL"
+#endif
+ (Only groupMemberId)
+ let v' = setRelationConnected indexInGroup newStatus v
+ currentTs <- liftIO getCurrentTime
+ liftIO $ DB.execute
+ db
+ [sql|
+ UPDATE group_members
+ SET member_relations_vector = ?, updated_at = ?
+ WHERE group_member_id = ?
+ |]
+ (Binary v', currentTs, groupMemberId)
+
+migrateGetMemberRelationsVector :: DB.Connection -> GroupMember -> ExceptT StoreError IO ByteString
+migrateGetMemberRelationsVector db m@GroupMember {groupMemberId} = do
+ liftIO $ migrateMemberRelationsVector db m
+ ExceptT . firstRow fromOnly (SEGroupMemberNotFound groupMemberId) $
+ DB.query
+ db
+ "SELECT member_relations_vector FROM group_members WHERE group_member_id = ?"
+ (Only groupMemberId)
+
+migrateMemberRelationsVector :: DB.Connection -> GroupMember -> IO ()
+migrateMemberRelationsVector db GroupMember {groupMemberId} =
+ migrateMemberRelationsVector' db groupMemberId
+
+migrateMemberRelationsVector' :: DB.Connection -> GroupMemberId -> IO ()
+migrateMemberRelationsVector' db groupMemberId = do
+ currentTs <- liftIO getCurrentTime
+ liftIO $ do
+#if defined(dbPostgres)
+ -- Lock the row first to ensure computation runs only after lock is acquired
+ _ :: [Only Int] <-
+ DB.query
+ db
+ "SELECT 1 FROM group_members WHERE group_member_id = ? AND member_relations_vector IS NULL FOR UPDATE"
+ (Only groupMemberId)
+#endif
+ DB.execute
+ db
+ [sql|
+ UPDATE group_members
+ SET
+ member_relations_vector = (
+ SELECT migrate_relations_vector(idx, direction, intro_status)
+ FROM (
+ SELECT m.index_in_group AS idx, 0 AS direction, i.intro_status
+ FROM group_member_intros i
+ JOIN group_members m ON m.group_member_id = i.to_group_member_id
+ WHERE i.re_group_member_id = group_members.group_member_id
+ UNION ALL
+ SELECT m.index_in_group AS idx, 1 AS direction, i.intro_status
+ FROM group_member_intros i
+ JOIN group_members m ON m.group_member_id = i.re_group_member_id
+ WHERE i.to_group_member_id = group_members.group_member_id
+ ) AS relations
+ ),
+ updated_at = ?
+ WHERE group_member_id = ?
+ AND member_relations_vector IS NULL
+ |]
+ (currentTs, groupMemberId)
+
+getMemberRelationsVector_ :: DB.Connection -> GroupMember -> IO (Maybe ByteString)
+getMemberRelationsVector_ db GroupMember {groupMemberId} =
+ maybeFirstRow fromOnly $
+ DB.query
+ db
+ "SELECT member_relations_vector FROM group_members WHERE group_member_id = ?"
+ (Only groupMemberId)
updateIntroStatus :: DB.Connection -> Int64 -> GroupMemberIntroStatus -> IO ()
updateIntroStatus db introId introStatus = do
@@ -1595,9 +1810,9 @@ updateIntroStatus db introId introStatus = do
|]
(introStatus, currentTs, introId)
-getIntroduction :: DB.Connection -> GroupMember -> GroupMember -> ExceptT StoreError IO GroupMemberIntro
-getIntroduction db reMember toMember = ExceptT $
- firstRow toIntro SEIntroNotFound $
+getIntroduction :: DB.Connection -> GroupMember -> GroupMember -> IO (Maybe GroupMemberIntro)
+getIntroduction db reMember toMember =
+ maybeFirstRow toIntro $
DB.query
db
[sql|
@@ -1619,106 +1834,6 @@ getIntroducedGroupMemberIds db invitee =
"SELECT re_group_member_id FROM group_member_intros WHERE to_group_member_id = ?"
(Only $ groupMemberId' invitee)
-getForwardIntroducedMembers :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> Bool -> IO [GroupMember]
-getForwardIntroducedMembers db vr user invitee highlyAvailable = do
- memberIds <- map fromOnly <$> query
- rights <$> mapM (runExceptT . getGroupMemberById db vr user) memberIds
- where
- mId = groupMemberId' invitee
- query
- | highlyAvailable = DB.query db q (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected)
- | otherwise =
- DB.query
- db
- (q <> " AND intro_chat_protocol_version >= ?")
- (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, groupForwardVersion)
- q =
- [sql|
- SELECT re_group_member_id
- FROM group_member_intros
- WHERE to_group_member_id = ? AND intro_status NOT IN (?,?,?)
- |]
-
--- for support scope we don't need to filter by intro_chat_protocol_version for non highly available client,
--- as we will filter moderators supporting this feature by a higher version (as opposed to getForwardIntroducedMembers)
-getForwardIntroducedModerators :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> IO [GroupMember]
-getForwardIntroducedModerators db vr user@User {userContactId} invitee = do
- memberIds <- map fromOnly <$> query
- rights <$> mapM (runExceptT . getGroupMemberById db vr user) memberIds
- where
- mId = groupMemberId' invitee
- query =
- DB.query
- db
- [sql|
- SELECT i.re_group_member_id
- FROM group_member_intros i
- JOIN group_members m ON m.group_member_id = i.re_group_member_id
- WHERE i.to_group_member_id = ? AND i.intro_status NOT IN (?,?,?)
- AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?,?)
- |]
- (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, userContactId, GRModerator, GRAdmin, GROwner)
-
-getForwardInvitedMembers :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> Bool -> IO [GroupMember]
-getForwardInvitedMembers db vr user forwardMember highlyAvailable = do
- memberIds <- map fromOnly <$> query
- rights <$> mapM (runExceptT . getGroupMemberById db vr user) memberIds
- where
- mId = groupMemberId' forwardMember
- query
- | highlyAvailable = DB.query db q (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected)
- | otherwise =
- DB.query
- db
- (q <> " AND intro_chat_protocol_version >= ?")
- (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, groupForwardVersion)
- q =
- [sql|
- SELECT to_group_member_id
- FROM group_member_intros
- WHERE re_group_member_id = ? AND intro_status NOT IN (?,?,?)
- |]
-
--- for support scope we don't need to filter by intro_chat_protocol_version for non highly available client,
--- as we will filter moderators supporting this feature by a higher version (as opposed to getForwardInvitedMembers)
-getForwardInvitedModerators :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> IO [GroupMember]
-getForwardInvitedModerators db vr user@User {userContactId} forwardMember = do
- memberIds <- map fromOnly <$> query
- rights <$> mapM (runExceptT . getGroupMemberById db vr user) memberIds
- where
- mId = groupMemberId' forwardMember
- query =
- DB.query
- db
- [sql|
- SELECT i.to_group_member_id
- FROM group_member_intros i
- JOIN group_members m ON m.group_member_id = i.to_group_member_id
- WHERE i.re_group_member_id = ? AND i.intro_status NOT IN (?,?,?)
- AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?,?)
- |]
- (mId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected, userContactId, GRModerator, GRAdmin, GROwner)
-
-getForwardScopeMember :: DB.Connection -> VersionRangeChat -> User -> GroupMember -> GroupMemberId -> IO (Maybe GroupMember)
-getForwardScopeMember db vr user GroupMember {groupMemberId = sendingGMId} scopeGMId = do
- (introExists_ :: Maybe Int64) <-
- liftIO $ maybeFirstRow fromOnly $
- DB.query
- db
- [sql|
- SELECT 1
- FROM group_member_intros
- WHERE
- (
- (re_group_member_id = ? AND to_group_member_id = ?) OR
- (re_group_member_id = ? AND to_group_member_id = ?)
- )
- AND intro_status NOT IN (?,?,?)
- LIMIT 1
- |]
- (sendingGMId, scopeGMId, scopeGMId, sendingGMId, GMIntroReConnected, GMIntroToConnected, GMIntroConnected)
- pure introExists_ $>> (eitherToMaybe <$> runExceptT (getGroupMemberById db vr user scopeGMId))
-
createIntroReMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> VersionChat -> MemberInfo -> Maybe MemberRestrictions -> (CommandId, ConnId) -> SubscriptionMode -> ExceptT StoreError IO GroupMember
createIntroReMember
db
@@ -2505,12 +2620,12 @@ createNewUnknownGroupMember db vr user@User {userId, userContactId} GroupInfo {g
db
[sql|
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
- ( (groupId, indexInGroup, memberId, GRAuthor, GCPreMember, GSMemUnknown, fromInvitedBy userContactId IBUnknown)
+ ( (groupId, indexInGroup, memberId, GRAuthor, GCPreMember, GSMemUnknown, Binary B.empty, fromInvitedBy userContactId IBUnknown)
:. (userId, localDisplayName, Nothing :: (Maybe Int64), profileId, currentTs, currentTs)
:. (minV, maxV)
)
@@ -2608,6 +2723,25 @@ getUserGroupsToExpire db User {userId} globalTTL =
where
cond = if globalTTL == 0 then "" else " OR chat_item_ttl IS NULL"
+hasMembersWithoutVector :: DB.Connection -> IO Bool
+hasMembersWithoutVector db =
+ fromOnly . head
+ <$> DB.query_
+ db
+ "SELECT EXISTS (SELECT 1 FROM group_members WHERE member_relations_vector IS NULL LIMIT 1)"
+
+getGMsWithoutVectorIds :: DB.Connection -> IO [GroupMemberId]
+getGMsWithoutVectorIds db =
+ map fromOnly <$>
+ DB.query_
+ db
+ [sql|
+ SELECT group_member_id
+ FROM group_members
+ WHERE member_relations_vector IS NULL
+ LIMIT 1000
+ |]
+
updateGroupAlias :: DB.Connection -> UserId -> GroupInfo -> LocalAlias -> IO GroupInfo
updateGroupAlias db userId g@GroupInfo {groupId} localAlias = do
updatedAt <- getCurrentTime
diff --git a/src/Simplex/Chat/Store/Postgres/Migrations.hs b/src/Simplex/Chat/Store/Postgres/Migrations.hs
index 9361713ea2..9dd388be0a 100644
--- a/src/Simplex/Chat/Store/Postgres/Migrations.hs
+++ b/src/Simplex/Chat/Store/Postgres/Migrations.hs
@@ -22,6 +22,7 @@ import Simplex.Chat.Store.Postgres.Migrations.M20250922_remove_unused_connection
import Simplex.Chat.Store.Postgres.Migrations.M20251007_connections_sync
import Simplex.Chat.Store.Postgres.Migrations.M20251017_chat_tags_cascade
import Simplex.Chat.Store.Postgres.Migrations.M20251117_member_relations_vector
+-- import Simplex.Chat.Store.Postgres.Migrations.M20251128_member_relations_vector_stage_2
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Text, Maybe Text)]
@@ -44,6 +45,7 @@ schemaMigrations =
("20251007_connections_sync", m20251007_connections_sync, Just down_m20251007_connections_sync),
("20251017_chat_tags_cascade", m20251017_chat_tags_cascade, Just down_m20251017_chat_tags_cascade),
("20251117_member_relations_vector", m20251117_member_relations_vector, Just down_m20251117_member_relations_vector)
+ -- ("20251128_member_relations_vector_stage_2", m20251128_member_relations_vector_stage_2, Just down_m20251128_member_relations_vector_stage_2)
]
-- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/M20251117_member_relations_vector.hs b/src/Simplex/Chat/Store/Postgres/Migrations/M20251117_member_relations_vector.hs
index 3f6deeb80f..33583cc076 100644
--- a/src/Simplex/Chat/Store/Postgres/Migrations/M20251117_member_relations_vector.hs
+++ b/src/Simplex/Chat/Store/Postgres/Migrations/M20251117_member_relations_vector.hs
@@ -6,10 +6,91 @@ import Data.Text (Text)
import qualified Data.Text as T
import Text.RawString.QQ (r)
+-- This migration creates custom aggregate function migrate_relations_vector(idx, direction, intro_status).
+-- Used in live migration and stage 2 migration (M20251128_member_relations_vector_stage_2).
+--
+-- Vector byte encoding: 4 reserved | 1 direction | 3 status
+-- Direction: 0 = IDSubjectIntroduced, 1 = IDReferencedIntroduced
+-- Status values: 0 = MRNew, 1 = MRIntroduced, 2 = MRSubjectConnected, 3 = MRReferencedConnected, 4 = MRConnected
+--
+-- The aggregate transforms intro_status into relation status:
+-- - intro_status 'new'/'sent'/'rcv'/'fwd': MRIntroduced (1)
+-- - intro_status 're-con': if direction=0 then MRSubjectConnected (2), else MRReferencedConnected (3)
+-- - intro_status 'to-con': if direction=0 then MRReferencedConnected (3), else MRSubjectConnected (2)
+-- - intro_status 'con': MRConnected (4)
+--
+-- Final byte combines direction and status: byte = (direction << 3) | status
+
m20251117_member_relations_vector :: Text
m20251117_member_relations_vector =
T.pack
[r|
+CREATE FUNCTION set_member_vector_new_relation(v BYTEA, idx BIGINT, direction INT, status INT)
+RETURNS BYTEA AS $$
+DECLARE
+ new_len INT;
+ result BYTEA;
+ byte_val INT;
+ old_byte INT;
+BEGIN
+ IF idx < 0 THEN
+ RETURN v;
+ END IF;
+ IF idx < length(v) THEN
+ old_byte := get_byte(v, idx::INT);
+ ELSE
+ old_byte := 0;
+ END IF;
+ byte_val := (old_byte & x'F0'::INT) | (direction * 8) | status;
+ new_len := GREATEST(length(v), idx + 1);
+ IF new_len > length(v) THEN
+ result := v || (SELECT string_agg('\x00'::BYTEA, ''::BYTEA) FROM generate_series(1, new_len - length(v)));
+ ELSE
+ result := v;
+ END IF;
+ result := set_byte(result, idx::INT, byte_val);
+ RETURN result;
+END;
+$$ LANGUAGE plpgsql IMMUTABLE;
+
+CREATE FUNCTION migrate_relations_vector_step(state BYTEA, idx BIGINT, direction INT, intro_status TEXT)
+RETURNS BYTEA AS $$
+DECLARE
+ new_len INT;
+ result BYTEA;
+ status INT;
+ byte_val INT;
+BEGIN
+ IF idx < 0 THEN
+ RETURN state;
+ END IF;
+ IF intro_status = 're-con' THEN
+ IF direction = 0 THEN status := 2; ELSE status := 3; END IF;
+ ELSIF intro_status = 'to-con' THEN
+ IF direction = 0 THEN status := 3; ELSE status := 2; END IF;
+ ELSIF intro_status = 'con' THEN
+ status := 4;
+ ELSE
+ status := 1;
+ END IF;
+ byte_val := (direction * 8) + status;
+ new_len := GREATEST(length(state), idx + 1);
+ IF new_len > length(state) THEN
+ result := state || (SELECT string_agg('\x00'::BYTEA, ''::BYTEA) FROM generate_series(1, new_len - length(state)));
+ ELSE
+ result := state;
+ END IF;
+ result := set_byte(result, idx::INT, byte_val);
+ RETURN result;
+END;
+$$ LANGUAGE plpgsql IMMUTABLE;
+
+CREATE AGGREGATE migrate_relations_vector(BIGINT, INT, TEXT) (
+ SFUNC = migrate_relations_vector_step,
+ STYPE = BYTEA,
+ INITCOND = ''
+);
+
ALTER TABLE group_members ADD COLUMN index_in_group BIGINT NOT NULL DEFAULT 0;
ALTER TABLE groups ADD COLUMN member_index BIGINT NOT NULL DEFAULT 0;
@@ -46,12 +127,28 @@ SET member_index = COALESCE((
FROM group_members
WHERE group_members.group_id = g.group_id
), 0);
+
+UPDATE group_members
+SET member_relations_vector = ''::BYTEA
+WHERE group_id IN (
+ SELECT mu.group_id
+ FROM group_members mu
+ WHERE mu.member_category = 'user'
+ AND (
+ mu.member_role NOT IN ('admin', 'owner')
+ OR mu.member_status IN ('removed', 'left', 'deleted')
+ )
+);
|]
down_m20251117_member_relations_vector :: Text
down_m20251117_member_relations_vector =
T.pack
[r|
+DROP AGGREGATE migrate_relations_vector(BIGINT, INT, TEXT);
+DROP FUNCTION migrate_relations_vector_step(BYTEA, BIGINT, INT, TEXT);
+DROP FUNCTION set_member_vector_new_relation(BYTEA, BIGINT, INT, INT);
+
DROP INDEX idx_group_members_group_id_index_in_group;
ALTER TABLE group_members DROP COLUMN index_in_group;
diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/M20251128_member_relations_vector_stage_2.hs b/src/Simplex/Chat/Store/Postgres/Migrations/M20251128_member_relations_vector_stage_2.hs
new file mode 100644
index 0000000000..7cfc273d62
--- /dev/null
+++ b/src/Simplex/Chat/Store/Postgres/Migrations/M20251128_member_relations_vector_stage_2.hs
@@ -0,0 +1,45 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Store.Postgres.Migrations.M20251128_member_relations_vector_stage_2 where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Text.RawString.QQ (r)
+
+-- Build member_relations_vector for all members that don't have it yet.
+-- Uses custom aggregate function migrate_relations_vector defined in M20251117_member_relations_vector.
+--
+-- Query returns (idx, direction, intro_status) for each introduction:
+-- - direction 0 (IDSubjectIntroduced): current member (subject) is re_group_member_id, was introduced to referenced member
+-- - direction 1 (IDReferencedIntroduced): current member (subject) is to_group_member_id, referenced member was introduced to it
+
+-- TODO [relations vector] drop group_member_intros in the end of migration
+m20251128_member_relations_vector_stage_2 :: Text
+m20251128_member_relations_vector_stage_2 =
+ T.pack
+ [r|
+UPDATE group_members
+SET member_relations_vector = (
+ SELECT migrate_relations_vector(idx, direction, intro_status)
+ FROM (
+ SELECT m.index_in_group AS idx, 0 AS direction, i.intro_status
+ FROM group_member_intros i
+ JOIN group_members m ON m.group_member_id = i.to_group_member_id
+ WHERE i.re_group_member_id = group_members.group_member_id
+ UNION ALL
+ SELECT m.index_in_group AS idx, 1 AS direction, i.intro_status
+ FROM group_member_intros i
+ JOIN group_members m ON m.group_member_id = i.re_group_member_id
+ WHERE i.to_group_member_id = group_members.group_member_id
+ ) AS relations
+)
+WHERE member_relations_vector IS NULL;
+|]
+
+-- TODO [relations vector] re-create group_member_intros
+down_m20251128_member_relations_vector_stage_2 :: Text
+down_m20251128_member_relations_vector_stage_2 =
+ T.pack
+ [r|
+
+|]
diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql
index 712099d7c9..567aca0144 100644
--- a/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql
+++ b/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql
@@ -34,6 +34,41 @@ $$;
+CREATE FUNCTION test_chat_schema.migrate_relations_vector_step(state bytea, idx bigint, direction integer, intro_status text) RETURNS bytea
+ LANGUAGE plpgsql IMMUTABLE
+ AS $$
+DECLARE
+ new_len INT;
+ result BYTEA;
+ status INT;
+ byte_val INT;
+BEGIN
+ IF idx < 0 THEN
+ RETURN state;
+ END IF;
+ IF intro_status = 're-con' THEN
+ IF direction = 0 THEN status := 2; ELSE status := 3; END IF;
+ ELSIF intro_status = 'to-con' THEN
+ IF direction = 0 THEN status := 3; ELSE status := 2; END IF;
+ ELSIF intro_status = 'con' THEN
+ status := 4;
+ ELSE
+ status := 1;
+ END IF;
+ byte_val := (direction * 8) + status;
+ new_len := GREATEST(length(state), idx + 1);
+ IF new_len > length(state) THEN
+ result := state || (SELECT string_agg('\x00'::BYTEA, ''::BYTEA) FROM generate_series(1, new_len - length(state)));
+ ELSE
+ result := state;
+ END IF;
+ result := set_byte(result, idx::INT, byte_val);
+ RETURN result;
+END;
+$$;
+
+
+
CREATE FUNCTION test_chat_schema.on_group_members_delete_update_summary() RETURNS trigger
LANGUAGE plpgsql
AS $$
@@ -85,6 +120,45 @@ END;
$$;
+
+CREATE FUNCTION test_chat_schema.set_member_vector_new_relation(v bytea, idx bigint, direction integer, status integer) RETURNS bytea
+ LANGUAGE plpgsql IMMUTABLE
+ AS $$
+DECLARE
+ new_len INT;
+ result BYTEA;
+ byte_val INT;
+ old_byte INT;
+BEGIN
+ IF idx < 0 THEN
+ RETURN v;
+ END IF;
+ IF idx < length(v) THEN
+ old_byte := get_byte(v, idx::INT);
+ ELSE
+ old_byte := 0;
+ END IF;
+ byte_val := (old_byte & x'F0'::INT) | (direction * 8) | status;
+ new_len := GREATEST(length(v), idx + 1);
+ IF new_len > length(v) THEN
+ result := v || (SELECT string_agg('\x00'::BYTEA, ''::BYTEA) FROM generate_series(1, new_len - length(v)));
+ ELSE
+ result := v;
+ END IF;
+ result := set_byte(result, idx::INT, byte_val);
+ RETURN result;
+END;
+$$;
+
+
+
+CREATE AGGREGATE test_chat_schema.migrate_relations_vector(bigint, integer, text) (
+ SFUNC = test_chat_schema.migrate_relations_vector_step,
+ STYPE = bytea,
+ INITCOND = ''
+);
+
+
SET default_table_access_method = heap;
diff --git a/src/Simplex/Chat/Store/SQLite/Migrations.hs b/src/Simplex/Chat/Store/SQLite/Migrations.hs
index 13ada872b2..0358ae621d 100644
--- a/src/Simplex/Chat/Store/SQLite/Migrations.hs
+++ b/src/Simplex/Chat/Store/SQLite/Migrations.hs
@@ -145,6 +145,7 @@ import Simplex.Chat.Store.SQLite.Migrations.M20250922_remove_unused_connections
import Simplex.Chat.Store.SQLite.Migrations.M20251007_connections_sync
import Simplex.Chat.Store.SQLite.Migrations.M20251017_chat_tags_cascade
import Simplex.Chat.Store.SQLite.Migrations.M20251117_member_relations_vector
+-- import Simplex.Chat.Store.SQLite.Migrations.M20251128_member_relations_vector_stage_2
import Simplex.Messaging.Agent.Store.Shared (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -290,6 +291,7 @@ schemaMigrations =
("20251007_connections_sync", m20251007_connections_sync, Just down_m20251007_connections_sync),
("20251017_chat_tags_cascade", m20251017_chat_tags_cascade, Just down_m20251017_chat_tags_cascade),
("20251117_member_relations_vector", m20251117_member_relations_vector, Just down_m20251117_member_relations_vector)
+ -- ("20251128_member_relations_vector_stage_2", m20251128_member_relations_vector_stage_2, Just down_m20251128_member_relations_vector_stage_2)
]
-- | The list of migrations in ascending order by date
diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20251117_member_relations_vector.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20251117_member_relations_vector.hs
index bf5308bcfd..3e4b4157f0 100644
--- a/src/Simplex/Chat/Store/SQLite/Migrations/M20251117_member_relations_vector.hs
+++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20251117_member_relations_vector.hs
@@ -1,9 +1,77 @@
+{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.SQLite.Migrations.M20251117_member_relations_vector where
+import qualified Data.ByteString as B
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
+import Database.SQLite3 (funcArgBlob, funcArgInt64, funcArgText, funcResultBlob)
+import Database.SQLite3.Bindings
+import Foreign.C.Types
+import Foreign.Ptr
+import Simplex.Chat.Types.MemberRelations (IntroductionDirection (..), MemberRelation (..), fromIntroDirInt, fromRelationInt, setNewRelation, setNewRelations)
+import Simplex.Messaging.Agent.Store.SQLite.Util (SQLiteFunc, SQLiteFuncFinal, mkSQLiteAggFinal, mkSQLiteAggStep, mkSQLiteFunc)
+
+-- This module defines custom aggregate function migrate_relations_vector(idx, direction, intro_status).
+-- It is passed via DBOpts and registered on DB open.
+-- Used in live migration and stage 2 migration (M20251128_member_relations_vector_stage_2).
+--
+-- Vector byte encoding: 4 reserved | 1 direction | 3 status
+-- Direction: 0 = IDSubjectIntroduced, 1 = IDReferencedIntroduced
+-- Status values: 0 = MRNew, 1 = MRIntroduced, 2 = MRSubjectConnected, 3 = MRReferencedConnected, 4 = MRConnected
+--
+-- The aggregate transforms intro_status into relation status:
+-- - intro_status 'new'/'sent'/'rcv'/'fwd': MRIntroduced (1)
+-- - intro_status 're-con': if direction=0 then MRSubjectConnected (2), else MRReferencedConnected (3)
+-- - intro_status 'to-con': if direction=0 then MRReferencedConnected (3), else MRSubjectConnected (2)
+-- - intro_status 'con': MRConnected (4)
+--
+-- The final function builds the vector using setNewRelations.
+
+foreign export ccall "simplex_member_relations_step" sqliteMemberRelationsStep :: SQLiteFunc
+
+foreign import ccall "&simplex_member_relations_step" sqliteMemberRelationsStepPtr :: FunPtr SQLiteFunc
+
+foreign export ccall "simplex_member_relations_final" sqliteMemberRelationsFinal :: SQLiteFuncFinal
+
+foreign import ccall "&simplex_member_relations_final" sqliteMemberRelationsFinalPtr :: FunPtr SQLiteFuncFinal
+
+-- Step function for migrate_relations_vector aggregate.
+-- Accumulates (idx, direction, relation) tuples.
+sqliteMemberRelationsStep :: SQLiteFunc
+sqliteMemberRelationsStep = mkSQLiteAggStep [] $ \_ args acc -> do
+ idx <- funcArgInt64 args 0
+ direction <- fromIntroDirInt . fromIntegral <$> funcArgInt64 args 1
+ introStatus <- funcArgText args 2
+ let relation = introStatusToRelation direction introStatus
+ pure $ (idx, (direction, relation)) : acc
+ where
+ introStatusToRelation dir status = case status of
+ "re-con" -> if dir == IDSubjectIntroduced then MRSubjectConnected else MRReferencedConnected
+ "to-con" -> if dir == IDSubjectIntroduced then MRReferencedConnected else MRSubjectConnected
+ "con" -> MRConnected
+ _ -> MRIntroduced -- 'new', 'sent', 'rcv', 'fwd'
+
+-- Final function for migrate_relations_vector aggregate.
+-- Builds the vector from accumulated tuples using setNewRelations.
+sqliteMemberRelationsFinal :: SQLiteFuncFinal
+sqliteMemberRelationsFinal = mkSQLiteAggFinal [] $ \cxt acc -> funcResultBlob cxt $ setNewRelations acc B.empty
+
+-- Non-aggregate function set_member_vector_new_relation(vector, idx, direction, status).
+-- Sets a new relation in the vector and returns the updated vector.
+
+foreign export ccall "simplex_set_member_vector_new_relation" sqliteSetMemberVectorNewRelation :: SQLiteFunc
+
+foreign import ccall "&simplex_set_member_vector_new_relation" sqliteSetMemberVectorNewRelationPtr :: FunPtr SQLiteFunc
+
+sqliteSetMemberVectorNewRelation :: SQLiteFunc
+sqliteSetMemberVectorNewRelation = mkSQLiteFunc $ \cxt args -> do
+ v <- funcArgBlob args 0
+ idx <- funcArgInt64 args 1
+ direction <- fromIntroDirInt . fromIntegral <$> funcArgInt64 args 2
+ status <- fromRelationInt . fromIntegral <$> funcArgInt64 args 3
+ funcResultBlob cxt $ setNewRelation idx direction status v
m20251117_member_relations_vector :: Query
m20251117_member_relations_vector =
@@ -46,6 +114,18 @@ SET member_index = COALESCE((
FROM group_members
WHERE group_members.group_id = g.group_id
), 0);
+
+UPDATE group_members
+SET member_relations_vector = x''
+WHERE group_id IN (
+ SELECT mu.group_id
+ FROM group_members mu
+ WHERE mu.member_category = 'user'
+ AND (
+ mu.member_role NOT IN (CAST('admin' AS BLOB), CAST('owner' AS BLOB))
+ OR mu.member_status IN ('removed', 'left', 'deleted')
+ )
+);
|]
down_m20251117_member_relations_vector :: Query
diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20251128_member_relations_vector_stage_2.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20251128_member_relations_vector_stage_2.hs
new file mode 100644
index 0000000000..f510a50410
--- /dev/null
+++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20251128_member_relations_vector_stage_2.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Store.SQLite.Migrations.M20251128_member_relations_vector_stage_2 where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+-- Build member_relations_vector for all members that don't have it yet.
+-- Uses custom aggregate function migrate_relations_vector defined in M20251117_member_relations_vector.
+--
+-- Query returns (idx, direction, intro_status) for each introduction:
+-- - direction 0 (IDSubjectIntroduced): current member (subject) is re_group_member_id, was introduced to referenced member
+-- - direction 1 (IDReferencedIntroduced): current member (subject) is to_group_member_id, referenced member was introduced to it
+
+-- TODO [relations vector] drop group_member_intros in the end of migration
+m20251128_member_relations_vector_stage_2 :: Query
+m20251128_member_relations_vector_stage_2 =
+ [sql|
+UPDATE group_members
+SET member_relations_vector = (
+ SELECT migrate_relations_vector(idx, direction, intro_status)
+ FROM (
+ SELECT m.index_in_group AS idx, 0 AS direction, i.intro_status
+ FROM group_member_intros i
+ JOIN group_members m ON m.group_member_id = i.to_group_member_id
+ WHERE i.re_group_member_id = group_members.group_member_id
+ UNION ALL
+ SELECT m.index_in_group AS idx, 1 AS direction, i.intro_status
+ FROM group_member_intros i
+ JOIN group_members m ON m.group_member_id = i.re_group_member_id
+ WHERE i.to_group_member_id = group_members.group_member_id
+ )
+)
+WHERE member_relations_vector IS NULL;
+|]
+
+-- TODO [relations vector] re-create group_member_intros
+down_m20251128_member_relations_vector_stage_2 :: Query
+down_m20251128_member_relations_vector_stage_2 =
+ [sql|
+
+|]
diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt
index 9156b56fcb..c46f6a5e7d 100644
--- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt
+++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_query_plans.txt
@@ -24,10 +24,10 @@ SEARCH contact_requests USING INTEGER PRIMARY KEY (rowid=?)
Query:
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_single_sender_group_member_id (single_sender_group_member_id=?)
@@ -76,10 +76,10 @@ SEARCH groups USING INTEGER PRIMARY KEY (rowid=?)
Query:
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, sent_inv_queue_info, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_single_sender_group_member_id (single_sender_group_member_id=?)
@@ -260,9 +260,9 @@ SEARCH users USING INTEGER PRIMARY KEY (rowid=?)
Query:
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_single_sender_group_member_id (single_sender_group_member_id=?)
@@ -293,10 +293,10 @@ SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (conta
Query:
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, member_profile_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_single_sender_group_member_id (single_sender_group_member_id=?)
@@ -327,10 +327,10 @@ SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (conta
Query:
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, member_xcontact_id, member_welcome_shared_msg_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_single_sender_group_member_id (single_sender_group_member_id=?)
@@ -492,9 +492,9 @@ SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?)
Query:
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_single_sender_group_member_id (single_sender_group_member_id=?)
@@ -525,10 +525,10 @@ SEARCH contacts USING COVERING INDEX idx_contacts_contact_group_member_id (conta
Query:
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by, invited_by_group_member_id,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_single_sender_group_member_id (single_sender_group_member_id=?)
@@ -989,19 +989,12 @@ Query:
Plan:
-Query:
- INSERT INTO group_member_intros
- (re_group_member_id, to_group_member_id, intro_status, intro_chat_protocol_version, created_at, updated_at)
- VALUES (?,?,?,?,?,?)
-
-Plan:
-
Query:
INSERT INTO group_members
- (group_id, index_in_group, member_id, member_role, member_category, member_status, member_restriction, invited_by, invited_by_group_member_id,
+ (group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, member_restriction, invited_by, invited_by_group_member_id,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_single_sender_group_member_id (single_sender_group_member_id=?)
@@ -1191,24 +1184,6 @@ SEARCH c USING INDEX idx_connections_via_contact_uri_hash (user_id=? AND via_con
SEARCH ct USING INTEGER PRIMARY KEY (rowid=?)
SEARCH cp USING INTEGER PRIMARY KEY (rowid=?)
-Query:
- SELECT 1
- FROM group_member_intros
- WHERE
- (
- (re_group_member_id = ? AND to_group_member_id = ?) OR
- (re_group_member_id = ? AND to_group_member_id = ?)
- )
- AND intro_status NOT IN (?,?,?)
- LIMIT 1
-
-Plan:
-MULTI-INDEX OR
-INDEX 1
-SEARCH group_member_intros USING INDEX sqlite_autoindex_group_member_intros_1 (re_group_member_id=? AND to_group_member_id=?)
-INDEX 2
-SEARCH group_member_intros USING INDEX sqlite_autoindex_group_member_intros_1 (re_group_member_id=? AND to_group_member_id=?)
-
Query:
SELECT 1 FROM users
WHERE (user_id = ? AND local_display_name = ?)
@@ -1455,28 +1430,6 @@ Plan:
SEARCH g USING INTEGER PRIMARY KEY (rowid=?)
SEARCH i USING INTEGER PRIMARY KEY (rowid=?)
-Query:
- SELECT i.re_group_member_id
- FROM group_member_intros i
- JOIN group_members m ON m.group_member_id = i.re_group_member_id
- WHERE i.to_group_member_id = ? AND i.intro_status NOT IN (?,?,?)
- AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?,?)
-
-Plan:
-SEARCH i USING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
-SEARCH m USING INTEGER PRIMARY KEY (rowid=?)
-
-Query:
- SELECT i.to_group_member_id
- FROM group_member_intros i
- JOIN group_members m ON m.group_member_id = i.to_group_member_id
- WHERE i.re_group_member_id = ? AND i.intro_status NOT IN (?,?,?)
- AND (m.contact_id IS NULL OR m.contact_id != ?) AND m.member_role IN (?,?,?)
-
-Plan:
-SEARCH i USING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
-SEARCH m USING INTEGER PRIMARY KEY (rowid=?)
-
Query:
SELECT member_status
FROM group_members
@@ -1645,10 +1598,10 @@ SEARCH users USING COVERING INDEX sqlite_autoindex_users_1 (contact_id=?)
Query:
INSERT INTO group_members
- ( group_id, index_in_group, member_id, member_role, member_category, member_status, invited_by,
+ ( group_id, index_in_group, member_id, member_role, member_category, member_status, member_relations_vector, invited_by,
user_id, local_display_name, contact_id, contact_profile_id, created_at, updated_at,
peer_chat_min_version, peer_chat_max_version)
- VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
+ VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)
Plan:
SEARCH delivery_jobs USING COVERING INDEX idx_delivery_jobs_single_sender_group_member_id (single_sender_group_member_id=?)
@@ -3509,6 +3462,14 @@ Plan:
SEARCH f USING INTEGER PRIMARY KEY (rowid=?)
SEARCH i USING INTEGER PRIMARY KEY (rowid=?)
+Query:
+ SELECT index_in_group, member_relations_vector
+ FROM group_members
+ WHERE local_display_name = ?
+
+Plan:
+SCAN group_members
+
Query:
SELECT m.group_member_id
FROM group_members m
@@ -3559,14 +3520,6 @@ SEARCH r USING INDEX idx_chat_item_mentions_chat_item_id (chat_item_id=?)
SEARCH m USING INDEX sqlite_autoindex_group_members_1 (group_id=? AND member_id=?) LEFT-JOIN
SEARCH p USING INTEGER PRIMARY KEY (rowid=?) LEFT-JOIN
-Query:
- SELECT re_group_member_id
- FROM group_member_intros
- WHERE to_group_member_id = ? AND intro_status NOT IN (?,?,?)
- AND intro_chat_protocol_version >= ?
-Plan:
-SEARCH group_member_intros USING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
-
Query:
SELECT reaction
FROM chat_item_reactions
@@ -3655,14 +3608,6 @@ Query:
Plan:
SEARCH protocol_servers USING INDEX idx_smp_servers_user_id (user_id=?)
-Query:
- SELECT to_group_member_id
- FROM group_member_intros
- WHERE re_group_member_id = ? AND intro_status NOT IN (?,?,?)
- AND intro_chat_protocol_version >= ?
-Plan:
-SEARCH group_member_intros USING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
-
Query:
SELECT usage_conditions_id, conditions_commit, notified_at, created_at
FROM usage_conditions
@@ -3782,6 +3727,40 @@ SCAN group_members USING COVERING INDEX idx_group_members_user_id_local_display_
LIST SUBQUERY 2
SCAN group_members USING COVERING INDEX idx_group_members_user_id_local_display_name
+Query:
+ UPDATE group_members
+ SET
+ member_relations_vector = (
+ SELECT migrate_relations_vector(idx, direction, intro_status)
+ FROM (
+ SELECT m.index_in_group AS idx, 0 AS direction, i.intro_status
+ FROM group_member_intros i
+ JOIN group_members m ON m.group_member_id = i.to_group_member_id
+ WHERE i.re_group_member_id = group_members.group_member_id
+ UNION ALL
+ SELECT m.index_in_group AS idx, 1 AS direction, i.intro_status
+ FROM group_member_intros i
+ JOIN group_members m ON m.group_member_id = i.re_group_member_id
+ WHERE i.to_group_member_id = group_members.group_member_id
+ ) AS relations
+ ),
+ updated_at = ?
+ WHERE group_member_id = ?
+ AND member_relations_vector IS NULL
+
+Plan:
+SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
+CORRELATED SCALAR SUBQUERY 3
+CO-ROUTINE relations
+COMPOUND QUERY
+LEFT-MOST SUBQUERY
+SEARCH i USING INDEX idx_group_member_intros_re_group_member_id (re_group_member_id=?)
+SEARCH m USING INTEGER PRIMARY KEY (rowid=?)
+UNION ALL
+SEARCH i USING INDEX idx_group_member_intros_to_group_member_id (to_group_member_id=?)
+SEARCH m USING INTEGER PRIMARY KEY (rowid=?)
+SCAN relations
+
Query:
UPDATE group_members
SET contact_id = ?, local_display_name = ?, contact_profile_id = ?, updated_at = ?
@@ -3790,6 +3769,14 @@ Query:
Plan:
SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
+Query:
+ UPDATE group_members
+ SET member_relations_vector = ?
+ WHERE local_display_name = ?
+
+Plan:
+SCAN group_members
+
Query:
UPDATE groups
SET member_index = member_index + 1
@@ -4739,12 +4726,12 @@ Plan:
SEARCH contacts USING INTEGER PRIMARY KEY (rowid=?)
Query:
- UPDATE group_member_intros
- SET intro_status = ?, updated_at = ?
- WHERE group_member_intro_id = ?
+ UPDATE group_members
+ SET member_relations_vector = ?, updated_at = ?
+ WHERE group_member_id = ?
Plan:
-SEARCH group_member_intros USING INTEGER PRIMARY KEY (rowid=?)
+SEARCH group_members USING INTEGER PRIMARY KEY (rowid=?)
Query:
UPDATE group_members
@@ -5133,6 +5120,44 @@ SEARCH m USING INTEGER PRIMARY KEY (rowid=?)
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
+Query:
+ SELECT
+ m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
+ m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
+ m.created_at, m.updated_at,
+ m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
+ c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
+ c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
+ c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
+ c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
+ FROM group_members m
+ JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
+ LEFT JOIN connections c ON c.group_member_id = m.group_member_id
+ WHERE m.group_id = ? AND m.index_in_group = ?
+Plan:
+SEARCH m USING INDEX idx_group_members_group_id_index_in_group (group_id=? AND index_in_group=?)
+SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
+SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
+
+Query:
+ SELECT
+ m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
+ m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
+ m.created_at, m.updated_at,
+ m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
+ c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
+ c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
+ c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
+ c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
+ FROM group_members m
+ JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
+ LEFT JOIN connections c ON c.group_member_id = m.group_member_id
+ WHERE m.group_id = ? AND m.index_in_group = ? AND (m.member_role IN (?,?,?) OR m.group_member_id = ?)
+Plan:
+SEARCH m USING INDEX idx_group_members_group_id_index_in_group (group_id=? AND index_in_group=?)
+SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
+SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
+
Query:
SELECT
m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
@@ -5209,25 +5234,6 @@ SEARCH m USING INDEX idx_group_members_group_id (user_id=? AND group_id=?)
SEARCH p USING INTEGER PRIMARY KEY (rowid=?)
SEARCH c USING INDEX idx_connections_group_member_id (group_member_id=?) LEFT-JOIN
-Query:
- SELECT
- m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction,
- m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.short_descr, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences,
- m.created_at, m.updated_at,
- m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts,
- c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.xcontact_id, c.custom_user_profile_id,
- c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.user_contact_link_id,
- c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
- c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
- FROM group_members m
- JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
- LEFT JOIN connections c ON c.group_member_id = m.group_member_id
- WHERE m.user_id = ? AND m.group_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) AND index_in_group < ?
-Plan:
-SEARCH m USING INDEX idx_group_members_group_id_index_in_group (group_id=? AND index_in_group Word8
+toIntroDirInt = \case
+ IDSubjectIntroduced -> 0
+ IDReferencedIntroduced -> 1
+
+fromIntroDirInt :: Word8 -> IntroductionDirection
+fromIntroDirInt = \case
+ 0 -> IDSubjectIntroduced
+ 1 -> IDReferencedIntroduced
+ _ -> IDSubjectIntroduced
+
data MemberRelation
= MRNew
| MRIntroduced
- | MRConnected
- deriving (Eq, Show)
+ | MRSubjectConnected -- Subject member notified about connection to referenced member
+ | MRReferencedConnected -- Referenced member notified about connection to subject member
+ | MRConnected -- Both members notified about connection
+ deriving (Eq, Ord, Show)
toRelationInt :: MemberRelation -> Word8
toRelationInt = \case
MRNew -> 0
MRIntroduced -> 1
- MRConnected -> 2
+ MRSubjectConnected -> 2
+ MRReferencedConnected -> 3
+ MRConnected -> 4
fromRelationInt :: Word8 -> MemberRelation
fromRelationInt = \case
0 -> MRNew
1 -> MRIntroduced
- 2 -> MRConnected
+ 2 -> MRSubjectConnected
+ 3 -> MRReferencedConnected
+ 4 -> MRConnected
_ -> MRNew
+-- Bit layout: 4 reserved | 1 direction | 3 status
+
-- | Get the relation status of a member at a given index from the relations vector.
-- Returns 'MRNew' if the vector is not long enough (lazy initialization).
getRelation :: Int64 -> ByteString -> MemberRelation
-getRelation i v
- | i < 0 || fromIntegral i >= B.length v = MRNew
- | otherwise = fromRelationInt $ (v `B.index` fromIntegral i) .&. relationMask
+getRelation i v = snd $ getRelation' i v
+-- | Get both direction and status of a member at a given index from the relations vector.
+-- Returns (IDSubjectIntroduced, MRNew) if the vector is not long enough (lazy initialization).
+getRelation' :: Int64 -> ByteString -> (IntroductionDirection, MemberRelation)
+getRelation' i v
+ | i < 0 || fromIntegral i >= B.length v = (IDSubjectIntroduced, MRNew)
+ | otherwise =
+ let b = v `B.index` fromIntegral i
+ in (fromIntroDirInt $ (b .&. directionMask) `shiftR` 3, fromRelationInt $ b .&. statusMask)
+
+-- | Get the indexes of members with the given relation status from the relations vector.
+getRelationsIndexes :: MemberRelation -> ByteString -> [Int64]
+getRelationsIndexes r v = [i | i <- [0 .. fromIntegral (B.length v) - 1], getRelation i v == r]
-- | Set the relation status of a member at a given index in the relations vector.
--- Expands the vector lazily if needed (padding with zeros for 'MRNew' relation).
+-- Preserves the introduction direction. Expands the vector lazily if needed.
setRelation :: Int64 -> MemberRelation -> ByteString -> ByteString
setRelation i r v
| i >= 0 = setRelations [(i, r)] v
| otherwise = v
--- | Set multiple relations at once.
--- Expands the vector lazily if needed (padding with zeros for 'MRNew' relation).
+-- | Set multiple relation statuses at once.
+-- Preserves the introduction direction. Expands the vector lazily if needed.
setRelations :: [(Int64, MemberRelation)] -> ByteString -> ByteString
-setRelations [] v = v
-setRelations relations v =
+setRelations = setRelations_ $ \r b -> (b .&. complement statusMask) .|. toRelationInt r
+
+-- | Set relation to connected state based on passed status and current status.
+-- newStatus should be MRSubjectConnected or MRReferencedConnected, otherwise returns vector unchanged.
+-- Logic:
+-- - if newStatus is complementary to oldStatus -> set MRConnected
+-- - if newStatus > oldStatus (by enum order) -> set newStatus
+-- - otherwise don't update
+setRelationConnected :: Int64 -> MemberRelation -> ByteString -> ByteString
+setRelationConnected i newStatus v
+ | newStatus /= MRSubjectConnected && newStatus /= MRReferencedConnected = v
+ | otherwise = case status' of
+ Nothing -> v
+ Just s -> setRelation i s v
+ where
+ oldStatus = getRelation i v
+ status' = case (oldStatus, newStatus) of
+ -- complementary statuses -> MRConnected
+ (MRSubjectConnected, MRReferencedConnected) -> Just MRConnected
+ (MRReferencedConnected, MRSubjectConnected) -> Just MRConnected
+ -- newStatus > oldStatus -> set newStatus
+ _ | newStatus > oldStatus -> Just newStatus
+ | otherwise -> Nothing
+
+-- | Set a new relation with both direction and status at a given index.
+-- Expands the vector lazily if needed.
+setNewRelation :: Int64 -> IntroductionDirection -> MemberRelation -> ByteString -> ByteString
+setNewRelation i dir r v
+ | i >= 0 = setNewRelations [(i, (dir, r))] v
+ | otherwise = v
+
+-- | Set multiple new relations with both direction and status at once.
+-- Expands the vector lazily if needed.
+setNewRelations :: [(Int64, (IntroductionDirection, MemberRelation))] -> ByteString -> ByteString
+setNewRelations = setRelations_ $ \(dir, r) b -> (b .&. relationMask) .|. (toIntroDirInt dir `shiftL` 3) .|. toRelationInt r
+ where
+ relationMask = complement (statusMask .|. directionMask)
+
+setRelations_ :: (r -> Word8 -> Word8) -> [(Int64, r)] -> ByteString -> ByteString
+setRelations_ _ [] v = v
+setRelations_ updateByte relations v =
let (fp, off, len) = toForeignPtr v
newLen = max len $ fromIntegral $ maximum (map fst relations) + 1
in unsafeCreate newLen $ \ptr -> do
withForeignPtr fp $ \vPtr -> copyBytes ptr (vPtr `plusPtr` off) len
when (newLen > len) $ fillBytes (ptr `plusPtr` len) 0 (newLen - len)
- forM_ relations $ \(ix, r) -> when (ix >= 0) $ do
+ forM_ relations $ \(ix, r) -> when (ix >= 0) $
let i = fromIntegral ix
- b <- peekByteOff ptr i
- let b' = (b .&. complement relationMask) .|. toRelationInt r
- pokeByteOff ptr i b'
+ in pokeByteOff ptr i . updateByte r =<< peekByteOff ptr i
-relationMask :: Word8
-relationMask = 0x07 -- reserving 3 bits
+statusMask :: Word8
+statusMask = 0x07 -- bits 0-2
+
+directionMask :: Word8
+directionMask = 0x08 -- bit 3
diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs
index c16f76148f..f4a995adfe 100644
--- a/src/Simplex/Chat/View.hs
+++ b/src/Simplex/Chat/View.hs
@@ -24,7 +24,6 @@ import Data.Function (on)
import Data.Int (Int64)
import Data.List (groupBy, intercalate, intersperse, sortOn)
import Data.List.NonEmpty (NonEmpty (..))
-import qualified Data.List.NonEmpty as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs
index 4c5efa26b6..42562d8e16 100644
--- a/tests/ChatTests/Groups.hs
+++ b/tests/ChatTests/Groups.hs
@@ -18,6 +18,7 @@ import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_)
import Control.Monad (forM_, void, when)
import Data.Bifunctor (second)
+import Data.Maybe (fromMaybe)
import qualified Data.ByteString.Char8 as B
import Data.Int (Int64)
import Data.List (intercalate, isInfixOf)
@@ -30,10 +31,12 @@ import Simplex.Chat.Messages (CIMention (..), CIMentionMember (..), ChatItemId)
import Simplex.Chat.Options
import Simplex.Chat.Protocol (MsgMention (..), MsgContent (..), msgContentText)
import Simplex.Chat.Types
+import Simplex.Chat.Types.MemberRelations (MemberRelation (..), setRelation)
import Simplex.Chat.Types.Shared (GroupMemberRole (..), GroupAcceptance (..))
import Simplex.Messaging.Agent.Env.SQLite
import Simplex.Messaging.Agent.RetryInterval
import qualified Simplex.Messaging.Agent.Store.DB as DB
+import Simplex.Messaging.Agent.Store.DB (Binary (..))
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Server.Env.STM hiding (subscriptions)
import Simplex.Messaging.Transport
@@ -1769,6 +1772,7 @@ testGroupDelayedModeration ps = do
-- and forwarding client doesn't check compatibility)
void $ withCCTransaction alice $ \db ->
DB.execute_ db "UPDATE group_member_intros SET intro_status='con'"
+ updateGroupForwardingVectors alice "bob" "cath" MRConnected
cath #> "#team hi" -- message is pending for bob
alice <# "#team cath> hi"
@@ -1815,6 +1819,7 @@ testGroupDelayedModerationFullDelete ps = do
-- and forwarding client doesn't check compatibility)
void $ withCCTransaction alice $ \db ->
DB.execute_ db "UPDATE group_member_intros SET intro_status='con'"
+ updateGroupForwardingVectors alice "bob" "cath" MRConnected
cath #> "#team hi" -- message is pending for bob
alice <# "#team cath> hi"
@@ -5018,7 +5023,7 @@ testGroupMsgForwardReport =
setupGroupForwarding :: TestCC -> TestCC -> TestCC -> IO ()
setupGroupForwarding host invitee1 invitee2 = do
- threadDelay 1000000 -- delay so intro_status doesn't get overwritten to connected
+ threadDelay 1000000 -- delay so member relations don't get overwritten to connected
invitee1Name <- userName invitee1
invitee2Name <- userName invitee2
@@ -5050,15 +5055,60 @@ setupGroupForwarding host invitee1 invitee2 = do
|]
(invitee1Name, invitee2Name)
+ setupGroupForwardingVectors host invitee1 invitee2
+
+setupGroupForwardingVectors :: TestCC -> TestCC -> TestCC -> IO ()
+setupGroupForwardingVectors host invitee1 invitee2 = do
+ invitee1Name <- userName invitee1
+ invitee2Name <- userName invitee2
+ updateGroupForwardingVectors host invitee1Name invitee2Name MRIntroduced
+
+updateGroupForwardingVectors :: TestCC -> String -> String -> MemberRelation -> IO ()
+updateGroupForwardingVectors host invitee1Name invitee2Name relation = do
+ void $ withCCTransaction host $ \db -> do
+ [(invitee1Index, invitee1Vec)] <- DB.query db
+ [sql|
+ SELECT index_in_group, member_relations_vector
+ FROM group_members
+ WHERE local_display_name = ?
+ |]
+ (Only invitee1Name)
+ [(invitee2Index, invitee2Vec)] <- DB.query db
+ [sql|
+ SELECT index_in_group, member_relations_vector
+ FROM group_members
+ WHERE local_display_name = ?
+ |]
+ (Only invitee2Name)
+
+ let invitee1Vec' = setRelation invitee2Index relation (fromMaybe B.empty invitee1Vec)
+ DB.execute db
+ [sql|
+ UPDATE group_members
+ SET member_relations_vector = ?
+ WHERE local_display_name = ?
+ |]
+ (Binary invitee1Vec', invitee1Name)
+
+ let invitee2Vec' = setRelation invitee1Index relation (fromMaybe B.empty invitee2Vec)
+ DB.execute db
+ [sql|
+ UPDATE group_members
+ SET member_relations_vector = ?
+ WHERE local_display_name = ?
+ |]
+ (Binary invitee2Vec', invitee2Name)
+
testGroupMsgForwardDeduplicate :: HasCallStack => TestParams -> IO ()
testGroupMsgForwardDeduplicate =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
- threadDelay 1000000 -- delay so intro_status doesn't get overwritten to connected
+ threadDelay 1000000 -- delay so member relations don't get overwritten to connected
void $ withCCTransaction alice $ \db ->
DB.execute_ db "UPDATE group_member_intros SET intro_status='fwd'"
+ setupGroupForwardingVectors alice bob cath
bob #> "#team hi there"
alice <# "#team bob> hi there"
diff --git a/tests/MemberRelationsTests.hs b/tests/MemberRelationsTests.hs
index 968dcbec43..c1afbd7f6a 100644
--- a/tests/MemberRelationsTests.hs
+++ b/tests/MemberRelationsTests.hs
@@ -29,21 +29,23 @@ memberRelationsTests = do
getRelation 0 vec `shouldBe` MRIntroduced
it "reads multiple relations" $ do
- let vec = B.pack [0, 0, 1, 2]
+ let vec = B.pack [0, 0, 1, 2, 3, 4]
getRelation 0 vec `shouldBe` MRNew
getRelation 1 vec `shouldBe` MRNew
getRelation 2 vec `shouldBe` MRIntroduced
- getRelation 3 vec `shouldBe` MRConnected
+ getRelation 3 vec `shouldBe` MRSubjectConnected
+ getRelation 4 vec `shouldBe` MRReferencedConnected
+ getRelation 5 vec `shouldBe` MRConnected
it "reads multiple relations 2" $ do
let vec = B.pack [1, 1, 0, 0, 2, 2, 0, 0]
getRelation 0 vec `shouldBe` MRIntroduced
getRelation 1 vec `shouldBe` MRIntroduced
- getRelation 4 vec `shouldBe` MRConnected
- getRelation 5 vec `shouldBe` MRConnected
+ getRelation 4 vec `shouldBe` MRSubjectConnected
+ getRelation 5 vec `shouldBe` MRSubjectConnected
it "ignore reserved bits" $ do
- let vec = B.pack [0xF9] -- 11111001
+ let vec = B.pack [0xF1] -- reserved=1111, direction=0, status=001
getRelation 0 vec `shouldBe` MRIntroduced
describe "setRelation" $ do
@@ -56,9 +58,9 @@ memberRelationsTests = do
vec `shouldBe` B.empty
it "expands vector to required length" $ do
- let vec = setRelation 5 MRConnected B.empty
+ let vec = setRelation 5 MRSubjectConnected B.empty
B.length vec `shouldBe` 6
- getRelation 5 vec `shouldBe` MRConnected
+ getRelation 5 vec `shouldBe` MRSubjectConnected
-- Other positions should be MRNew (0)
getRelation 0 vec `shouldBe` MRNew
getRelation 10 vec `shouldBe` MRNew
@@ -69,21 +71,21 @@ memberRelationsTests = do
let vec1 = setRelation 0 MRIntroduced B.empty
let vec2 = setRelation 1 MRIntroduced vec1
-- Update: [01][10][00][00]
- let vec3 = setRelation 1 MRConnected vec2
+ let vec3 = setRelation 1 MRSubjectConnected vec2
getRelation 0 vec3 `shouldBe` MRIntroduced
- getRelation 1 vec3 `shouldBe` MRConnected
+ getRelation 1 vec3 `shouldBe` MRSubjectConnected
it "updates relation in specific byte of multi-byte vector" $ do
let vec1 = setRelation 0 MRIntroduced B.empty
- let vec2 = setRelation 10 MRConnected vec1
+ let vec2 = setRelation 10 MRSubjectConnected vec1
B.length vec2 `shouldBe` 11
getRelation 0 vec2 `shouldBe` MRIntroduced
- getRelation 10 vec2 `shouldBe` MRConnected
+ getRelation 10 vec2 `shouldBe` MRSubjectConnected
forM_ [1..9] $ \i -> getRelation i vec2 `shouldBe` MRNew
it "handles setting relation at last position in byte" $ do
- let vec = setRelation 3 MRConnected B.empty
- getRelation 3 vec `shouldBe` MRConnected
+ let vec = setRelation 3 MRSubjectConnected B.empty
+ getRelation 3 vec `shouldBe` MRSubjectConnected
it "preserves vector when setting same value" $ do
let vec1 = setRelation 0 MRIntroduced B.empty
@@ -91,12 +93,24 @@ memberRelationsTests = do
vec2 `shouldBe` vec1
getRelation 0 vec2 `shouldBe` MRIntroduced
- it "preserves reserved bits" $ do
- let v = B.pack [0xF8] -- 11111000
+ it "preserves reserved bits and direction" $ do
+ let v = B.pack [0xF8] -- reserved=1111, direction=1, status=000
getRelation 0 v `shouldBe` MRNew
- let v' = setRelation 0 MRIntroduced v
- getRelation 0 v' `shouldBe` MRIntroduced
- B.unpack v' `shouldBe` [0xF9] -- 11111001
+ let v' = setRelation 0 MRConnected v
+ getRelation 0 v' `shouldBe` MRConnected
+ B.unpack v' `shouldBe` [0xFC] -- reserved=1111, direction=1, status=100
+
+ describe "setNewRelation" $ do
+ it "sets new relation with direction" $ do
+ let vec = setNewRelation 0 IDReferencedIntroduced MRSubjectConnected B.empty
+ getRelation' 0 vec `shouldBe` (IDReferencedIntroduced, MRSubjectConnected)
+ B.unpack vec `shouldBe` [0x0A] -- direction=1, status=010
+
+ it "preserves reserved bits" $ do
+ let v = B.pack [0xF0] -- reserved=1111, direction=0, status=000
+ let v' = setNewRelation 0 IDReferencedIntroduced MRConnected v
+ getRelation 0 v' `shouldBe` MRConnected
+ B.unpack v' `shouldBe` [0xFC] -- reserved=1111, direction=1, status=100
describe "setRelations" $ do
it "returns same vector for empty list" $ do
@@ -104,106 +118,183 @@ memberRelationsTests = do
setRelations [] vec `shouldBe` vec
it "sets multiple relations in empty vector" $ do
- let updates = [(0, MRIntroduced), (1, MRConnected), (2, MRIntroduced)]
+ let updates = [(0, MRIntroduced), (1, MRSubjectConnected), (2, MRReferencedConnected), (3, MRConnected)]
let vec = setRelations updates B.empty
getRelation 0 vec `shouldBe` MRIntroduced
- getRelation 1 vec `shouldBe` MRConnected
- getRelation 2 vec `shouldBe` MRIntroduced
- getRelation 3 vec `shouldBe` MRNew -- Unset position
+ getRelation 1 vec `shouldBe` MRSubjectConnected
+ getRelation 2 vec `shouldBe` MRReferencedConnected
+ getRelation 3 vec `shouldBe` MRConnected
+ getRelation 4 vec `shouldBe` MRNew -- Unset position
it "sets multiple relations 1" $ do
- let updates = [(0, MRIntroduced), (1, MRConnected), (2, MRConnected), (3, MRIntroduced)]
+ let updates = [(0, MRIntroduced), (1, MRSubjectConnected), (2, MRSubjectConnected), (3, MRIntroduced)]
let vec = setRelations updates B.empty
B.length vec `shouldBe` 4
getRelation 0 vec `shouldBe` MRIntroduced
- getRelation 1 vec `shouldBe` MRConnected
- getRelation 2 vec `shouldBe` MRConnected
+ getRelation 1 vec `shouldBe` MRSubjectConnected
+ getRelation 2 vec `shouldBe` MRSubjectConnected
getRelation 3 vec `shouldBe` MRIntroduced
it "sets multiple relations 2" $ do
- let updates = [(0, MRIntroduced), (5, MRConnected), (10, MRIntroduced)]
+ let updates = [(0, MRIntroduced), (5, MRSubjectConnected), (10, MRIntroduced)]
let vec = setRelations updates B.empty
B.length vec `shouldBe` 11
getRelation 0 vec `shouldBe` MRIntroduced
- getRelation 5 vec `shouldBe` MRConnected
+ getRelation 5 vec `shouldBe` MRSubjectConnected
getRelation 10 vec `shouldBe` MRIntroduced
getRelation 7 vec `shouldBe` MRNew -- Unset position between
it "handles sparse updates (few indices in large range)" $ do
-- Sparse: 3 updates in large group
- let updates = [(0, MRIntroduced), (100, MRConnected), (5000, MRIntroduced)]
+ let updates = [(0, MRIntroduced), (100, MRSubjectConnected), (5000, MRIntroduced)]
let vec = setRelations updates B.empty
getRelation 0 vec `shouldBe` MRIntroduced
- getRelation 100 vec `shouldBe` MRConnected
+ getRelation 100 vec `shouldBe` MRSubjectConnected
getRelation 5000 vec `shouldBe` MRIntroduced
getRelation 50 vec `shouldBe` MRNew -- Untouched position
it "handles dense updates (many consecutive indices)" $ do
-- Dense: many consecutive updates
- let updates = [(i, if even i then MRIntroduced else MRConnected) | i <- [0 .. 99]]
+ let updates = [(i, if even i then MRIntroduced else MRSubjectConnected) | i <- [0 .. 99]]
let vec = setRelations updates B.empty
- all (\i -> getRelation i vec == (if even i then MRIntroduced else MRConnected)) [0 .. 99] `shouldBe` True
+ all (\i -> getRelation i vec == (if even i then MRIntroduced else MRSubjectConnected)) [0 .. 99] `shouldBe` True
it "handles unsorted input correctly" $ do
- let updates = [(10, MRConnected), (2, MRIntroduced), (5, MRConnected), (0, MRIntroduced)]
+ let updates = [(10, MRSubjectConnected), (2, MRIntroduced), (5, MRSubjectConnected), (0, MRIntroduced)]
let vec = setRelations updates B.empty
getRelation 0 vec `shouldBe` MRIntroduced
getRelation 2 vec `shouldBe` MRIntroduced
- getRelation 5 vec `shouldBe` MRConnected
- getRelation 10 vec `shouldBe` MRConnected
+ getRelation 5 vec `shouldBe` MRSubjectConnected
+ getRelation 10 vec `shouldBe` MRSubjectConnected
it "handles duplicate indices (last one wins)" $ do
- let updates = [(0, MRIntroduced), (0, MRConnected), (0, MRIntroduced)]
+ let updates = [(0, MRIntroduced), (0, MRSubjectConnected), (0, MRIntroduced)]
let vec = setRelations updates B.empty
getRelation 0 vec `shouldBe` MRIntroduced
it "preserves existing relations not in update list" $ do
- let vec1 = setRelation 0 MRConnected B.empty
+ let vec1 = setRelation 0 MRSubjectConnected B.empty
let vec2 = setRelation 5 MRIntroduced vec1
- let updates = [(10, MRConnected)]
+ let updates = [(10, MRSubjectConnected)]
let vec3 = setRelations updates vec2
- getRelation 0 vec3 `shouldBe` MRConnected
+ getRelation 0 vec3 `shouldBe` MRSubjectConnected
getRelation 5 vec3 `shouldBe` MRIntroduced
- getRelation 10 vec3 `shouldBe` MRConnected
+ getRelation 10 vec3 `shouldBe` MRSubjectConnected
+
+ describe "setNewRelations" $ do
+ it "sets multiple new relations with direction" $ do
+ let updates = [(0, (IDSubjectIntroduced, MRIntroduced)), (1, (IDReferencedIntroduced, MRSubjectConnected))]
+ let vec = setNewRelations updates B.empty
+ getRelation 0 vec `shouldBe` MRIntroduced
+ getRelation 1 vec `shouldBe` MRSubjectConnected
+ B.unpack vec `shouldBe` [0x01, 0x0A] -- [dir=0,status=001], [dir=1,status=010]
describe "edge cases and invariants" $ do
it "round-trip: set then get returns same value" $ do
- let vec1 = setRelation 42 MRConnected B.empty
- getRelation 42 vec1 `shouldBe` MRConnected
+ let vec1 = setRelation 42 MRSubjectConnected B.empty
+ getRelation 42 vec1 `shouldBe` MRSubjectConnected
it "multiple round-trips preserve values" $ do
let vec1 = setRelation 0 MRIntroduced B.empty
- let vec2 = setRelation 1 MRConnected vec1
- let vec3 = setRelation 2 MRIntroduced vec2
- getRelation 0 vec3 `shouldBe` MRIntroduced
- getRelation 1 vec3 `shouldBe` MRConnected
- getRelation 2 vec3 `shouldBe` MRIntroduced
+ let vec2 = setRelation 1 MRSubjectConnected vec1
+ let vec3 = setRelation 2 MRReferencedConnected vec2
+ let vec4 = setRelation 3 MRConnected vec3
+ getRelation 0 vec4 `shouldBe` MRIntroduced
+ getRelation 1 vec4 `shouldBe` MRSubjectConnected
+ getRelation 2 vec4 `shouldBe` MRReferencedConnected
+ getRelation 3 vec4 `shouldBe` MRConnected
it "setRelations equivalent to multiple setRelation calls" $ do
- let updates = [(0, MRIntroduced), (5, MRConnected), (10, MRIntroduced)]
+ let updates = [(0, MRIntroduced), (5, MRSubjectConnected), (10, MRConnected)]
let vecBatch = setRelations updates B.empty
- let vecSeq = setRelation 10 MRIntroduced $ setRelation 5 MRConnected $ setRelation 0 MRIntroduced B.empty
+ let vecSeq = setRelation 10 MRConnected $ setRelation 5 MRSubjectConnected $ setRelation 0 MRIntroduced B.empty
vecBatch `shouldBe` vecSeq
getRelation 0 vecBatch `shouldBe` getRelation 0 vecSeq
getRelation 5 vecBatch `shouldBe` getRelation 5 vecSeq
getRelation 10 vecBatch `shouldBe` getRelation 10 vecSeq
it "handles large group size (10000 members)" $ do
- let updates = [(0, MRIntroduced), (5000, MRConnected), (9999, MRIntroduced)]
+ let updates = [(0, MRIntroduced), (5000, MRSubjectConnected), (9999, MRIntroduced)]
let vec = setRelations updates B.empty
B.length vec `shouldBe` 10000
getRelation 0 vec `shouldBe` MRIntroduced
- getRelation 5000 vec `shouldBe` MRConnected
+ getRelation 5000 vec `shouldBe` MRSubjectConnected
getRelation 9999 vec `shouldBe` MRIntroduced
it "all status values can be stored and retrieved" $ do
let vec1 = setRelation 0 MRNew B.empty
let vec2 = setRelation 1 MRIntroduced vec1
- let vec3 = setRelation 2 MRConnected vec2
- getRelation 0 vec3 `shouldBe` MRNew
- getRelation 1 vec3 `shouldBe` MRIntroduced
- getRelation 2 vec3 `shouldBe` MRConnected
+ let vec3 = setRelation 2 MRSubjectConnected vec2
+ let vec4 = setRelation 3 MRReferencedConnected vec3
+ let vec5 = setRelation 4 MRConnected vec4
+ getRelation 0 vec5 `shouldBe` MRNew
+ getRelation 1 vec5 `shouldBe` MRIntroduced
+ getRelation 2 vec5 `shouldBe` MRSubjectConnected
+ getRelation 3 vec5 `shouldBe` MRReferencedConnected
+ getRelation 4 vec5 `shouldBe` MRConnected
it "vector length is minimal (lazy expansion)" $ do
- let vec = setRelation 3 MRConnected B.empty
+ let vec = setRelation 3 MRSubjectConnected B.empty
B.length vec `shouldBe` 4
+
+ it "setRelation preserves existing direction" $ do
+ let vec1 = setNewRelation 0 IDReferencedIntroduced MRIntroduced B.empty
+ let vec2 = setRelation 0 MRConnected vec1
+ getRelation 0 vec2 `shouldBe` MRConnected
+ B.unpack vec2 `shouldBe` [0x0C] -- direction=1 preserved, status=100
+
+ describe "setRelationConnected" $ do
+ it "MRSubjectConnected on MRIntroduced -> MRSubjectConnected" $ do
+ let vec1 = setRelation 0 MRIntroduced B.empty
+ let vec2 = setRelationConnected 0 MRSubjectConnected vec1
+ getRelation 0 vec2 `shouldBe` MRSubjectConnected
+
+ it "MRReferencedConnected on MRIntroduced -> MRReferencedConnected" $ do
+ let vec1 = setRelation 0 MRIntroduced B.empty
+ let vec2 = setRelationConnected 0 MRReferencedConnected vec1
+ getRelation 0 vec2 `shouldBe` MRReferencedConnected
+
+ it "MRSubjectConnected on MRReferencedConnected -> MRConnected (complementary)" $ do
+ let vec1 = setRelation 0 MRReferencedConnected B.empty
+ let vec2 = setRelationConnected 0 MRSubjectConnected vec1
+ getRelation 0 vec2 `shouldBe` MRConnected
+
+ it "MRReferencedConnected on MRSubjectConnected -> MRConnected (complementary)" $ do
+ let vec1 = setRelation 0 MRSubjectConnected B.empty
+ let vec2 = setRelationConnected 0 MRReferencedConnected vec1
+ getRelation 0 vec2 `shouldBe` MRConnected
+
+ it "MRSubjectConnected on MRSubjectConnected -> no change" $ do
+ let vec1 = setRelation 0 MRSubjectConnected B.empty
+ let vec2 = setRelationConnected 0 MRSubjectConnected vec1
+ vec2 `shouldBe` vec1
+
+ it "MRReferencedConnected on MRReferencedConnected -> no change" $ do
+ let vec1 = setRelation 0 MRReferencedConnected B.empty
+ let vec2 = setRelationConnected 0 MRReferencedConnected vec1
+ vec2 `shouldBe` vec1
+
+ it "MRSubjectConnected on MRConnected -> no change" $ do
+ let vec1 = setRelation 0 MRConnected B.empty
+ let vec2 = setRelationConnected 0 MRSubjectConnected vec1
+ vec2 `shouldBe` vec1
+
+ it "MRReferencedConnected on MRConnected -> no change" $ do
+ let vec1 = setRelation 0 MRConnected B.empty
+ let vec2 = setRelationConnected 0 MRReferencedConnected vec1
+ vec2 `shouldBe` vec1
+
+ it "invalid status (MRConnected) -> no change" $ do
+ let vec1 = setRelation 0 MRIntroduced B.empty
+ let vec2 = setRelationConnected 0 MRConnected vec1
+ vec2 `shouldBe` vec1
+
+ it "invalid status (MRNew) -> no change" $ do
+ let vec1 = setRelation 0 MRIntroduced B.empty
+ let vec2 = setRelationConnected 0 MRNew vec1
+ vec2 `shouldBe` vec1
+
+ it "setRelationConnected preserves direction when updating" $ do
+ let vec1 = setNewRelation 0 IDReferencedIntroduced MRIntroduced B.empty
+ let vec2 = setRelationConnected 0 MRSubjectConnected vec1
+ getRelation' 0 vec2 `shouldBe` (IDReferencedIntroduced, MRSubjectConnected)
diff --git a/tests/SchemaDump.hs b/tests/SchemaDump.hs
index b1b7dbc264..8a716ddf11 100644
--- a/tests/SchemaDump.hs
+++ b/tests/SchemaDump.hs
@@ -18,6 +18,7 @@ import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Database.SQLite.Simple (Query (..))
+import Simplex.Chat.Options.SQLite (chatDBFunctions)
import Simplex.Chat.Store (createChatStore)
import qualified Simplex.Chat.Store as Store
import Simplex.Messaging.Agent.Env.SQLite (createAgentStore)
@@ -63,7 +64,7 @@ testVerifySchemaDump :: IO ()
testVerifySchemaDump = withTmpFiles $ do
savedSchema <- ifM (doesFileExist appSchema) (readFile appSchema) (pure "")
savedSchema `deepseq` pure ()
- void $ createChatStore (DBOpts testDB "" False True TQOff) (MigrationConfig MCError Nothing)
+ void $ createChatStore (DBOpts testDB chatDBFunctions "" False True TQOff) (MigrationConfig MCError Nothing)
getSchema testDB appSchema `shouldReturn` savedSchema
removeFile testDB
@@ -71,14 +72,14 @@ testVerifyLintFKeyIndexes :: IO ()
testVerifyLintFKeyIndexes = withTmpFiles $ do
savedLint <- ifM (doesFileExist appLint) (readFile appLint) (pure "")
savedLint `deepseq` pure ()
- void $ createChatStore (DBOpts testDB "" False True TQOff) (MigrationConfig MCError Nothing)
+ void $ createChatStore (DBOpts testDB chatDBFunctions "" False True TQOff) (MigrationConfig MCError Nothing)
getLintFKeyIndexes testDB "tests/tmp/chat_lint.sql" `shouldReturn` savedLint
removeFile testDB
testSchemaMigrations :: IO ()
testSchemaMigrations = withTmpFiles $ do
let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) Store.migrations
- Right st <- createDBStore (DBOpts testDB "" False True TQOff) noDownMigrations (MigrationConfig MCError Nothing)
+ Right st <- createDBStore (DBOpts testDB chatDBFunctions "" False True TQOff) noDownMigrations (MigrationConfig MCError Nothing)
mapM_ (testDownMigration st) $ drop (length noDownMigrations) Store.migrations
closeDBStore st
removeFile testDB
@@ -152,7 +153,7 @@ saveQueryPlans = it "verify and overwrite query plans" $ \TestParams {chatQueryS
updatePlans
appChatQueryPlans
chatQueryStats
- (createChatStore (DBOpts testDB "" False True TQOff) (MigrationConfig MCError Nothing))
+ (createChatStore (DBOpts testDB chatDBFunctions "" False True TQOff) (MigrationConfig MCError Nothing))
(\db -> do
DB.execute_ db "CREATE TABLE IF NOT EXISTS temp_conn_ids (conn_id BLOB)"
DB.execute_ db "CREATE TABLE IF NOT EXISTS temp_delete_members (contact_profile_id INTEGER, member_profile_id INTEGER, local_display_name TEXT)"
@@ -161,7 +162,7 @@ saveQueryPlans = it "verify and overwrite query plans" $ \TestParams {chatQueryS
updatePlans
appAgentQueryPlans
agentQueryStats
- (createAgentStore (DBOpts testAgentDB "" False True TQOff) (MigrationConfig MCError Nothing))
+ (createAgentStore (DBOpts testAgentDB [] "" False True TQOff) (MigrationConfig MCError Nothing))
(const $ pure ())
chatSavedPlans' == chatSavedPlans `shouldBe` True
agentSavedPlans' == agentSavedPlans `shouldBe` True