core, ui: relay reject rejoin (#6978)

src/Simplex/Chat/Library/Commands.hs

@@ -1587,6 +1587,9 @@ processChatCommand vr nm = \case
                   Right (Just (Just failure)) -> pure $ CRChatRelayTestResult user (Just relayProfile) (Just failure)
   TestChatRelay address -> withUser $ \User {userId} ->
     processChatCommand vr nm $ APITestChatRelay userId address
+  APIAllowRelayGroup groupId -> withUser $ \user -> do
+    gInfo' <- withStore $ \db -> allowRelayGroup db vr user groupId
+    pure $ CRRelayGroupAllowed user gInfo'
   GetUserChatRelays -> withUser $ \user -> do
     srvs <- withFastStore (`getUserServers` user)
     liftIO $ CRUserServers user <$> groupByOperator (onlyRelays srvs)
@@ -2939,9 +2942,13 @@ processChatCommand vr nm = \case
       toView $ CEvtNewChatItems user [AChatItem SCTGroup SMDSnd (GroupChat gInfo' scopeInfo) ci]
       -- TODO delete direct connections that were unused
       deleteGroupLinkIfExists user gInfo'
+      let relayRejected = useRelays' gInfo && isRelay membership
       -- member records are not deleted to keep history
-      withFastStore' $ \db -> updateGroupMemberStatus db userId membership GSMemLeft
-      pure $ CRLeftMemberUser user gInfo' {membership = membership {memberStatus = GSMemLeft}}
+      withFastStore' $ \db -> do
+        updateGroupMemberStatus db userId membership GSMemLeft
+        when relayRejected $ updateRelayOwnStatus_ db gInfo RSRejected
+      let relayOwnStatus' = if relayRejected then Just RSRejected else relayOwnStatus gInfo
+      pure $ CRLeftMemberUser user gInfo' {membership = membership {memberStatus = GSMemLeft}, relayOwnStatus = relayOwnStatus'}
     where
       -- Relay leaving channel: create delivery job for cursor-based sending and async connection cleanup.
       leaveChannelRelay gInfo = do
@@ -2993,6 +3000,9 @@ processChatCommand vr nm = \case
   LeaveGroup gName -> withUser $ \user -> do
     groupId <- withFastStore $ \db -> getGroupIdByName db user gName
     processChatCommand vr nm $ APILeaveGroup groupId
+  AllowRelayGroup gName -> withUser $ \user -> do
+    groupId <- withFastStore $ \db -> getGroupIdByName db user gName
+    processChatCommand vr nm $ APIAllowRelayGroup groupId
   DeleteGroup gName -> withUser $ \user -> do
     groupId <- withFastStore $ \db -> getGroupIdByName db user gName
     processChatCommand vr nm $ APIDeleteChat (ChatRef CTGroup groupId Nothing) (CDMFull True)
@@ -5041,6 +5051,8 @@ chatCommandP =
       "/xftp" $> GetUserProtoServers (AProtocolType SPXFTP),
       "/_relay test " *> (APITestChatRelay <$> A.decimal <* A.space <*> strP),
       "/relay test " *> (TestChatRelay <$> strP),
+      "/_relay allow #" *> (APIAllowRelayGroup <$> A.decimal),
+      "/group allow #" *> (AllowRelayGroup <$> displayNameP),
       "/relays " *> (SetUserChatRelays <$> chatRelaysP),
       "/relays" $> GetUserChatRelays,
       "/_operators" $> APIGetServerOperators,

src/Simplex/Chat/Library/Internal.hs

@@ -1059,6 +1059,28 @@ acceptRelayJoinRequestAsync
       ownerMember' <- getGroupMemberById db vr user groupMemberId
       pure (gInfo', ownerMember')
 
+rejectRelayInvitationAsync
+  :: User
+  -> Int64
+  -> VersionRangeChat
+  -> GroupRelayInvitation
+  -> InvitationId
+  -> VersionRangeChat
+  -> Int64
+  -> RelayRejectionReason
+  -> CM ()
+rejectRelayInvitationAsync user uclId vr groupRelayInv invId reqChatVRange initialDelay reason = do
+  (_gInfo, ownerMember) <- withStore $ \db ->
+    createRelayRequestGroup db vr user groupRelayInv invId reqChatVRange initialDelay GSMemInvited RSRejected
+  let GroupMember {groupMemberId} = ownerMember
+      msg = XGrpRelayReject reason
+  subMode <- chatReadVar subscriptionMode
+  chatVR <- chatVersionRange
+  let chatV = chatVR `peerConnChatVersion` reqChatVRange
+  connIds <- agentAcceptContactAsync user False invId msg subMode PQSupportOff chatV
+  withStore' $ \db ->
+    createJoiningMemberConnection db user uclId connIds chatV reqChatVRange groupMemberId subMode
+
 businessGroupProfile :: Profile -> GroupPreferences -> GroupProfile
 businessGroupProfile Profile {displayName, fullName, shortDescr, image} groupPreferences =
   GroupProfile {displayName, fullName, description = Nothing, shortDescr, image, publicGroup = Nothing, groupPreferences = Just groupPreferences, memberAdmission = Nothing}

src/Simplex/Chat/Library/Subscriber.hs

@@ -770,6 +770,21 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                     withStore' $ \db -> setRelayLinkConfId db m confId relayLink
                     void $ getAgentConnShortLinkAsync user CFGetRelayDataAccept (Just conn') relayLink
                 | otherwise -> messageError "x.grp.relay.acpt: only owner can add relay"
+              XGrpRelayReject reason
+                | memberRole' membership == GROwner && isRelay m -> do
+                    -- GSMemLeft (not GSMemRejected): owner UI treats this identically to an explicit /leave from the relay; GSMemRejected has knocking-admission semantics.
+                    (relay', m') <- withStore $ \db -> do
+                      relay <- getGroupRelayByGMId db (groupMemberId' m)
+                      relay' <- if relayStatus relay == RSInvited
+                        then liftIO $ updateRelayStatusFromTo db relay RSInvited RSRejected
+                        else pure relay
+                      liftIO $ updateGroupMemberStatus db userId m GSMemLeft
+                      pure (relay', m {memberStatus = GSMemLeft})
+                    -- complete the contact handshake so the relay receives INFO and cleans up its transient bookkeeping
+                    allowAgentConnectionAsync user conn' confId XOk
+                    toView $ CEvtGroupRelayUpdated user gInfo m' relay'
+                    toViewTE $ TERelayRejected user gInfo reason
+                | otherwise -> messageError "x.grp.relay.reject: only owner should receive relay rejection"
               _ -> messageError "CONF from invited member must have x.grp.acpt"
           GCHostMember ->
             case chatMsgEvent of
@@ -817,10 +832,16 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
             when (memberStatus m == GSMemRejected) $ do
               deleteMemberConnection' m True
               withStore' $ \db -> deleteGroupMember db user m
-          XOk -> pure ()
+          XOk ->
+            -- transient relay-reject row cleanup after the rejection handshake completes
+            when (memberCategory m == GCHostMember && not (relayServesGroup gInfo)) $ do
+              deleteMemberConnection' m True
+              withStore' $ \db -> do
+                deleteGroupMember db user m
+                deleteGroup db user gInfo
           _ -> messageError "INFO from member must have x.grp.mem.info, x.info or x.ok"
         pure ()
-      CON _pqEnc -> unless (memberStatus m == GSMemRejected || memberStatus membership == GSMemRejected) $ do
+      CON _pqEnc -> unless rejected $ do
         -- TODO [knocking] send pending messages after accepting?
         -- possible improvement: check for each pending message, requires keeping track of connection state
         unless (connDisabled conn) $ sendPendingGroupMessages user gInfo m conn
@@ -922,6 +943,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                     forM_ (memberConn im) $ \imConn ->
                       void $ sendDirectMemberMessage imConn (XGrpMemCon memberId) groupId
                 _ -> messageWarning "sendXGrpMemCon: member category GCPreMember or GCPostMember is expected"
+        where
+          rejected =
+            memberStatus m `elem` ([GSMemRejected, GSMemLeft, GSMemRemoved, GSMemGroupDeleted] :: [GroupMemberStatus])
+              || memberStatus membership == GSMemRejected
+              || not (relayServesGroup gInfo)
       MSG msgMeta _msgFlags msgBody -> do
         tags <- newTVarIO []
         withAckMessage "group msg" agentConnId msgMeta True (Just tags) $ \eInfo -> do
@@ -933,7 +959,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
             if isUserGrpFwdRelay gInfo' && not (blockedByAdmin m)
               then
                 let tasks
-                      | relayOwnStatus gInfo' == Just RSInactive = filter relayRemovedNewTask newDeliveryTasks
+                      | not (relayServesGroup gInfo') = filter relayRemovedNewTask newDeliveryTasks
                       | otherwise = newDeliveryTasks
                  in createDeliveryTasks gInfo' m' tasks
               else pure False
@@ -1523,10 +1549,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
                           mem <- acceptGroupJoinSendRejectAsync user uclId gInfo invId chatVRange p xContactId_ rjctReason
                           toViewTE $ TERejectingGroupJoinRequestMember user gInfo mem rjctReason
         xGrpRelayInv :: InvitationId -> VersionRangeChat -> GroupRelayInvitation -> CM ()
-        xGrpRelayInv invId chatVRange groupRelayInv = do
+        xGrpRelayInv invId chatVRange groupRelayInv@GroupRelayInvitation {groupLink} = do
+          rejected <- withStore' $ \db -> isRelayGroupRejected db user groupLink
           initialDelay <- asks $ initialInterval . relayRequestRetryInterval . config
-          (_gInfo, _ownerMember) <- withStore $ \db -> createRelayRequestGroup db vr user groupRelayInv invId chatVRange initialDelay
-          lift $ void $ getRelayRequestWorker True
+          if rejected
+            then rejectRelayInvitationAsync user uclId vr groupRelayInv invId chatVRange initialDelay RRRRejoinRejected
+            else do
+              (_gInfo, _ownerMember) <- withStore $ \db ->
+                createRelayRequestGroup db vr user groupRelayInv invId chatVRange initialDelay GSMemAccepted RSInvited
+              lift $ void $ getRelayRequestWorker True
         xGrpRelayTest :: InvitationId -> VersionRangeChat -> ByteString -> CM ()
         xGrpRelayTest invId chatVRange challenge = do
           privKey_ <- withAgent $ \a -> getConnLinkPrivKey a (aConnId conn)
@@ -3133,7 +3164,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
           unless (isUserGrpFwdRelay gInfo) $ deleteGroupConnections user gInfo False
           withStore' $ \db -> do
             updateGroupMemberStatus db userId membership GSMemRemoved
-            when (isJust $ relayOwnStatus gInfo) $ updateRelayOwnStatus_ db gInfo RSInactive
+            when (maybe False (/= RSRejected) (relayOwnStatus gInfo)) $ updateRelayOwnStatus_ db gInfo RSInactive
           let membership' = membership {memberStatus = GSMemRemoved}
           when withMessages $ deleteMessages gInfo membership' SMDSnd
           deleteMemberItem msg gInfo RGEUserDeleted
@@ -3572,7 +3603,7 @@ runDeliveryTaskWorker a deliveryKey Worker {doWork} = do
         processDeliveryTask task@MessageDeliveryTask {jobScope} =
           case jobScopeImpliedSpec jobScope of
             DJDeliveryJob _includePending
-              | relayOwnStatus gInfo == Just RSInactive -> do
+              | not (relayServesGroup gInfo) -> do
                   logWarn "delivery task worker: relay inactive"
                   withStore' $ \db -> setDeliveryTaskErrStatus db (deliveryTaskId task) "relay inactive"
               | otherwise ->
@@ -3642,7 +3673,7 @@ runDeliveryJobWorker a deliveryKey Worker {doWork} = do
         processDeliveryJob job =
           case jobScopeImpliedSpec jobScope of
             DJDeliveryJob _includePending
-              | relayOwnStatus gInfo == Just RSInactive -> do
+              | not (relayServesGroup gInfo) -> do
                   logWarn "delivery job worker: relay inactive"
                   withStore' $ \db -> setDeliveryJobErrStatus db (deliveryJobId job) "relay inactive"
               | otherwise -> do