diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index a8ff929a98..9876ac2452 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -1905,6 +1905,8 @@ processChatCommand vr nm = \case void $ createChatItem user (CDGroupSnd gInfo Nothing) False CIChatBanner Nothing (Just epochStart) -- TODO [relays] member: TBC save items as message from channel -- TODO - hostMember to later be associated with owner profile when relays send it + -- TODO - pick any owner at random from initial introductions, find unknown member in group? + -- TODO - alternatively support not having a member in CDGroupRcv direction? let cd = CDGroupRcv gInfo Nothing hostMember cInfo = GroupChat gInfo Nothing void $ createGroupFeatureItems_ user cd True CIRcvGroupFeature gInfo diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index cd961f9c00..697de2cbc2 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -1082,16 +1082,11 @@ introduceMember vr user gInfo@GroupInfo {groupId} m@GroupMember {activeConn = Ju shuffledIntros <- liftIO $ shuffleIntros intros if m `supportsVersion` batchSendVersion then do - let events = map (memberIntro . reMember) shuffledIntros + let events = map (memberIntroEvt gInfo . reMember) shuffledIntros forM_ (L.nonEmpty events) $ \events' -> sendGroupMemberMessages user conn events' groupId else forM_ shuffledIntros $ \intro -> processIntro intro `catchAllErrors` eToView - 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 @@ -1102,9 +1097,29 @@ introduceMember vr user gInfo@GroupInfo {groupId} m@GroupMember {activeConn = Ju 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 + void $ sendDirectMemberMessage conn (memberIntroEvt gInfo $ reMember intro) groupId withStore' $ \db -> updateIntroStatus db introId GMIntroSent +memberIntroEvt :: GroupInfo -> GroupMember -> ChatMsgEvent 'Json +memberIntroEvt gInfo reMember = + let mInfo = memberInfo gInfo reMember + mRestrictions = memberRestrictions reMember + in XGrpMemIntro mInfo mRestrictions + +-- Used in groups with relays to introduce moderators and above to a new member. +-- Member is not introduced to anybody: +-- - in channels member will be prohibited to send, so it doesn't matter; +-- - if member does send, recipients will create unknown member record; +-- - later - to do member profile request protocol. +-- This doesn't create introduction records in db, compared to above methods. +introduceModerators :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM () +introduceModerators _ _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active" +introduceModerators vr user gInfo@GroupInfo {groupId} GroupMember {activeConn = Just conn} = do + modMs <- withStore' $ \db -> getGroupModerators db vr user gInfo + let events = map (memberIntroEvt gInfo) modMs + forM_ (L.nonEmpty events) $ \events' -> + sendGroupMemberMessages user conn events' groupId + userProfileInGroup :: User -> GroupInfo -> Maybe Profile -> Profile userProfileInGroup user = userProfileInGroup' user . groupFeatureUserAllowed SGFSimplexLinks {-# INLINE userProfileInGroup #-} diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 8fd875ba17..1f6be2d2c9 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -847,16 +847,20 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = let Connection {viaUserContactLink} = conn when (isJust viaUserContactLink && isNothing (memberContactId m')) $ sendXGrpLinkMem gInfo'' when (connChatVersion < batchSend2Version) $ getAutoReplyMsg >>= mapM_ (\mc -> sendGroupAutoReply mc Nothing) - unless (useRelays' gInfo'') $ - case mStatus of - GSMemPendingApproval -> pure () - GSMemPendingReview -> introduceToModerators vr user gInfo'' m' - _ -> do - introduceToAll vr user gInfo'' m' - let memberIsCustomer = case businessChat gInfo'' of - Just BusinessChatInfo {chatType = BCCustomer, customerId} -> memberId' m' == customerId - _ -> False - when (groupFeatureAllowed SGFHistory gInfo'' && not memberIsCustomer) $ sendHistory user gInfo'' m' + if useRelays' gInfo'' + then do + introduceModerators vr user gInfo'' m' + when (groupFeatureAllowed SGFHistory gInfo'') $ sendHistory user gInfo'' m' + else + case mStatus of + GSMemPendingApproval -> pure () + GSMemPendingReview -> introduceToModerators vr user gInfo'' m' + _ -> do + introduceToAll vr user gInfo'' m' + let memberIsCustomer = case businessChat gInfo'' of + Just BusinessChatInfo {chatType = BCCustomer, customerId} -> memberId' m' == customerId + _ -> False + when (groupFeatureAllowed SGFHistory gInfo'' && not memberIsCustomer) $ sendHistory user gInfo'' m' where sendXGrpLinkMem gInfo'' = do let incognitoProfile = ExistingIncognito <$> incognitoMembershipProfile gInfo'' @@ -2653,19 +2657,26 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = case memberCategory m of GCHostMember -> withStore' (\db -> runExceptT $ getGroupMemberByMemberId db vr user gInfo memId) >>= \case - Right _ -> messageError "x.grp.mem.intro ignored: member already exists" - Left _ -> do - when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole c) - case memChatVRange of - Nothing -> messageError "x.grp.mem.intro: member chat version range incompatible" - Just (ChatVersionRange mcvr) - | maxVersion mcvr >= groupDirectInvVersion -> do - subMode <- chatReadVar subscriptionMode - -- [async agent commands] commands should be asynchronous, continuation is to send XGrpMemInv - have to remember one has completed and process on second - groupConnIds <- createConn subMode - let chatV = maybe (minVersion vr) (\peerVR -> vr `peerConnChatVersion` fromChatVRange peerVR) memChatVRange - void $ withStore $ \db -> createIntroReMember db user gInfo m chatV memInfo memRestrictions groupConnIds subMode - | otherwise -> messageError "x.grp.mem.intro: member chat version range incompatible" + Right _ -> + unless (useRelays' gInfo) $ + messageError "x.grp.mem.intro ignored: member already exists" + Left _ + | useRelays' gInfo -> + void $ withStore $ \db -> createIntroReMember db user gInfo memInfo memRestrictions + | otherwise -> do + when (memberRole < GRAdmin) $ throwChatError (CEGroupContactRole c) + case memChatVRange of + Nothing -> messageError "x.grp.mem.intro: member chat version range incompatible" + Just (ChatVersionRange mcvr) + | maxVersion mcvr >= groupDirectInvVersion -> do + subMode <- chatReadVar subscriptionMode + -- [async agent commands] commands should be asynchronous, continuation is to send XGrpMemInv - have to remember one has completed and process on second + groupConnIds <- createConn subMode + let chatV = maybe (minVersion vr) (\peerVR -> vr `peerConnChatVersion` fromChatVRange peerVR) memChatVRange + void $ withStore $ \db -> do + reMember <- createIntroReMember db user gInfo memInfo memRestrictions + createIntroReMemberConn db user m reMember chatV memInfo groupConnIds subMode + | otherwise -> messageError "x.grp.mem.intro: member chat version range incompatible" _ -> messageError "x.grp.mem.intro can be only sent by host member" where createConn subMode = createAgentConnectionAsync user CFCreateConnGrpMemInv (chatHasNtfs chatSettings) SCMInvitation subMode diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index 82a30c5d47..f22e9e5a41 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -117,6 +117,7 @@ module Simplex.Chat.Store.Groups getForwardInvitedModerators, getForwardScopeMember, createIntroReMember, + createIntroReMemberConn, createIntroToMemberContact, getMatchingContacts, getMatchingMembers, @@ -1893,28 +1894,35 @@ getForwardScopeMember db vr user GroupMember {groupMemberId = sendingGMId} scope (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.Connection -> User -> GroupInfo -> MemberInfo -> Maybe MemberRestrictions -> ExceptT StoreError IO GroupMember createIntroReMember db - user@User {userId} + user gInfo + memInfo@(MemberInfo _ _ _ memberProfile) + memRestrictions_ = do + currentTs <- liftIO getCurrentTime + (localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs + let memRestriction = restriction <$> memRestrictions_ + newMember = NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId, isRelay = False} + liftIO $ createNewMember_ db user gInfo newMember currentTs + +createIntroReMemberConn :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionChat -> MemberInfo -> (CommandId, ConnId) -> SubscriptionMode -> ExceptT StoreError IO GroupMember +createIntroReMemberConn + db + user@User {userId} _host@GroupMember {memberContactId, activeConn} + reMember@GroupMember {groupMemberId} chatV - memInfo@(MemberInfo _ _ memChatVRange memberProfile) - memRestrictions_ + (MemberInfo _ _ memChatVRange _) (groupCmdId, groupAgentConnId) subMode = do let mcvr = maybe chatInitialVRange fromChatVRange memChatVRange cLevel = 1 + maybe 0 (\Connection {connLevel} -> connLevel) activeConn - memRestriction = restriction <$> memRestrictions_ currentTs <- liftIO getCurrentTime - (localDisplayName, memProfileId) <- createNewMemberProfile_ db user memberProfile currentTs - let newMember = NewGroupMember {memInfo, memCategory = GCPreMember, memStatus = GSMemIntroduced, memRestriction, memInvitedBy = IBUnknown, memInvitedByGroupMemberId = Nothing, localDisplayName, memContactId = Nothing, memProfileId, isRelay = False} - liftIO $ do - member <- createNewMember_ db user gInfo newMember currentTs - conn@Connection {connId = groupConnId} <- createMemberConnection_ db userId (groupMemberId' member) groupAgentConnId chatV mcvr memberContactId cLevel currentTs subMode - liftIO $ setCommandConnId db user groupCmdId groupConnId - pure (member :: GroupMember) {activeConn = Just conn} + conn@Connection {connId = groupConnId} <- liftIO $ createMemberConnection_ db userId groupMemberId groupAgentConnId chatV mcvr memberContactId cLevel currentTs subMode + liftIO $ setCommandConnId db user groupCmdId groupConnId + pure (reMember :: GroupMember) {activeConn = Just conn} createIntroToMemberContact :: DB.Connection -> User -> GroupMember -> GroupMember -> VersionChat -> VersionRangeChat -> (CommandId, ConnId) -> Maybe (CommandId, ConnId) -> Maybe ProfileId -> SubscriptionMode -> IO () createIntroToMemberContact db user@User {userId} GroupMember {memberContactId = viaContactId, activeConn} _to@GroupMember {groupMemberId, localDisplayName} chatV mcvr (groupCmdId, groupAgentConnId) directConnIds customUserProfileId subMode = do