core: show contact and group member servers (#824)

* core: show contact and group member servers (WIP)

* contact and member information

* update simplexmq
This commit is contained in:
Evgeny Poberezkin
2022-07-20 14:57:16 +01:00
committed by GitHub
parent 5e71deaa3d
commit 3c03c96a53
7 changed files with 85 additions and 18 deletions
+22 -6
View File
@@ -591,6 +591,18 @@ processChatCommand = \case
ChatConfig {defaultServers = InitialAgentServers {smp = defaultSMPServers}} <- asks config
withAgent $ \a -> setSMPServers a (fromMaybe defaultSMPServers (nonEmpty smpServers))
pure CRCmdOk
APIContactInfo contactId -> withUser $ \User {userId} -> do
ct <- withStore $ \db -> getContact db userId contactId
CRContactInfo ct <$> withAgent (`getConnectionServers` contactConnId ct)
APIGroupMemberInfo gId gMemberId -> withUser $ \user -> do
(g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId
CRGroupMemberInfo g m <$> mapM (withAgent . flip getConnectionServers) (memberConnId m)
ContactInfo cName -> withUser $ \User {userId} -> do
contactId <- withStore $ \db -> getContactIdByName db userId cName
processChatCommand $ APIContactInfo contactId
GroupMemberInfo gName mName -> withUser $ \user -> do
(gId, mId) <- withStore $ \db -> getGroupIdByName db user gName >>= \gId -> (gId,) <$> getGroupMemberIdByName db user gId mName
processChatCommand $ APIGroupMemberInfo gId mId
ChatHelp section -> pure $ CRChatHelp section
Welcome -> withUser $ pure . CRWelcome
AddContact -> withUser $ \User {userId} -> withChatLock . procCmd $ do
@@ -1245,7 +1257,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
processDirectMessage :: ACommand 'Agent -> Connection -> Maybe Contact -> m ()
processDirectMessage agentMsg conn@Connection {connId, viaUserContactLink} = \case
Nothing -> case agentMsg of
CONF confId connInfo -> do
CONF confId _ connInfo -> do
saveConnInfo conn connInfo
allowAgentConnection conn confId $ XInfo profile
INFO connInfo ->
@@ -1284,7 +1296,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
XCallEnd callId -> xCallEnd ct callId msg msgMeta
_ -> pure ()
ackMsgDeliveryEvent conn msgMeta
CONF confId connInfo -> do
CONF confId _ connInfo -> do
-- confirming direct connection with a member
ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
case chatMsgEvent of
@@ -1347,7 +1359,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
processGroupMessage :: ACommand 'Agent -> Connection -> GroupInfo -> GroupMember -> m ()
processGroupMessage agentMsg conn gInfo@GroupInfo {groupId, localDisplayName = gName, membership} m = case agentMsg of
CONF confId connInfo -> do
CONF confId _ connInfo -> do
ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
case memberCategory m of
GCInviteeMember ->
@@ -1443,7 +1455,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
case agentMsg of
-- SMP CONF for SndFileConnection happens for direct file protocol
-- when recipient of the file "joins" connection created by the sender
CONF confId connInfo -> do
CONF confId _ connInfo -> do
ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
case chatMsgEvent of
-- TODO save XFileAcpt message
@@ -1481,7 +1493,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
-- SMP CONF for RcvFileConnection happens for group file protocol
-- when sender of the file "joins" connection created by the recipient
-- (sender doesn't create connections for all group members)
CONF confId connInfo -> do
CONF confId _ connInfo -> do
ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
case chatMsgEvent of
XOk -> allowAgentConnection conn confId XOk
@@ -1532,7 +1544,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
processUserContactRequest :: ACommand 'Agent -> Connection -> UserContact -> m ()
processUserContactRequest agentMsg _conn UserContact {userContactLinkId} = case agentMsg of
REQ invId connInfo -> do
REQ invId _ connInfo -> do
ChatMessage {chatMsgEvent} <- liftEither $ parseChatMessage connInfo
case chatMsgEvent of
XContact p xContactId_ -> profileContactRequest invId p xContactId_
@@ -2435,6 +2447,10 @@ chatCommandP =
"/smp_servers default" $> SetUserSMPServers [],
"/smp_servers " *> (SetUserSMPServers <$> smpServersP),
"/smp_servers" $> GetUserSMPServers,
"/_info #" *> (APIGroupMemberInfo <$> A.decimal <* A.space <*> A.decimal),
"/_info @" *> (APIContactInfo <$> A.decimal),
("/info #" <|> "/i #") *> (GroupMemberInfo <$> displayName <* A.space <* optional (A.char '@') <*> displayName),
("/info @" <|> "/info " <|> "/i @" <|> "/i ") *> (ContactInfo <$> displayName),
("/help files" <|> "/help file" <|> "/hf") $> ChatHelp HSFiles,
("/help groups" <|> "/help group" <|> "/hg") $> ChatHelp HSGroups,
("/help address" <|> "/ha") $> ChatHelp HSMyAddress,