IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: terminal api to send message to / connect with member contact (#3065)

Browse Source 
* core: terminal api to send message to / connect with member contact

* style

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
spaced4ndy 2023-09-16 21:30:20 +04:00 committed by GitHub
parent 0e5b16498a
commit 04770fb30d
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
5 changed files with 132 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
src/Simplex/Chat.hs
View File

@ -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),

5
src/Simplex/Chat/Controller.hs
View File

@ -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}

24
src/Simplex/Chat/Store/Groups.hs
View File

@ -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 <-

15
src/Simplex/Chat/View.hs
View File

@ -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 <> " <message>") <> " 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 <invitation_link_above>"
]
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 <> " <your message>")
_ -> ""
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]

78
tests/ChatTests/Groups.hs
View File

@ -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 </)
alice `send` "@bob hey"
alice
<### [ WithTime "@bob hey",
"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"
]
bob
<### [ "#team alice is creating direct contact alice with you",
WithTime "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 <your message>"
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 </)
@ -2706,12 +2721,11 @@ testMemberContactMessage =
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 <message> 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 <message> 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 <message> 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 <message> 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 <> " <message> 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