wip

src/Simplex/Chat/Library/Commands.hs

@@ -2024,11 +2024,18 @@ processChatCommand' vr = \case
           updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` (toView . CRChatError (Just user))
           pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing
         Nothing -> throwChatError $ CEContactNotActive ct
-  -- TODO [knocking] APIAcceptMember
-  APIAcceptMember groupId gmId memRole -> withUser $ \user -> do
-    -- Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId
-    -- pure $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected} -- GSMemApproved?
-    ok user
+  APIAcceptMember groupId gmId role -> withUser $ \user -> do
+    (gInfo, m) <- withFastStore $ \db -> (,) <$> getGroupInfo db vr user groupId <*> getGroupMemberById db vr user gmId
+    assertUserGroupRole gInfo GRAdmin
+    when (memberStatus m /= GSMemPendingApproval) $ throwChatError $ CECommandError "member is not pending approval"
+    case memberConn m of
+      Just mConn -> do
+        let msg = XGrpLinkAcpt role
+        void $ sendDirectMemberMessage mConn msg groupId
+        m' <- withFastStore' $ \db -> updateGroupMemberAccepted db user m role
+        introduceToGroup vr user gInfo m
+        pure $ CRJoinedGroupMember user gInfo m'
+      _ -> throwChatError CEGroupMemberNotActive
   APIMemberRole groupId memberId memRole -> withUser $ \user -> do
     Group gInfo@GroupInfo {membership} members <- withFastStore $ \db -> getGroup db vr user groupId
     if memberId == groupMemberId' membership

src/Simplex/Chat/Library/Internal.hs

@@ -38,7 +38,7 @@ import Data.Functor (($>))
 import Data.Functor.Identity
 import Data.Int (Int64)
 import Data.List (find, mapAccumL, partition)
-import Data.List.NonEmpty (NonEmpty (..))
+import Data.List.NonEmpty (NonEmpty (..), (<|))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
@@ -78,7 +78,7 @@ import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI)
 import Simplex.FileTransfer.Types (RcvFileId, SndFileId)
 import Simplex.Messaging.Agent as Agent
 import Simplex.Messaging.Agent.Client (getFastNetworkConfig, ipAddressProtected, withLockMap)
-import Simplex.Messaging.Agent.Env.SQLite (ServerCfg (..))
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), ServerCfg (..))
 import Simplex.Messaging.Agent.Lock (withLock)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..))
@@ -930,6 +930,132 @@ profileToSendOnAccept user ip = userProfileToSend user (getIncognitoProfile <$>
       NewIncognito p -> p
       ExistingIncognito lp -> fromLocalProfile lp
 
+introduceToGroup :: VersionRangeChat -> User -> GroupInfo -> GroupMember -> CM ()
+introduceToGroup _ _ _ GroupMember {activeConn = Nothing} = throwChatError $ CEInternalError "member connection not active"
+introduceToGroup vr user gInfo@GroupInfo {groupId, membership} m@GroupMember {activeConn = Just conn} = do
+  members <- withStore' $ \db -> getGroupMembers db vr user gInfo
+  void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m
+  sendIntroductions members
+  when (groupFeatureAllowed SGFHistory gInfo) sendHistory
+  where
+    sendIntroductions members = do
+      intros <- withStore' $ \db -> createIntroductions db (maxVersion vr) members m
+      shuffledIntros <- liftIO $ shuffleIntros intros
+      if m `supportsVersion` batchSendVersion
+        then do
+          let events = map (memberIntro . reMember) shuffledIntros
+          forM_ (L.nonEmpty events) $ \events' ->
+            sendGroupMemberMessages user conn events' groupId
+        else forM_ shuffledIntros $ \intro ->
+          processIntro intro `catchChatError` (toView . CRChatError (Just user))
+    memberIntro :: GroupMember -> ChatMsgEvent 'Json
+    memberIntro reMember =
+      let mInfo = memberInfo reMember
+          mRestrictions = memberRestrictions reMember
+      in XGrpMemIntro mInfo mRestrictions
+    shuffleIntros :: [GroupMemberIntro] -> IO [GroupMemberIntro]
+    shuffleIntros intros = do
+      let (admins, others) = partition isAdmin intros
+          (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
+    sendHistory =
+      when (m `supportsVersion` batchSendVersion) $ do
+        (errs, items) <- partitionEithers <$> withStore' (\db -> getGroupHistoryItems db user gInfo m 100)
+        (errs', events) <- partitionEithers <$> mapM (tryChatError . itemForwardEvents) items
+        let errors = map ChatErrorStore errs <> errs'
+        unless (null errors) $ toView $ CRChatErrors (Just user) errors
+        let events' = maybe (concat events) (\x -> concat events <> [x]) descrEvent_
+        forM_ (L.nonEmpty events') $ \events'' ->
+          sendGroupMemberMessages user conn events'' groupId
+    descrEvent_ :: Maybe (ChatMsgEvent 'Json)
+    descrEvent_
+      | m `supportsVersion` groupHistoryIncludeWelcomeVersion = do
+          let GroupInfo {groupProfile = GroupProfile {description}} = gInfo
+          fmap (\descr -> XMsgNew $ MCSimple $ extMsgContent (MCText descr) Nothing) description
+      | otherwise = Nothing
+    itemForwardEvents :: CChatItem 'CTGroup -> CM [ChatMsgEvent 'Json]
+    itemForwardEvents cci = case cci of
+      (CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv sender, content = CIRcvMsgContent mc, file})
+        | not (blockedByAdmin sender) -> do
+            fInvDescr_ <- join <$> forM file getRcvFileInvDescr
+            processContentItem sender ci mc fInvDescr_
+      (CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent mc, file}) -> do
+        fInvDescr_ <- join <$> forM file getSndFileInvDescr
+        processContentItem membership ci mc fInvDescr_
+      _ -> pure []
+      where
+        getRcvFileInvDescr :: CIFile 'MDRcv -> CM (Maybe (FileInvitation, RcvFileDescrText))
+        getRcvFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do
+          expired <- fileExpired
+          if fileProtocol /= FPXFTP || fileStatus == CIFSRcvCancelled || expired
+            then pure Nothing
+            else do
+              rfd <- withStore $ \db -> getRcvFileDescrByRcvFileId db fileId
+              pure $ invCompleteDescr ciFile rfd
+        getSndFileInvDescr :: CIFile 'MDSnd -> CM (Maybe (FileInvitation, RcvFileDescrText))
+        getSndFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do
+          expired <- fileExpired
+          if fileProtocol /= FPXFTP || fileStatus == CIFSSndCancelled || expired
+            then pure Nothing
+            else do
+              -- can also lookup in extra_xftp_file_descriptions, though it can be empty;
+              -- would be best if snd file had a single rcv description for all members saved in files table
+              rfd <- withStore $ \db -> getRcvFileDescrBySndFileId db fileId
+              pure $ invCompleteDescr ciFile rfd
+        fileExpired :: CM Bool
+        fileExpired = do
+          ttl <- asks $ rcvFilesTTL . agentConfig . config
+          cutoffTs <- addUTCTime (-ttl) <$> liftIO getCurrentTime
+          pure $ chatItemTs cci < cutoffTs
+        invCompleteDescr :: CIFile d -> RcvFileDescr -> Maybe (FileInvitation, RcvFileDescrText)
+        invCompleteDescr CIFile {fileName, fileSize} RcvFileDescr {fileDescrText, fileDescrComplete}
+          | fileDescrComplete =
+              let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
+                  fInv = xftpFileInvitation fileName fileSize fInvDescr
+              in Just (fInv, fileDescrText)
+          | otherwise = Nothing
+        processContentItem :: GroupMember -> ChatItem 'CTGroup d -> MsgContent -> Maybe (FileInvitation, RcvFileDescrText) -> CM [ChatMsgEvent 'Json]
+        processContentItem sender ChatItem {formattedText, meta, quotedItem, mentions} mc fInvDescr_ =
+          if isNothing fInvDescr_ && not (msgContentHasText mc)
+            then pure []
+            else do
+              let CIMeta {itemTs, itemSharedMsgId, itemTimed} = meta
+                  quotedItemId_ = quoteItemId =<< quotedItem
+                  fInv_ = fst <$> fInvDescr_
+                  (mc', _, mentions') = updatedMentionNames mc formattedText mentions
+                  mentions'' = M.map (\CIMention {memberId} -> MsgMention {memberId}) mentions'
+              (chatMsgEvent, _) <- withStore $ \db -> prepareGroupMsg db user gInfo mc' mentions'' quotedItemId_ Nothing fInv_ itemTimed False
+              let senderVRange = memberChatVRange' sender
+                  xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent}
+              fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of
+                (Just fileDescrText, Just msgId) -> do
+                  partSize <- asks $ xftpDescrPartSize . config
+                  let parts = splitFileDescr partSize fileDescrText
+                  pure . L.toList $ L.map (XMsgFileDescr msgId) parts
+                _ -> pure []
+              let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents
+                  GroupMember {memberId} = sender
+                  msgForwardEvents = map (\cm -> XGrpMsgForward memberId cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs)
+              pure msgForwardEvents
+
+splitFileDescr :: Int -> RcvFileDescrText -> NonEmpty FileDescr
+splitFileDescr partSize rfdText = splitParts 1 rfdText
+  where
+    splitParts partNo remText =
+      let (part, rest) = T.splitAt partSize remText
+          complete = T.null rest
+          fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete}
+       in if complete
+            then fileDescr :| []
+            else fileDescr <| splitParts (partNo + 1) rest
+
 deleteGroupLink' :: User -> GroupInfo -> CM ()
 deleteGroupLink' user gInfo = do
   vr <- chatVersionRange

src/Simplex/Chat/Library/Subscriber.hs

@@ -27,8 +27,8 @@ import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Either (lefts, partitionEithers, rights)
 import Data.Functor (($>))
 import Data.Int (Int64)
-import Data.List (foldl', partition)
-import Data.List.NonEmpty (NonEmpty (..), (<|))
+import Data.List (foldl')
+import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
@@ -36,8 +36,7 @@ import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, mapMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (decodeLatin1)
-import Data.Time (addUTCTime)
-import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)
+import Data.Time.Clock (UTCTime, diffUTCTime)
 import qualified Data.UUID as UUID
 import qualified Data.UUID.V4 as V4
 import Data.Word (Word32)
@@ -60,14 +59,12 @@ import Simplex.Chat.Store.Shared
 import Simplex.Chat.Types
 import Simplex.Chat.Types.Preferences
 import Simplex.Chat.Types.Shared
-import Simplex.Chat.Util (shuffle)
 import Simplex.FileTransfer.Description (ValidFileDescription)
 import qualified Simplex.FileTransfer.Description as FD
 import Simplex.FileTransfer.Protocol (FilePartyI)
 import qualified Simplex.FileTransfer.Transport as XFTP
 import Simplex.FileTransfer.Types (FileErrorType (..), RcvFileId, SndFileId)
 import Simplex.Messaging.Agent as Agent
-import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..))
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Agent.Protocol as AP (AgentErrorType (..))
 import qualified Simplex.Messaging.Agent.Store.DB as DB
@@ -296,17 +293,6 @@ agentFileError = \case
       SMP.TRANSPORT TEVersion -> srvErr SrvErrVersion
       e -> srvErr . SrvErrOther $ tshow e
 
-splitFileDescr :: Int -> RcvFileDescrText -> NonEmpty FileDescr
-splitFileDescr partSize rfdText = splitParts 1 rfdText
-  where
-    splitParts partNo remText =
-      let (part, rest) = T.splitAt partSize remText
-          complete = T.null rest
-          fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete}
-       in if complete
-            then fileDescr :| []
-            else fileDescr <| splitParts (partNo + 1) rest
-
 processAgentMsgRcvFile :: ACorrId -> RcvFileId -> AEvent 'AERcvFile -> CM ()
 processAgentMsgRcvFile _corrId aFileId msg = do
   (cRef_, fileId) <- withStore (`getXFTPRcvFileDBIds` AgentRcvFileId aFileId)
@@ -805,123 +791,12 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
             let Connection {viaUserContactLink} = conn
             when (isJust viaUserContactLink && isNothing (memberContactId m)) sendXGrpLinkMem
             when (connChatVersion < batchSend2Version) sendGroupAutoReply
-            unless (status' == GSMemPendingApproval) introduceToGroup
+            unless (status' == GSMemPendingApproval) $ introduceToGroup vr user gInfo m
             where
-              introduceToGroup = do
-                members <- withStore' $ \db -> getGroupMembers db vr user gInfo
-                void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m
-                sendIntroductions members
-                when (groupFeatureAllowed SGFHistory gInfo) sendHistory
               sendXGrpLinkMem = do
                 let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
                     profileToSend = profileToSendOnAccept user profileMode True
                 void $ sendDirectMemberMessage conn (XGrpLinkMem profileToSend) groupId
-              sendIntroductions members = do
-                intros <- withStore' $ \db -> createIntroductions db (maxVersion vr) members m
-                shuffledIntros <- liftIO $ shuffleIntros intros
-                if m `supportsVersion` batchSendVersion
-                  then do
-                    let events = map (memberIntro . reMember) shuffledIntros
-                    forM_ (L.nonEmpty events) $ \events' ->
-                      sendGroupMemberMessages user conn events' groupId
-                  else forM_ shuffledIntros $ \intro ->
-                    processIntro intro `catchChatError` (toView . CRChatError (Just user))
-              memberIntro :: GroupMember -> ChatMsgEvent 'Json
-              memberIntro reMember =
-                let mInfo = memberInfo reMember
-                    mRestrictions = memberRestrictions reMember
-                 in XGrpMemIntro mInfo mRestrictions
-              shuffleIntros :: [GroupMemberIntro] -> IO [GroupMemberIntro]
-              shuffleIntros intros = do
-                let (admins, others) = partition isAdmin intros
-                    (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
-              sendHistory =
-                when (m `supportsVersion` batchSendVersion) $ do
-                  (errs, items) <- partitionEithers <$> withStore' (\db -> getGroupHistoryItems db user gInfo m 100)
-                  (errs', events) <- partitionEithers <$> mapM (tryChatError . itemForwardEvents) items
-                  let errors = map ChatErrorStore errs <> errs'
-                  unless (null errors) $ toView $ CRChatErrors (Just user) errors
-                  let events' = maybe (concat events) (\x -> concat events <> [x]) descrEvent_
-                  forM_ (L.nonEmpty events') $ \events'' ->
-                    sendGroupMemberMessages user conn events'' groupId
-              descrEvent_ :: Maybe (ChatMsgEvent 'Json)
-              descrEvent_
-                | m `supportsVersion` groupHistoryIncludeWelcomeVersion = do
-                    let GroupInfo {groupProfile = GroupProfile {description}} = gInfo
-                    fmap (\descr -> XMsgNew $ MCSimple $ extMsgContent (MCText descr) Nothing) description
-                | otherwise = Nothing
-              itemForwardEvents :: CChatItem 'CTGroup -> CM [ChatMsgEvent 'Json]
-              itemForwardEvents cci = case cci of
-                (CChatItem SMDRcv ci@ChatItem {chatDir = CIGroupRcv sender, content = CIRcvMsgContent mc, file})
-                  | not (blockedByAdmin sender) -> do
-                      fInvDescr_ <- join <$> forM file getRcvFileInvDescr
-                      processContentItem sender ci mc fInvDescr_
-                (CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent mc, file}) -> do
-                  fInvDescr_ <- join <$> forM file getSndFileInvDescr
-                  processContentItem membership ci mc fInvDescr_
-                _ -> pure []
-                where
-                  getRcvFileInvDescr :: CIFile 'MDRcv -> CM (Maybe (FileInvitation, RcvFileDescrText))
-                  getRcvFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do
-                    expired <- fileExpired
-                    if fileProtocol /= FPXFTP || fileStatus == CIFSRcvCancelled || expired
-                      then pure Nothing
-                      else do
-                        rfd <- withStore $ \db -> getRcvFileDescrByRcvFileId db fileId
-                        pure $ invCompleteDescr ciFile rfd
-                  getSndFileInvDescr :: CIFile 'MDSnd -> CM (Maybe (FileInvitation, RcvFileDescrText))
-                  getSndFileInvDescr ciFile@CIFile {fileId, fileProtocol, fileStatus} = do
-                    expired <- fileExpired
-                    if fileProtocol /= FPXFTP || fileStatus == CIFSSndCancelled || expired
-                      then pure Nothing
-                      else do
-                        -- can also lookup in extra_xftp_file_descriptions, though it can be empty;
-                        -- would be best if snd file had a single rcv description for all members saved in files table
-                        rfd <- withStore $ \db -> getRcvFileDescrBySndFileId db fileId
-                        pure $ invCompleteDescr ciFile rfd
-                  fileExpired :: CM Bool
-                  fileExpired = do
-                    ttl <- asks $ rcvFilesTTL . agentConfig . config
-                    cutoffTs <- addUTCTime (-ttl) <$> liftIO getCurrentTime
-                    pure $ chatItemTs cci < cutoffTs
-                  invCompleteDescr :: CIFile d -> RcvFileDescr -> Maybe (FileInvitation, RcvFileDescrText)
-                  invCompleteDescr CIFile {fileName, fileSize} RcvFileDescr {fileDescrText, fileDescrComplete}
-                    | fileDescrComplete =
-                        let fInvDescr = FileDescr {fileDescrText = "", fileDescrPartNo = 0, fileDescrComplete = False}
-                            fInv = xftpFileInvitation fileName fileSize fInvDescr
-                         in Just (fInv, fileDescrText)
-                    | otherwise = Nothing
-                  processContentItem :: GroupMember -> ChatItem 'CTGroup d -> MsgContent -> Maybe (FileInvitation, RcvFileDescrText) -> CM [ChatMsgEvent 'Json]
-                  processContentItem sender ChatItem {formattedText, meta, quotedItem, mentions} mc fInvDescr_ =
-                    if isNothing fInvDescr_ && not (msgContentHasText mc)
-                      then pure []
-                      else do
-                        let CIMeta {itemTs, itemSharedMsgId, itemTimed} = meta
-                            quotedItemId_ = quoteItemId =<< quotedItem
-                            fInv_ = fst <$> fInvDescr_
-                            (mc', _, mentions') = updatedMentionNames mc formattedText mentions
-                            mentions'' = M.map (\CIMention {memberId} -> MsgMention {memberId}) mentions'
-                        (chatMsgEvent, _) <- withStore $ \db -> prepareGroupMsg db user gInfo mc' mentions'' quotedItemId_ Nothing fInv_ itemTimed False
-                        let senderVRange = memberChatVRange' sender
-                            xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent}
-                        fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of
-                          (Just fileDescrText, Just msgId) -> do
-                            partSize <- asks $ xftpDescrPartSize . config
-                            let parts = splitFileDescr partSize fileDescrText
-                            pure . L.toList $ L.map (XMsgFileDescr msgId) parts
-                          _ -> pure []
-                        let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents
-                            GroupMember {memberId} = sender
-                            msgForwardEvents = map (\cm -> XGrpMsgForward memberId cm itemTs) (xMsgNewChatMsg : fileDescrChatMsgs)
-                        pure msgForwardEvents
           _ -> do
             let memCategory = memberCategory m
             withStore' (\db -> getViaGroupContact db vr user m) >>= \case
@@ -984,6 +859,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
               XFileAcptInv sharedMsgId fileConnReq_ fName -> xFileAcptInvGroup gInfo m' sharedMsgId fileConnReq_ fName
               XInfo p -> xInfoMember gInfo m' p brokerTs
               XGrpLinkMem p -> xGrpLinkMem gInfo m' conn' p
+              XGrpLinkAcpt role -> xGrpLinkAcpt gInfo m' role
               XGrpMemNew memInfo -> xGrpMemNew gInfo m' memInfo msg brokerTs
               XGrpMemIntro memInfo memRestrictions_ -> xGrpMemIntro gInfo m' memInfo memRestrictions_
               XGrpMemInv memId introInv -> xGrpMemInv gInfo m' memId introInv
@@ -2194,10 +2070,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
             probeMatchingMemberContact m' connectedIncognito
         else messageError "x.grp.link.mem error: invalid group link host profile update"
 
-    -- TODO [knocking]
-    -- xGrpLinkAcpt
-    -- set statuses to GSMemConnected
-    -- probeMatchingMemberContact
+    xGrpLinkAcpt :: GroupInfo -> GroupMember -> GroupMemberRole -> CM ()
+    xGrpLinkAcpt GroupInfo {membership} m role = do
+      withStore' $ \db -> do
+        void $ updateGroupMemberAccepted db user membership role
+        updateGroupMemberStatus db userId m GSMemConnected
+      let m' = m {memberStatus = GSMemConnected}
+          connectedIncognito = memberIncognito membership
+      probeMatchingMemberContact m' connectedIncognito
 
     processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Bool -> Maybe UTCTime -> CM GroupMember
     processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' createItems itemTs_

src/Simplex/Chat/Protocol.hs

@@ -331,9 +331,9 @@ data ChatMsgEvent (e :: MsgEncoding) where
   XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json
   XGrpAcpt :: MemberId -> ChatMsgEvent 'Json
   XGrpLinkInv :: GroupLinkInvitation -> ChatMsgEvent 'Json
-  XGrpLinkAcpt :: MemberId -> ChatMsgEvent 'Json
   XGrpLinkReject :: GroupLinkRejection -> ChatMsgEvent 'Json
   XGrpLinkMem :: Profile -> ChatMsgEvent 'Json
+  XGrpLinkAcpt :: GroupMemberRole -> ChatMsgEvent 'Json
   XGrpMemNew :: MemberInfo -> ChatMsgEvent 'Json
   XGrpMemIntro :: MemberInfo -> Maybe MemberRestrictions -> ChatMsgEvent 'Json
   XGrpMemInv :: MemberId -> IntroInvitation -> ChatMsgEvent 'Json
@@ -822,9 +822,9 @@ data CMEventTag (e :: MsgEncoding) where
   XGrpInv_ :: CMEventTag 'Json
   XGrpAcpt_ :: CMEventTag 'Json
   XGrpLinkInv_ :: CMEventTag 'Json
-  XGrpLinkAcpt_ :: CMEventTag 'Json
   XGrpLinkReject_ :: CMEventTag 'Json
   XGrpLinkMem_ :: CMEventTag 'Json
+  XGrpLinkAcpt_ :: CMEventTag 'Json
   XGrpMemNew_ :: CMEventTag 'Json
   XGrpMemIntro_ :: CMEventTag 'Json
   XGrpMemInv_ :: CMEventTag 'Json
@@ -875,9 +875,9 @@ instance MsgEncodingI e => StrEncoding (CMEventTag e) where
     XGrpInv_ -> "x.grp.inv"
     XGrpAcpt_ -> "x.grp.acpt"
     XGrpLinkInv_ -> "x.grp.link.inv"
-    XGrpLinkAcpt_ -> "x.grp.link.acpt"
     XGrpLinkReject_ -> "x.grp.link.reject"
     XGrpLinkMem_ -> "x.grp.link.mem"
+    XGrpLinkAcpt_ -> "x.grp.link.acpt"
     XGrpMemNew_ -> "x.grp.mem.new"
     XGrpMemIntro_ -> "x.grp.mem.intro"
     XGrpMemInv_ -> "x.grp.mem.inv"
@@ -929,9 +929,9 @@ instance StrEncoding ACMEventTag where
         "x.grp.inv" -> XGrpInv_
         "x.grp.acpt" -> XGrpAcpt_
         "x.grp.link.inv" -> XGrpLinkInv_
-        "x.grp.link.acpt" -> XGrpLinkAcpt_
         "x.grp.link.reject" -> XGrpLinkReject_
         "x.grp.link.mem" -> XGrpLinkMem_
+        "x.grp.link.acpt" -> XGrpLinkAcpt_
         "x.grp.mem.new" -> XGrpMemNew_
         "x.grp.mem.intro" -> XGrpMemIntro_
         "x.grp.mem.inv" -> XGrpMemInv_
@@ -979,9 +979,9 @@ toCMEventTag msg = case msg of
   XGrpInv _ -> XGrpInv_
   XGrpAcpt _ -> XGrpAcpt_
   XGrpLinkInv _ -> XGrpLinkInv_
-  XGrpLinkAcpt _ -> XGrpLinkAcpt_
   XGrpLinkReject _ -> XGrpLinkReject_
   XGrpLinkMem _ -> XGrpLinkMem_
+  XGrpLinkAcpt _ -> XGrpLinkAcpt_
   XGrpMemNew _ -> XGrpMemNew_
   XGrpMemIntro _ _ -> XGrpMemIntro_
   XGrpMemInv _ _ -> XGrpMemInv_
@@ -1082,9 +1082,9 @@ appJsonToCM AppMessageJson {v, msgId, event, params} = do
       XGrpInv_ -> XGrpInv <$> p "groupInvitation"
       XGrpAcpt_ -> XGrpAcpt <$> p "memberId"
       XGrpLinkInv_ -> XGrpLinkInv <$> p "groupLinkInvitation"
-      XGrpLinkAcpt_ -> XGrpLinkAcpt <$> p "memberId"
       XGrpLinkReject_ -> XGrpLinkReject <$> p "groupLinkRejection"
       XGrpLinkMem_ -> XGrpLinkMem <$> p "profile"
+      XGrpLinkAcpt_ -> XGrpLinkAcpt <$> p "role"
       XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo"
       XGrpMemIntro_ -> XGrpMemIntro <$> p "memberInfo" <*> opt "memberRestrictions"
       XGrpMemInv_ -> XGrpMemInv <$> p "memberId" <*> p "memberIntro"
@@ -1146,9 +1146,9 @@ chatToAppMessage ChatMessage {chatVRange, msgId, chatMsgEvent} = case encoding @
       XGrpInv groupInv -> o ["groupInvitation" .= groupInv]
       XGrpAcpt memId -> o ["memberId" .= memId]
       XGrpLinkInv groupLinkInv -> o ["groupLinkInvitation" .= groupLinkInv]
-      XGrpLinkAcpt memId -> o ["memberId" .= memId]
       XGrpLinkReject groupLinkRjct -> o ["groupLinkRejection" .= groupLinkRjct]
       XGrpLinkMem profile -> o ["profile" .= profile]
+      XGrpLinkAcpt role -> o ["role" .= role]
       XGrpMemNew memInfo -> o ["memberInfo" .= memInfo]
       XGrpMemIntro memInfo memRestrictions -> o $ ("memberRestrictions" .=? memRestrictions) ["memberInfo" .= memInfo]
       XGrpMemInv memId memIntro -> o ["memberId" .= memId, "memberIntro" .= memIntro]

src/Simplex/Chat/Store/Groups.hs

@@ -78,6 +78,7 @@ module Simplex.Chat.Store.Groups
     createMemberConnectionAsync,
     updateGroupMemberStatus,
     updateGroupMemberStatusById,
+    updateGroupMemberAccepted,
     createNewGroupMember,
     checkGroupMemberHasItems,
     deleteGroupMember,
@@ -1202,6 +1203,19 @@ updateGroupMemberStatusById db userId groupMemberId memStatus = do
     |]
     (memStatus, currentTs, userId, groupMemberId)
 
+updateGroupMemberAccepted :: DB.Connection -> User -> GroupMember -> GroupMemberRole -> IO GroupMember
+updateGroupMemberAccepted db User {userId} m@GroupMember {groupMemberId} role = do
+  currentTs <- getCurrentTime
+  DB.execute
+    db
+    [sql|
+      UPDATE group_members
+      SET member_status = ?, member_role = ?, updated_at = ?
+      WHERE user_id = ? AND group_member_id = ?
+    |]
+    (GSMemConnected, role, currentTs, userId, groupMemberId)
+  pure m {memberStatus = GSMemConnected, memberRole = role, updatedAt = currentTs}
+
 -- | add new member with profile
 createNewGroupMember :: DB.Connection -> User -> GroupInfo -> GroupMember -> MemberInfo -> GroupMemberCategory -> GroupMemberStatus -> ExceptT StoreError IO GroupMember
 createNewGroupMember db user gInfo invitingMember memInfo@MemberInfo {profile} memCategory memStatus = do