wip

src/Simplex/Chat/Library/Commands.hs

@@ -3815,6 +3815,7 @@ chatCommandP =
       "/_ntf conn messages " *> (ApiGetConnNtfMessages <$> strP),
       "/_add #" *> (APIAddMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
       "/_join #" *> (APIJoinGroup <$> A.decimal <*> pure MFAll), -- needs to be changed to support in UI
+      "/_accept member #" *> (APIAcceptMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
       "/_member role #" *> (APIMemberRole <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
       "/_block #" *> (APIBlockMemberForAll <$> A.decimal <* A.space <*> A.decimal <* A.space <* "blocked=" <*> onOffP),
       "/_remove #" *> (APIRemoveMember <$> A.decimal <* A.space <*> A.decimal),

src/Simplex/Chat/Library/Internal.hs

@@ -820,17 +820,19 @@ acceptContactRequestAsync user cReq@UserContactRequest {agentInvitationId = Agen
     setCommandConnId db user cmdId connId
     pure ct
 
-acceptGroupJoinRequestAsync :: User -> GroupInfo -> UserContactRequest -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember
+acceptGroupJoinRequestAsync :: User -> GroupInfo -> UserContactRequest -> GroupAcceptance -> GroupMemberRole -> Maybe IncognitoProfile -> CM GroupMember
 acceptGroupJoinRequestAsync
   user
   gInfo@GroupInfo {groupProfile, membership, businessChat}
   ucr@UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange}
+  gAcceptance
   gLinkMemRole
   incognitoProfile = do
     gVar <- asks random
+    let initialStatus = acceptanceToStatus gAcceptance
     (groupMemberId, memberId) <- withStore $ \db -> do
       liftIO $ deleteContactRequestRec db user ucr
-      createJoiningMember db gVar user gInfo ucr gLinkMemRole GSMemAccepted
+      createJoiningMember db gVar user gInfo ucr gLinkMemRole initialStatus
     currentMemCount <- withStore' $ \db -> getGroupCurrentMembersCount db user gInfo
     let Profile {displayName} = profileToSendOnAccept user incognitoProfile True
         GroupMember {memberRole = userRole, memberId = userMemberId} = membership
@@ -841,7 +843,7 @@ acceptGroupJoinRequestAsync
                 fromMemberName = displayName,
                 invitedMember = MemberIdRole memberId gLinkMemRole,
                 groupProfile,
-                acceptance = Nothing, -- TODO [knocking]
+                acceptance = Just gAcceptance,
                 business = businessChat,
                 groupSize = Just currentMemCount
               }
@@ -901,7 +903,7 @@ acceptBusinessJoinRequestAsync
                 fromMemberName = displayName,
                 invitedMember = MemberIdRole memberId GRMember,
                 groupProfile = businessGroupProfile userProfile groupPreferences,
-                acceptance = Nothing, -- TODO [knocking]
+                acceptance = Just GAAuto,
                 -- This refers to the "title member" that defines the group name and profile.
                 -- This coincides with fromMember to be current user when accepting the connecting user,
                 -- but it will be different when inviting somebody else.

src/Simplex/Chat/Library/Subscriber.hs

@@ -594,13 +594,14 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                 ucl <- withStore $ \db -> getUserContactLinkById db userId userContactLinkId
                 let (UserContactLink {autoAccept}, gli_) = ucl
                 when (connChatVersion < batchSend2Version) $ sendAutoReply ct' autoAccept
-                -- -- TODO [knocking] legacy branch - do nothing?
-                -- forM_ gli_ $ \GroupLinkInfo {groupId, memberRole = gLinkMemRole, acceptance = _acceptance} -> do
-                --   groupInfo <- withStore $ \db -> getGroupInfo db vr user groupId
-                --   subMode <- chatReadVar subscriptionMode
-                --   groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode
-                --   gVar <- asks random
-                --   withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct' gLinkMemRole groupConnIds connChatVersion peerChatVRange subMode
+                -- TODO REMOVE LEGACY vvv
+                forM_ gli_ $ \GroupLinkInfo {groupId, memberRole = gLinkMemRole, acceptance = _acceptance} -> do
+                  groupInfo <- withStore $ \db -> getGroupInfo db vr user groupId
+                  subMode <- chatReadVar subscriptionMode
+                  groupConnIds <- createAgentConnectionAsync user CFCreateConnGrpInv True SCMInvitation subMode
+                  gVar <- asks random
+                  withStore $ \db -> createNewContactMemberAsync db gVar user groupInfo ct' gLinkMemRole groupConnIds connChatVersion peerChatVRange subMode
+            -- TODO REMOVE LEGACY ^^^
             Just (gInfo, m@GroupMember {activeConn}) ->
               when (maybe False ((== ConnReady) . connStatus) activeConn) $ do
                 notifyMemberConnected gInfo m $ Just ct
@@ -704,6 +705,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                       liftIO $ setConnConnReqInv db user connId cReq
                       getHostConnId db user groupId
                     sendXGrpMemInv hostConnId Nothing XGrpMemIntroCont {groupId, groupMemberId, memberId, groupConnReq}
+              -- TODO REMOVE LEGACY vvv
               -- [async agent commands] group link auto-accept continuation on receiving INV
               CFCreateConnGrpInv -> do
                 ct <- withStore $ \db -> getContactViaMember db vr user m
@@ -729,6 +731,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                     (_msg, _) <- sendDirectContactMessage user ct $ XGrpInv groupInv
                     -- we could link chat item with sent group invitation message (_msg)
                     createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
+              -- TODO REMOVE LEGACY ^^^
               _ -> throwChatError $ CECommandError "unexpected cmdFunction"
             CRContactUri _ -> throwChatError $ CECommandError "unexpected ConnectionRequestUri type"
       CONF confId _pqSupport _ connInfo -> do
@@ -766,7 +769,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
             | otherwise -> messageError "x.grp.mem.info: memberId is different from expected"
           -- sent when connecting via group link
           XInfo _ ->
-            -- TODO [group rejection] Keep rejected member record and connection for ability to start dialogue.
+            -- TODO Keep rejected member to allow them to appeal against rejection.
             when (memberStatus m == GSMemRejected) $ do
               deleteMemberConnection' user m True
               withStore' $ \db -> deleteGroupMember db user m
@@ -774,17 +777,20 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           _ -> messageError "INFO from member must have x.grp.mem.info, x.info or x.ok"
         pure ()
       CON _pqEnc -> unless (memberStatus m == GSMemRejected) $ do
-        withStore' $ \db -> do
-          updateGroupMemberStatus db userId m GSMemConnected
-          unless (memberActive membership) $
-            updateGroupMemberStatus db userId membership GSMemConnected
-        -- possible improvement: check for each pending message, requires keeping track of connection state
-        unless (connDisabled conn) $ sendPendingGroupMessages user m conn
+        status' <- case memberStatus m of
+          GSMemPendingApproval -> pure GSMemPendingApproval
+          _ -> do
+            withStore' $ \db -> do
+              updateGroupMemberStatus db userId m GSMemConnected
+              unless (memberActive membership) $
+                updateGroupMemberStatus db userId membership GSMemConnected
+            -- possible improvement: check for each pending message, requires keeping track of connection state
+            unless (connDisabled conn) $ sendPendingGroupMessages user m conn
+            pure GSMemConnected
         withAgent $ \a -> toggleConnectionNtfs a (aConnId conn) $ chatHasNtfs chatSettings
         case memberCategory m of
           GCHostMember -> do
-            -- TODO [knocking] here it will communicate whether user is approved as member as status of membership
-            toView $ CRUserJoinedGroup user gInfo {membership = membership {memberStatus = GSMemConnected}} m {memberStatus = GSMemConnected}
+            toView $ CRUserJoinedGroup user gInfo {membership = membership {memberStatus = status'}} m {memberStatus = status'}
             let cd = CDGroupRcv gInfo m
             createInternalChatItem user cd (CIRcvGroupE2EEInfo E2EInfo {pqEnabled = PQEncOff}) Nothing
             createGroupFeatureItems user cd CIRcvGroupFeature gInfo
@@ -795,16 +801,17 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
               expectHistory = groupFeatureAllowed SGFHistory gInfo && m `supportsVersion` groupHistoryIncludeWelcomeVersion
           GCInviteeMember -> do
             memberConnectedChatItem gInfo m
-            -- TODO [knocking] here it will communicate whether member needs to be approved as member status
-            toView $ CRJoinedGroupMember user gInfo m {memberStatus = GSMemConnected}
+            toView $ CRJoinedGroupMember user gInfo m {memberStatus = status'}
             let Connection {viaUserContactLink} = conn
             when (isJust viaUserContactLink && isNothing (memberContactId m)) sendXGrpLinkMem
-            members <- withStore' $ \db -> getGroupMembers db vr user gInfo
-            void . sendGroupMessage user gInfo members . XGrpMemNew $ memberInfo m
-            sendIntroductions members
-            when (groupFeatureAllowed SGFHistory gInfo) sendHistory
             when (connChatVersion < batchSend2Version) sendGroupAutoReply
+            unless (status' == GSMemPendingApproval) introduceToGroup
             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
@@ -1331,7 +1338,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                                 messageError "processUserContactRequest: chat version range incompatible for accepting group join request"
                             | otherwise -> do
                                 let profileMode = ExistingIncognito <$> incognitoMembershipProfile gInfo
-                                mem <- acceptGroupJoinRequestAsync user gInfo cReq useRole profileMode
+                                mem <- acceptGroupJoinRequestAsync user gInfo cReq acceptance useRole profileMode
                                 createInternalChatItem user (CDGroupRcv gInfo mem) (CIRcvGroupEvent RGEInvitedViaGroupLink) Nothing
                                 toView $ CRAcceptingGroupJoinRequestMember user gInfo mem
                           Left rjctReason
@@ -1341,19 +1348,19 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                                 mem <- acceptGroupJoinSendRejectAsync user gInfo cReq rjctReason
                                 toViewTE $ TERejectingGroupJoinRequestMember user gInfo mem rjctReason
                 _ -> toView $ CRReceivedContactRequest user cReq
-          -- TODO [knocking] move logic to bot
-          -- where
-          --   rejectionReason ChatConfig {profileNameLimit, allowedProfileName}
-          --     | T.length displayName > profileNameLimit = Just GRRLongName
-          --     | maybe False (\f -> not $ f displayName) allowedProfileName = Just GRRBlockedName
-          --     | otherwise = Nothing
-          --   userMemberRole linkRole = \case
-          --     Just AOAll -> GRObserver
-          --     Just AONameOnly | noImage -> GRObserver
-          --     Just AOIncognito | noImage && isRandomName displayName -> GRObserver
-          --     _ -> linkRole
-          --     where
-          --       noImage = maybe True (\(ImageData i) -> i == "") image
+    -- TODO [knocking] move logic to bot
+    -- where
+    --   rejectionReason ChatConfig {profileNameLimit, allowedProfileName}
+    --     | T.length displayName > profileNameLimit = Just GRRLongName
+    --     | maybe False (\f -> not $ f displayName) allowedProfileName = Just GRRBlockedName
+    --     | otherwise = Nothing
+    --   userMemberRole linkRole = \case
+    --     Just AOAll -> GRObserver
+    --     Just AONameOnly | noImage -> GRObserver
+    --     Just AOIncognito | noImage && isRandomName displayName -> GRObserver
+    --     _ -> linkRole
+    --     where
+    --       noImage = maybe True (\(ImageData i) -> i == "") image
 
     memberCanSend :: GroupMember -> CM () -> CM ()
     memberCanSend GroupMember {memberRole} a
@@ -2176,16 +2183,22 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
     xInfoMember gInfo m p' brokerTs = void $ processMemberProfileUpdate gInfo m p' True (Just brokerTs)
 
     xGrpLinkMem :: GroupInfo -> GroupMember -> Connection -> Profile -> CM ()
-    xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory} Connection {viaGroupLink} p' = do
+    xGrpLinkMem gInfo@GroupInfo {membership, businessChat} m@GroupMember {groupMemberId, memberCategory, memberStatus} Connection {viaGroupLink} p' = do
       xGrpLinkMemReceived <- withStore $ \db -> getXGrpLinkMemReceived db groupMemberId
       if (viaGroupLink || isJust businessChat) && isNothing (memberContactId m) && memberCategory == GCHostMember && not xGrpLinkMemReceived
         then do
           m' <- processMemberProfileUpdate gInfo m p' False Nothing
           withStore' $ \db -> setXGrpLinkMemReceived db groupMemberId True
-          let connectedIncognito = memberIncognito membership
-          probeMatchingMemberContact m' connectedIncognito
+          unless (memberStatus == GSMemPendingApproval) $ do
+            let connectedIncognito = memberIncognito membership
+            probeMatchingMemberContact m' connectedIncognito
         else messageError "x.grp.link.mem error: invalid group link host profile update"
 
+    -- TODO [knocking]
+    -- xGrpLinkAcpt
+    -- set statuses to GSMemConnected
+    -- probeMatchingMemberContact
+
     processMemberProfileUpdate :: GroupInfo -> GroupMember -> Profile -> Bool -> Maybe UTCTime -> CM GroupMember
     processMemberProfileUpdate gInfo m@GroupMember {memberProfile = p, memberContactId} p' createItems itemTs_
       | redactedMemberProfile (fromLocalProfile p) /= redactedMemberProfile p' = do

src/Simplex/Chat/Store/Groups.hs

@@ -520,9 +520,10 @@ deleteContactCardKeepConn db connId Contact {contactId, profile = LocalProfile {
   DB.execute db "DELETE FROM contact_profiles WHERE contact_profile_id = ?" (Only profileId)
 
 createGroupInvitedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkInvitation -> ExceptT StoreError IO (GroupInfo, GroupMember)
-createGroupInvitedViaLink db vr user conn GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, business} = do
+createGroupInvitedViaLink db vr user conn GroupLinkInvitation {fromMember, fromMemberName, invitedMember, groupProfile, acceptance, business} = do
   let fromMemberProfile = profileFromName fromMemberName
-  createGroupViaLink' db vr user conn fromMember fromMemberProfile invitedMember groupProfile business GSMemAccepted
+      initialStatus = maybe GSMemAccepted acceptanceToStatus acceptance
+  createGroupViaLink' db vr user conn fromMember fromMemberProfile invitedMember groupProfile business initialStatus
 
 createGroupRejectedViaLink :: DB.Connection -> VersionRangeChat -> User -> Connection -> GroupLinkRejection -> ExceptT StoreError IO (GroupInfo, GroupMember)
 createGroupRejectedViaLink db vr user conn GroupLinkRejection {fromMember = fromMember@MemberIdRole {memberId}, invitedMember, groupProfile} = do

src/Simplex/Chat/Types.hs

@@ -1019,6 +1019,11 @@ instance ToJSON GroupMemberStatus where
   toJSON = J.String . textEncode
   toEncoding = JE.text . textEncode
 
+acceptanceToStatus :: GroupAcceptance -> GroupMemberStatus
+acceptanceToStatus = \case
+  GAAuto -> GSMemAccepted
+  GAManual -> GSMemPendingApproval
+
 memberActive :: GroupMember -> Bool
 memberActive m = case memberStatus m of
   GSMemRejected -> False
@@ -1027,7 +1032,7 @@ memberActive m = case memberStatus m of
   GSMemGroupDeleted -> False
   GSMemUnknown -> False
   GSMemInvited -> False
-  GSMemPendingApproval -> True -- TODO [knocking] False?
+  GSMemPendingApproval -> True
   GSMemIntroduced -> False
   GSMemIntroInvited -> False
   GSMemAccepted -> False
@@ -1048,7 +1053,7 @@ memberCurrent' = \case
   GSMemGroupDeleted -> False
   GSMemUnknown -> False
   GSMemInvited -> False
-  GSMemPendingApproval -> False -- TODO [knocking] True?
+  GSMemPendingApproval -> False
   GSMemIntroduced -> True
   GSMemIntroInvited -> True
   GSMemAccepted -> True

src/Simplex/Chat/Types/Shared.hs

@@ -51,6 +51,7 @@ instance ToJSON GroupMemberRole where
 
 data GroupAcceptance = GAAuto | GAManual deriving (Eq, Show)
 
+-- TODO [knocking] encoding doesn't match field type
 instance FromField GroupAcceptance where fromField = blobFieldDecoder strDecode
 
 instance ToField GroupAcceptance where toField = toField . strEncode

src/Simplex/Chat/View.hs

@@ -1080,8 +1080,12 @@ viewUserJoinedGroup g =
     Nothing -> [ttyGroup' g <> ": you joined the group"]
 
 viewJoinedGroupMember :: GroupInfo -> GroupMember -> [StyledString]
-viewJoinedGroupMember g m =
-  [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "]
+viewJoinedGroupMember g@GroupInfo {groupId} m@GroupMember {groupMemberId, memberStatus} = case memberStatus of
+  GSMemPendingApproval ->
+    [ (ttyGroup' g <> ": " <> ttyMember m <> " connected and pending approval, ")
+      <> ("use " <> highlight ("/_accept member #" <> show groupId <> " " <> show groupMemberId <> " <role>") <> " to accept member")
+    ]
+  _ -> [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "]
 
 viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> [StyledString]
 viewReceivedGroupInvitation g c role =

tests/ChatTests/Groups.hs

@@ -87,7 +87,7 @@ chatGroupTests = do
     xit'' "shared batch body is reused" testSharedBatchBody
   describe "async group connections" $ do
     xit "create and join group when clients go offline" testGroupAsync
-  describe "group links" $ do
+  fdescribe "group links" $ do
     it "create group link, join via group link" testGroupLink
     it "invitees were previously connected as contacts" testGroupLinkInviteesWereConnected
     it "all members were previously connected as contacts" testGroupLinkAllMembersWereConnected