From 3c03c96a535705ade4028b745d63d0d99be718ca Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Wed, 20 Jul 2022 14:57:16 +0100 Subject: [PATCH] core: show contact and group member servers (#824) * core: show contact and group member servers (WIP) * contact and member information * update simplexmq --- cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- src/Simplex/Chat.hs | 28 +++++++++++++++++++----- src/Simplex/Chat/Controller.hs | 6 +++++ src/Simplex/Chat/Store.hs | 40 +++++++++++++++++++++++++++------- src/Simplex/Chat/View.hs | 23 ++++++++++++++++++- stack.yaml | 2 +- 7 files changed, 85 insertions(+), 18 deletions(-) diff --git a/cabal.project b/cabal.project index e81ee9dfe4..918229945d 100644 --- a/cabal.project +++ b/cabal.project @@ -5,7 +5,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 1d40bb97c2b2f9b143ca7c1982331cf531786000 + tag: d810db4eed04f33260e037507d0cb1f017fe6cae source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 2529cbc277..13e72cb54d 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."1d40bb97c2b2f9b143ca7c1982331cf531786000" = "1i55c00crg380sh0zig5k6viganccrrrh3bxkkhjisbr7lixvfbd"; + "https://github.com/simplex-chat/simplexmq.git"."d810db4eed04f33260e037507d0cb1f017fe6cae" = "0py3kaysqm24pa4rzhxr3l8ayz18rggh0vjnc7glzwf3hyv5wa05"; "https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp"; "https://github.com/simplex-chat/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj"; "https://github.com/zw3rk/android-support.git"."3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb" = "1r6jyxbim3dsvrmakqfyxbd6ms6miaghpbwyl0sr6dzwpgaprz97"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 3822fe42a4..35fea2f1bb 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -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, diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 1ade7cd5ef..d6add41403 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -143,6 +143,10 @@ data ChatCommand | APIListMembers GroupId | GetUserSMPServers | SetUserSMPServers [SMPServer] + | APIContactInfo ContactId + | APIGroupMemberInfo GroupId GroupMemberId + | ContactInfo ContactName + | GroupMemberInfo GroupName ContactName | ChatHelp HelpSection | Welcome | AddContact @@ -199,6 +203,8 @@ data ChatResponse | CRLastMessages {chatItems :: [AChatItem]} | CRApiParsedMarkdown {formattedText :: Maybe MarkdownList} | CRUserSMPServers {smpServers :: [SMPServer]} + | CRContactInfo {contact :: Contact, connectionStats :: ConnectionStats} + | CRGroupMemberInfo {groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats} | CRNewChatItem {chatItem :: AChatItem} | CRChatItemStatusUpdated {chatItem :: AChatItem} | CRChatItemUpdated {chatItem :: AChatItem} diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index a852f21f53..9bfef298cd 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -67,6 +67,7 @@ module Simplex.Chat.Store getGroupIdByName, getGroupMemberIdByName, getGroupInfoByName, + getGroupMember, getGroupMembers, deleteGroup, getUserGroups, @@ -1395,9 +1396,31 @@ toGroupInfo userContactId ((groupId, localDisplayName, displayName, fullName, im let membership = toGroupMember userContactId userMemberRow in GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName, fullName, image}, membership, createdAt, updatedAt} +getGroupMember :: DB.Connection -> User -> GroupId -> GroupMemberId -> ExceptT StoreError IO GroupMember +getGroupMember db user@User {userId} groupId groupMemberId = + ExceptT . firstRow (toContactMember user) (SEGroupMemberNotFound {groupId, groupMemberId}) $ + DB.query + db + [sql| + SELECT + m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, + m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name, p.image, + c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, + c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at + FROM group_members m + JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id + LEFT JOIN connections c ON c.connection_id = ( + SELECT max(cc.connection_id) + FROM connections cc + where cc.group_member_id = m.group_member_id + ) + WHERE m.group_id = ? AND m.group_member_id = ? AND m.user_id = ? + |] + (groupId, groupMemberId, userId) + getGroupMembers :: DB.Connection -> User -> GroupInfo -> IO [GroupMember] -getGroupMembers db User {userId, userContactId} GroupInfo {groupId} = do - map toContactMember +getGroupMembers db user@User {userId, userContactId} GroupInfo {groupId} = do + map (toContactMember user) <$> DB.query db [sql| @@ -1416,10 +1439,10 @@ getGroupMembers db User {userId, userContactId} GroupInfo {groupId} = do WHERE m.group_id = ? AND m.user_id = ? AND (m.contact_id IS NULL OR m.contact_id != ?) |] (groupId, userId, userContactId) - where - toContactMember :: (GroupMemberRow :. MaybeConnectionRow) -> GroupMember - toContactMember (memberRow :. connRow) = - (toGroupMember userContactId memberRow) {activeConn = toMaybeConnection connRow} + +toContactMember :: User -> (GroupMemberRow :. MaybeConnectionRow) -> GroupMember +toContactMember User {userContactId} (memberRow :. connRow) = + (toGroupMember userContactId memberRow) {activeConn = toMaybeConnection connRow} -- TODO no need to load all members to find the member who invited the user, -- instead of findFromContact there could be a query @@ -3106,7 +3129,7 @@ getGroupIdByName db User {userId} gName = getGroupMemberIdByName :: DB.Connection -> User -> GroupId -> ContactName -> ExceptT StoreError IO GroupMemberId getGroupMemberIdByName db User {userId} groupId groupMemberName = - ExceptT . firstRow fromOnly (SEGroupMemberNotFound 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) getChatItemIdByAgentMsgId :: DB.Connection -> Int64 -> AgentMsgId -> IO (Maybe ChatItemId) @@ -3798,7 +3821,8 @@ data StoreError | SEContactRequestNotFoundByName {contactName :: ContactName} | SEGroupNotFound {groupId :: GroupId} | SEGroupNotFoundByName {groupName :: GroupName} - | SEGroupMemberNotFound {groupId :: GroupId, groupMemberName :: ContactName} + | SEGroupMemberNameNotFound {groupId :: GroupId, groupMemberName :: ContactName} + | SEGroupMemberNotFound {groupId :: GroupId, groupMemberId :: GroupMemberId} | SEGroupWithoutUser | SEDuplicateGroupMember | SEGroupAlreadyJoined diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index f28e6bbe4e..d41d86801f 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -59,6 +59,8 @@ responseToView testView = \case CRApiChat chat -> if testView then testViewChat chat else [plain . bshow $ J.encode chat] CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft] CRUserSMPServers smpServers -> viewSMPServers smpServers testView + CRContactInfo ct cStats -> viewContactInfo ct cStats + CRGroupMemberInfo g m cStats -> viewGroupMemberInfo g m cStats CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item False CRLastMessages chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True) chatItems CRChatItemStatusUpdated _ -> [] @@ -483,7 +485,26 @@ viewSMPServers smpServers testView = customSMPServers = if null smpServers then "no custom SMP servers saved" - else plain $ intercalate ", " (map (B.unpack . strEncode) smpServers) + else viewServers smpServers + +viewContactInfo :: Contact -> ConnectionStats -> [StyledString] +viewContactInfo Contact {contactId} stats = + ["contact ID: " <> sShow contactId] <> viewConnectionStats stats + +viewGroupMemberInfo :: GroupInfo -> GroupMember -> Maybe ConnectionStats -> [StyledString] +viewGroupMemberInfo GroupInfo {groupId} GroupMember {groupMemberId} stats = + [ "group ID: " <> sShow groupId, + "member ID: " <> sShow groupMemberId + ] + <> maybe ["member not connected"] viewConnectionStats stats + +viewConnectionStats :: ConnectionStats -> [StyledString] +viewConnectionStats ConnectionStats {rcvServers, sndServers} = + ["receiving messages via: " <> viewServers rcvServers | not $ null rcvServers] + <> ["sending messages via: " <> viewServers sndServers | not $ null sndServers] + +viewServers :: [SMPServer] -> StyledString +viewServers = plain . intercalate ", " . map (B.unpack . strEncode) viewUserProfileUpdated :: Profile -> Profile -> [StyledString] viewUserProfileUpdated Profile {displayName = n, fullName, image} Profile {displayName = n', fullName = fullName', image = image'} diff --git a/stack.yaml b/stack.yaml index 5cce9923c3..c89dace009 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,7 +49,7 @@ extra-deps: # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561 # - ../simplexmq - github: simplex-chat/simplexmq - commit: 1d40bb97c2b2f9b143ca7c1982331cf531786000 + commit: d810db4eed04f33260e037507d0cb1f017fe6cae # - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977 - github: simplex-chat/aeson commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7