diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 9376fb100..f636aa269 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1368,8 +1368,49 @@ processChatCommand = \case RejectContact cName -> withUser $ \User {userId} -> do connReqId <- withStore $ \db -> getContactRequestIdByName db userId cName processChatCommand $ APIRejectContact connReqId - SendMessage chatName msg -> sendTextMessage chatName msg False - SendLiveMessage chatName msg -> sendTextMessage chatName msg True + SendMessage (ChatName cType name) msg -> withUser $ \user -> do + let mc = MCText msg + case cType of + CTDirect -> + withStore' (\db -> runExceptT $ getContactIdByName db user name) >>= \case + Right ctId -> do + let chatRef = ChatRef CTDirect ctId + processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage Nothing Nothing mc + Left _ -> + withStore' (\db -> runExceptT $ getActiveMembersByName db user name) >>= \case + Right [(gInfo, member)] -> do + let GroupInfo {localDisplayName = gName} = gInfo + GroupMember {localDisplayName = mName} = member + processChatCommand $ SendMemberContactMessage gName mName msg + Right (suspectedMember : _) -> + throwChatError $ CEContactNotFound name (Just suspectedMember) + _ -> + throwChatError $ CEContactNotFound name Nothing + CTGroup -> do + gId <- withStore $ \db -> getGroupIdByName db user name + let chatRef = ChatRef CTGroup gId + processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage Nothing Nothing mc + _ -> throwChatError $ CECommandError "not supported" + SendMemberContactMessage gName mName msg -> withUser $ \user -> do + (gId, mId) <- getGroupAndMemberId user gName mName + m <- withStore $ \db -> getGroupMember db user gId mId + let mc = MCText msg + case memberContactId m of + Nothing -> do + gInfo <- withStore $ \db -> getGroupInfo db user gId + toView $ CRNoMemberContactCreating user gInfo m + processChatCommand (APICreateMemberContact gId mId) >>= \case + cr@(CRNewMemberContact _ Contact {contactId} _ _) -> do + toView cr + processChatCommand $ APISendMemberContactInvitation contactId (Just mc) + cr -> pure cr + Just ctId -> do + let chatRef = ChatRef CTDirect ctId + processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage Nothing Nothing mc + SendLiveMessage chatName msg -> withUser $ \user -> do + chatRef <- getChatRef user chatName + let mc = MCText msg + processChatCommand . APISendMessage chatRef True Nothing $ ComposedMessage Nothing Nothing mc SendMessageBroadcast msg -> withUser $ \user -> do contacts <- withStore' (`getUserContacts` user) let cts = filter (\ct -> isReady ct && directOrUsed ct) contacts @@ -1616,11 +1657,6 @@ processChatCommand = \case toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct') ci) pure $ CRNewMemberContactSentInv user ct' g m _ -> throwChatError CEGroupMemberNotActive - CreateMemberContact gName mName -> withMemberName gName mName APICreateMemberContact - SendMemberContactInvitation cName msg_ -> withUser $ \user -> do - contactId <- withStore $ \db -> getContactIdByName db user cName - let mc = MCText <$> msg_ - processChatCommand $ APISendMemberContactInvitation contactId mc CreateGroupLink gName mRole -> withUser $ \user -> do groupId <- withStore $ \db -> getGroupIdByName db user gName processChatCommand $ APICreateGroupLink groupId mRole @@ -2052,10 +2088,6 @@ processChatCommand = \case ci <- saveSndChatItem user (CDDirectSnd ct) msg content toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci) setActive $ ActiveG localDisplayName - sendTextMessage chatName msg live = withUser $ \user -> do - chatRef <- getChatRef user chatName - let mc = MCText msg - processChatCommand . APISendMessage chatRef live Nothing $ ComposedMessage Nothing Nothing mc sndContactCITimed :: Bool -> Contact -> Maybe Int -> m (Maybe CITimed) sndContactCITimed live = sndCITimed_ live . contactTimedTTL sndGroupCITimed :: Bool -> GroupInfo -> Maybe Int -> m (Maybe CITimed) @@ -5420,8 +5452,6 @@ chatCommandP = "/show link #" *> (ShowGroupLink <$> displayName), "/_create member contact #" *> (APICreateMemberContact <$> A.decimal <* A.space <*> A.decimal), "/_invite member contact @" *> (APISendMemberContactInvitation <$> A.decimal <*> optional (A.space *> msgContentP)), - "/contact member #" *> (CreateMemberContact <$> displayName <* A.space <*> displayName), - "/invite member contact @" *> (SendMemberContactInvitation <$> displayName <*> optional (A.space *> msgTextP)), (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <*> pure Nothing <*> quotedMsg <*> msgTextP), (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> msgTextP), "/_contacts " *> (APIListContacts <$> A.decimal), @@ -5432,6 +5462,7 @@ chatCommandP = ("/connect" <|> "/c") *> (Connect <$> incognitoP <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)), ("/connect" <|> "/c") *> (AddContact <$> incognitoP), SendMessage <$> chatNameP <* A.space <*> msgTextP, + "@#" *> (SendMemberContactMessage <$> displayName <* A.space <* char_ '@' <*> displayName <* A.space <*> msgTextP), "/live " *> (SendLiveMessage <$> chatNameP <*> (A.space *> msgTextP <|> pure "")), (">@" <|> "> @") *> sendMsgQuote (AMsgDirection SMDRcv), (">>@" <|> ">> @") *> sendMsgQuote (AMsgDirection SMDSnd), diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 5b34e85db..7b6212650 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -284,8 +284,6 @@ data ChatCommand | APIGetGroupLink GroupId | APICreateMemberContact GroupId GroupMemberId | APISendMemberContactInvitation {contactId :: ContactId, msgContent_ :: Maybe MsgContent} - | CreateMemberContact GroupName ContactName - | SendMemberContactInvitation {contactName :: ContactName, message_ :: Maybe Text} | APIGetUserProtoServers UserId AProtocolType | GetUserProtoServers AProtocolType | APISetUserProtoServers UserId AProtoServersConfig @@ -357,6 +355,7 @@ data ChatCommand | AcceptContact IncognitoEnabled ContactName | RejectContact ContactName | SendMessage ChatName Text + | SendMemberContactMessage GroupName ContactName Text | SendLiveMessage ChatName Text | SendMessageQuote {contactName :: ContactName, msgDir :: AMsgDirection, quotedMsg :: Text, message :: Text} | SendMessageBroadcast Text -- UserId (not used in UI) @@ -557,6 +556,7 @@ data ChatResponse | CRGroupLink {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact, memberRole :: GroupMemberRole} | CRGroupLinkDeleted {user :: User, groupInfo :: GroupInfo} | CRAcceptingGroupJoinRequest {user :: User, groupInfo :: GroupInfo, contact :: Contact} + | CRNoMemberContactCreating {user :: User, groupInfo :: GroupInfo, member :: GroupMember} -- only used in CLI | CRNewMemberContact {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember} | CRNewMemberContactSentInv {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember} | CRNewMemberContactReceivedInv {user :: User, contact :: Contact, groupInfo :: GroupInfo, member :: GroupMember} @@ -884,6 +884,7 @@ data ChatErrorType | CEChatStoreChanged | CEInvalidConnReq | CEInvalidChatMessage {connection :: Connection, msgMeta :: Maybe MsgMetaJSON, messageData :: Text, message :: String} + | CEContactNotFound {contactName :: ContactName, suspectedMember :: Maybe (GroupInfo, GroupMember)} | CEContactNotReady {contact :: Contact} | CEContactDisabled {contact :: Contact} | CEConnectionDisabled {connection :: Connection} diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index a8e9eb442..1e5f8c976 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -34,6 +34,7 @@ module Simplex.Chat.Store.Groups updateGroupProfile, getGroupIdByName, getGroupMemberIdByName, + getActiveMembersByName, getGroupInfoByName, getGroupMember, getGroupMemberById, @@ -97,7 +98,9 @@ import Control.Monad.Except import Crypto.Random (ChaChaDRG) import Data.Either (rights) import Data.Int (Int64) +import Data.List (sortOn) import Data.Maybe (fromMaybe, isNothing) +import Data.Ord (Down (..)) import Data.Text (Text) import Data.Time.Clock (UTCTime (..), getCurrentTime) import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), (:.) (..)) @@ -1127,6 +1130,27 @@ getGroupMemberIdByName db User {userId} groupId groupMemberName = ExceptT . firstRow fromOnly (SEGroupMemberNameNotFound groupId groupMemberName) $ DB.query db "SELECT group_member_id FROM group_members WHERE user_id = ? AND group_id = ? AND local_display_name = ?" (userId, groupId, groupMemberName) +getActiveMembersByName :: DB.Connection -> User -> ContactName -> ExceptT StoreError IO [(GroupInfo, GroupMember)] +getActiveMembersByName db user@User {userId} groupMemberName = do + groupMemberIds :: [(GroupId, GroupMemberId)] <- + liftIO $ + DB.query + db + [sql| + SELECT group_id, group_member_id + FROM group_members + WHERE user_id = ? AND local_display_name = ? + AND member_status IN (?,?) AND member_category != ? + |] + (userId, groupMemberName, GSMemConnected, GSMemComplete, GCUserMember) + possibleMembers <- forM groupMemberIds $ \(groupId, groupMemberId) -> do + groupInfo <- getGroupInfo db user groupId + groupMember <- getGroupMember db user groupId groupMemberId + pure (groupInfo, groupMember) + pure $ sortOn (Down . ts . fst) possibleMembers + where + ts GroupInfo {chatTs, updatedAt} = fromMaybe updatedAt chatTs + getMatchingContacts :: DB.Connection -> User -> Contact -> IO [Contact] getMatchingContacts db user@User {userId} Contact {contactId, profile = LocalProfile {displayName, fullName, image}} = do contactIds <- diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index e69c0f469..5cbab08ae 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -230,7 +230,8 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView CRGroupLink u g cReq mRole -> ttyUser u $ groupLink_ "Group link:" g cReq mRole CRGroupLinkDeleted u g -> ttyUser u $ viewGroupLinkDeleted g CRAcceptingGroupJoinRequest _ g c -> [ttyFullContact c <> ": accepting request to join group " <> ttyGroup' g <> "..."] - CRNewMemberContact u Contact {localDisplayName = c} g m -> ttyUser u ["contact for member " <> ttyGroup' g <> " " <> ttyMember m <> " prepared, use " <> highlight ("/invite member contact @" <> c <> " ") <> " to send invitation"] + CRNoMemberContactCreating u g m -> ttyUser u ["member " <> ttyGroup' g <> " " <> ttyMember m <> " does not have associated contact, creating contact"] + CRNewMemberContact u _ g m -> ttyUser u ["contact for member " <> ttyGroup' g <> " " <> ttyMember m <> " is created"] CRNewMemberContactSentInv u _ct g m -> ttyUser u ["sent invitation to connect directly to member " <> ttyGroup' g <> " " <> ttyMember m] CRNewMemberContactReceivedInv u ct g m -> ttyUser u [ttyGroup' g <> " " <> ttyMember m <> " is creating direct contact " <> ttyContact' ct <> " with you"] CRMemberSubError u g m e -> ttyUser u [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e] @@ -665,6 +666,17 @@ viewConnReqInvitation cReq = "and ask them to connect: " <> highlight' "/c " ] +viewContactNotFound :: ContactName -> Maybe (GroupInfo, GroupMember) -> [StyledString] +viewContactNotFound cName suspectedMember = + ["no contact " <> ttyContact cName <> useMessageMember] + where + useMessageMember = case suspectedMember of + Just (g, m) -> do + let GroupInfo {localDisplayName = gName} = g + GroupMember {localDisplayName = mName} = m + ", use " <> highlight' ("@#" <> T.unpack gName <> " " <> T.unpack mName <> " ") + _ -> "" + viewChatCleared :: AChatInfo -> [StyledString] viewChatCleared (AChatInfo _ chatInfo) = case chatInfo of DirectChat ct -> [ttyContact' ct <> ": all messages are removed locally ONLY"] @@ -1547,6 +1559,7 @@ viewChatError logLevel = \case <> (", connection id: " <> show connId) <> maybe "" (\MsgMetaJSON {rcvId} -> ", agent msg rcv id: " <> show rcvId) msgMeta_ ] + CEContactNotFound cName m_ -> viewContactNotFound cName m_ CEContactNotReady c -> [ttyContact' c <> ": not ready"] CEContactDisabled Contact {localDisplayName = c} -> [ttyContact c <> ": disabled, to enable: " <> highlight ("/enable " <> c) <> ", to delete: " <> highlight ("/d " <> c)] CEConnectionDisabled Connection {connId, connType} -> [plain $ "connection " <> textEncode connType <> " (" <> tshow connId <> ") is disabled" | logLevel <= CLLWarning] diff --git a/tests/ChatTests/Groups.hs b/tests/ChatTests/Groups.hs index f83d94e39..4f2c61b92 100644 --- a/tests/ChatTests/Groups.hs +++ b/tests/ChatTests/Groups.hs @@ -237,8 +237,12 @@ testGroupShared alice bob cath checkMessages = do -- delete contact alice ##> "/d bob" alice <## "bob: contact is deleted" - alice ##> "@bob hey" - alice <## "no contact bob" + alice `send` "@bob hey" + alice + <### [ "@bob hey", + "member #team bob does not have associated contact, creating contact", + "peer chat protocol version range incompatible" + ] when checkMessages $ threadDelay 1000000 alice #> "#team checking connection" bob <# "#team alice> checking connection" @@ -650,11 +654,22 @@ testGroupDeleteInvitedContact = bob <# "#team alice> hello" bob #> "#team hi there" alice <# "#team bob> hi there" - alice ##> "@bob hey" - alice <## "no contact bob" - bob #> "@alice hey" - bob <## "[alice, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection" - (alice hey", + "alice: security code changed" + ] + concurrently_ + (alice <## "bob (Bob): contact is connected") + (bob <## "alice (Alice): contact is connected") + alice <##> bob testDeleteGroupMemberProfileKept :: HasCallStack => FilePath -> IO () testDeleteGroupMemberProfileKept = @@ -703,7 +718,7 @@ testDeleteGroupMemberProfileKept = alice ##> "/d bob" alice <## "bob: contact is deleted" alice ##> "@bob hey" - alice <## "no contact bob" + alice <## "no contact bob, use @#club bob " bob #> "@alice hey" bob <## "[alice, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection" (alice "/d alice" bob <## "alice: contact is deleted" - alice ##> "/contact member #team bob" - alice <## "contact for member #team bob prepared, use /invite member contact @bob to send invitation" - - alice ##> "/invite member contact @bob hi" + alice ##> "@#team bob hi" alice - <### [ "sent invitation to connect directly to member #team bob", + <### [ "member #team bob does not have associated contact, creating contact", + "contact for member #team bob is created", + "sent invitation to connect directly to member #team bob", WithTime "@bob hi" ] bob @@ -2736,10 +2750,10 @@ testMemberContactNoMessage = bob ##> "/d alice" bob <## "alice: contact is deleted" - alice ##> "/contact member #team bob" - alice <## "contact for member #team bob prepared, use /invite member contact @bob to send invitation" + alice ##> "/_create member contact #1 2" + alice <## "contact for member #team bob is created" - alice ##> "/invite member contact @bob" + alice ##> "/_invite member contact @4" -- cath is 3, new bob contact is 4 alice <## "sent invitation to connect directly to member #team bob" bob <## "#team alice is creating direct contact alice with you" concurrently_ @@ -2755,9 +2769,13 @@ testMemberContactProhibitedContactExists = \alice bob cath -> do createGroup3 "team" alice bob cath - alice ##> "/contact member #team bob" + alice ##> "/_create member contact #1 2" alice <## "bad chat command: member contact already exists" + alice ##> "@#team bob hi" + alice <# "@bob hi" + bob <# "alice> hi" + testMemberContactProhibitedRepeatInv :: HasCallStack => FilePath -> IO () testMemberContactProhibitedRepeatInv = testChat3 aliceProfile bobProfile cathProfile $ @@ -2769,15 +2787,15 @@ testMemberContactProhibitedRepeatInv = bob ##> "/d alice" bob <## "alice: contact is deleted" - alice ##> "/contact member #team bob" - alice <## "contact for member #team bob prepared, use /invite member contact @bob to send invitation" + alice ##> "/_create member contact #1 2" + alice <## "contact for member #team bob is created" - alice ##> "/invite member contact @bob hi" + alice ##> "/_invite member contact @4 text hi" -- cath is 3, new bob contact is 4 alice <### [ "sent invitation to connect directly to member #team bob", WithTime "@bob hi" ] - alice ##> "/invite member contact @bob hey" + alice ##> "/_invite member contact @4 text hey" alice <## "bad chat command: x.grp.direct.inv already sent" bob <### [ "#team alice is creating direct contact alice with you", @@ -2799,12 +2817,11 @@ testMemberContactInvitedConnectionReplaced tmp = do alice ##> "/d bob" alice <## "bob: contact is deleted" - alice ##> "/contact member #team bob" - alice <## "contact for member #team bob prepared, use /invite member contact @bob to send invitation" - - alice ##> "/invite member contact @bob hi" + alice ##> "@#team bob hi" alice - <### [ "sent invitation to connect directly to member #team bob", + <### [ "member #team bob does not have associated contact, creating contact", + "contact for member #team bob is created", + "sent invitation to connect directly to member #team bob", WithTime "@bob hi" ] bob @@ -2912,12 +2929,11 @@ testMemberContactIncognito = cath ##> ("/d " <> bobIncognito) cath <## (bobIncognito <> ": contact is deleted") - bob ##> ("/contact member #team " <> cathIncognito) - bob <## ("contact for member #team " <> cathIncognito <> " prepared, use /invite member contact @" <> cathIncognito <> " to send invitation") - - bob ##> ("/invite member contact @" <> cathIncognito <> " hi") + bob ##> ("@#team " <> cathIncognito <> " hi") bob - <### [ ConsoleString ("sent invitation to connect directly to member #team " <> cathIncognito), + <### [ ConsoleString ("member #team " <> cathIncognito <> " does not have associated contact, creating contact"), + ConsoleString ("contact for member #team " <> cathIncognito <> " is created"), + ConsoleString ("sent invitation to connect directly to member #team " <> cathIncognito), WithTime ("i @" <> cathIncognito <> " hi") ] cath