blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

core chat groups protocol for adding members (#78)

Browse Source 
* add category and local display name to group members, extend member status

* additional chat commands, serialization

* parse all chat messages

* draft group protocol implementation

* group protocol: connect new member to existing members (TODO fix race condition with contact connection)

* send/receive group messages (race condition still there - the 3rd member cannot send either group or direct messages to the 2nd member - CONN SIMPLEX)

* send x.grp.mem.info and x.ok in SMP confirmation

* fix host user adding new member, update simplexmq to fix sqlite concurrency, remove logs, make # optional in chat commands

* more precise view messages about members joining and connecting

* track connection status; only send messages to active members (TODO change to current members); group name autocomplete after joining the group

* track via which group the contact was added; show only one message when a contact fully connected; group tests

* test sending messages to the new direct contacts created via the group

* update simplexmq to include .cabal file

* remove unused import
This commit is contained in:
Evgeny Poberezkin
2021-07-24 10:26:28 +01:00
committed by GitHub
parent 94f89ed8f7
commit 189cd7e09d
14 changed files with 1262 additions and 347 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/View.hs
+82 -34
View File
@@ -13,12 +13,16 @@ module Simplex.Chat.View
showContactConnected,
showContactDisconnected,
showReceivedMessage,
showReceivedGroupMessage,
showSentMessage,
showSentGroupMessage,
showGroupCreated,
showSentGroupInvitation,
showReceivedGroupInvitation,
showConnectedGroupMember,
showUserConnectedToGroup,
showJoinedGroupMember,
showUserJoinedGroup,
showJoinedGroupMemberConnecting,
showConnectedToGroupMember,
safeDecodeUtf8,
)
where
@@ -26,7 +30,7 @@ where
import Control.Monad.IO.Unlift
import Control.Monad.Reader
import Data.ByteString.Char8 (ByteString)
import Data.Composition ((.:))
import Data.Composition ((.:), (.:.))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (DiffTime, UTCTime)
@@ -60,10 +64,22 @@ showContactDisconnected :: ChatReader m => ContactName -> m ()
showContactDisconnected = printToView . contactDisconnected
showReceivedMessage :: ChatReader m => ContactName -> UTCTime -> Text -> MsgIntegrity -> m ()
showReceivedMessage c utcTime msg mOk = printToView =<< liftIO (receivedMessage c utcTime msg mOk)
showReceivedMessage = showReceivedMessage_ . ttyFromContact
showReceivedGroupMessage :: ChatReader m => GroupName -> ContactName -> UTCTime -> Text -> MsgIntegrity -> m ()
showReceivedGroupMessage = showReceivedMessage_ .: ttyFromGroup
showReceivedMessage_ :: ChatReader m => StyledString -> UTCTime -> Text -> MsgIntegrity -> m ()
showReceivedMessage_ from utcTime msg mOk = printToView =<< liftIO (receivedMessage from utcTime msg mOk)
showSentMessage :: ChatReader m => ContactName -> ByteString -> m ()
showSentMessage c msg = printToView =<< liftIO (sentMessage c msg)
showSentMessage = showSentMessage_ . ttyToContact
showSentGroupMessage :: ChatReader m => GroupName -> ByteString -> m ()
showSentGroupMessage = showSentMessage_ . ttyToGroup
showSentMessage_ :: ChatReader m => StyledString -> ByteString -> m ()
showSentMessage_ to msg = printToView =<< liftIO (sentMessage to msg)
showGroupCreated :: ChatReader m => Group -> m ()
showGroupCreated = printToView . groupCreated
@@ -71,14 +87,20 @@ showGroupCreated = printToView . groupCreated
showSentGroupInvitation :: ChatReader m => Group -> ContactName -> m ()
showSentGroupInvitation = printToView .: sentGroupInvitation
showReceivedGroupInvitation :: ChatReader m => Group -> ContactName -> m ()
showReceivedGroupInvitation = printToView .: receivedGroupInvitation
showReceivedGroupInvitation :: ChatReader m => Group -> ContactName -> GroupMemberRole -> m ()
showReceivedGroupInvitation = printToView .:. receivedGroupInvitation
showConnectedGroupMember :: ChatReader m => GroupName -> ContactName -> m ()
showConnectedGroupMember = printToView .: connectedGroupMember
showJoinedGroupMember :: ChatReader m => GroupName -> GroupMember -> m ()
showJoinedGroupMember = printToView .: joinedGroupMember
showUserConnectedToGroup :: ChatReader m => GroupName -> m ()
showUserConnectedToGroup = printToView . userConnectedToGroup
showUserJoinedGroup :: ChatReader m => GroupName -> m ()
showUserJoinedGroup = printToView . userJoinedGroup
showJoinedGroupMemberConnecting :: ChatReader m => GroupName -> GroupMember -> GroupMember -> m ()
showJoinedGroupMemberConnecting = printToView .:. joinedGroupMemberConnecting
showConnectedToGroupMember :: ChatReader m => GroupName -> GroupMember -> m ()
showConnectedToGroupMember = printToView .: connectedToGroupMember
invitation :: SMPQueueInfo -> [StyledString]
invitation qInfo =
@@ -101,28 +123,40 @@ contactDisconnected c = ["disconnected from " <> ttyContact c <> " - restart cha
groupCreated :: Group -> [StyledString]
groupCreated g@Group {localDisplayName} =
[ "group " <> ttyFullGroup g <> " is created",
"use " <> highlight ("/a #" <> localDisplayName <> " <name>") <> " to add members"
"use " <> highlight ("/a " <> localDisplayName <> " <name>") <> " to add members"
]
sentGroupInvitation :: Group -> ContactName -> [StyledString]
sentGroupInvitation g c = ["invitation to join the group " <> ttyFullGroup g <> " sent to " <> ttyContact c]
receivedGroupInvitation :: Group -> ContactName -> [StyledString]
receivedGroupInvitation g@Group {localDisplayName} c =
[ ttyContact c <> " invites you to join the group " <> ttyFullGroup g,
"use " <> highlight ("/j #" <> localDisplayName) <> " to accept"
receivedGroupInvitation :: Group -> ContactName -> GroupMemberRole -> [StyledString]
receivedGroupInvitation g@Group {localDisplayName} c role =
[ ttyFullGroup g <> ": " <> ttyContact c <> " invites you to join the group as " <> plain (serializeMemberRole role),
"use " <> highlight ("/j " <> localDisplayName) <> " to accept"
]
connectedGroupMember :: GroupName -> ContactName -> [StyledString]
connectedGroupMember g c = [ttyContact c <> " joined the group " <> ttyGroup g]
joinedGroupMember :: GroupName -> GroupMember -> [StyledString]
joinedGroupMember g m = [ttyGroup g <> ": " <> ttyMember m <> " joined the group "]
userConnectedToGroup :: GroupName -> [StyledString]
userConnectedToGroup g = ["you joined the group " <> ttyGroup g]
userJoinedGroup :: GroupName -> [StyledString]
userJoinedGroup g = [ttyGroup g <> ": you joined the group"]
receivedMessage :: ContactName -> UTCTime -> Text -> MsgIntegrity -> IO [StyledString]
receivedMessage c utcTime msg mOk = do
joinedGroupMemberConnecting :: GroupName -> GroupMember -> GroupMember -> [StyledString]
joinedGroupMemberConnecting g host m = [ttyGroup g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
connectedToGroupMember :: GroupName -> GroupMember -> [StyledString]
connectedToGroupMember g m = [ttyGroup g <> ": " <> connectedMember m <> " is connected"]
connectedMember :: GroupMember -> StyledString
connectedMember m = case memberCategory m of
GCPreMember -> "member " <> ttyFullMember m
GCPostMember -> "new member " <> ttyMember m -- without fullName as as it was shown in joinedGroupMemberConnecting
_ -> "member " <> ttyMember m -- these case is not used
receivedMessage :: StyledString -> UTCTime -> Text -> MsgIntegrity -> IO [StyledString]
receivedMessage from utcTime msg mOk = do
t <- formatUTCTime <$> getCurrentTimeZone <*> getZonedTime
pure $ prependFirst (t <> " " <> ttyFromContact c) (msgPlain msg) ++ showIntegrity mOk
pure $ prependFirst (t <> " " <> from) (msgPlain msg) ++ showIntegrity mOk
where
formatUTCTime :: TimeZone -> ZonedTime -> StyledString
formatUTCTime localTz currentTime =
@@ -145,10 +179,10 @@ receivedMessage c utcTime msg mOk = do
msgError :: String -> [StyledString]
msgError s = [styled (Colored Red) s]
sentMessage :: ContactName -> ByteString -> IO [StyledString]
sentMessage c msg = do
sentMessage :: StyledString -> ByteString -> IO [StyledString]
sentMessage to msg = do
time <- formatTime defaultTimeLocale "%H:%M" <$> getZonedTime
pure $ prependFirst (styleTime time <> " " <> ttyToContact c) (msgPlain $ safeDecodeUtf8 msg)
pure $ prependFirst (styleTime time <> " " <> to) (msgPlain $ safeDecodeUtf8 msg)
prependFirst :: StyledString -> [StyledString] -> [StyledString]
prependFirst s [] = [s]
@@ -162,9 +196,10 @@ chatError = \case
ChatError err -> case err of
CEGroupDuplicateMember c -> ["contact " <> ttyContact c <> " is already in the group"]
CEGroupDuplicateMemberId -> ["cannot add member - duplicate member ID"]
CEGroupRole -> ["insufficient role for this group command"]
CEGroupUserRole -> ["you have insufficient permissions for this group command"]
CEGroupContactRole c -> ["contact " <> ttyContact c <> " has insufficient permissions for this group action"]
CEGroupNotJoined g -> ["you did not join this group, use " <> highlight ("/join #" <> g)]
CEGroupMemberNotReady -> ["you cannot invite other members yet, try later"]
CEGroupMemberNotActive -> ["you cannot invite other members yet, try later"]
CEGroupInternal s -> ["chat group bug: " <> plain s]
-- e -> ["chat error: " <> plain (show e)]
ChatErrorStore err -> case err of
@@ -191,7 +226,17 @@ ttyContact = styled (Colored Green)
ttyFullContact :: Contact -> StyledString
ttyFullContact Contact {localDisplayName, profile = Profile {fullName}} =
ttyContact localDisplayName <> optFullName localDisplayName fullName
ttyFullName localDisplayName fullName
ttyMember :: GroupMember -> StyledString
ttyMember GroupMember {localDisplayName} = ttyContact localDisplayName
ttyFullMember :: GroupMember -> StyledString
ttyFullMember GroupMember {localDisplayName, memberProfile = Profile {fullName}} =
ttyFullName localDisplayName fullName
ttyFullName :: ContactName -> Text -> StyledString
ttyFullName c fullName = ttyContact c <> optFullName c fullName
ttyToContact :: ContactName -> StyledString
ttyToContact c = styled (Colored Cyan) $ "@" <> c <> " "
@@ -206,9 +251,15 @@ ttyFullGroup :: Group -> StyledString
ttyFullGroup Group {localDisplayName, groupProfile = GroupProfile {fullName}} =
ttyGroup localDisplayName <> optFullName localDisplayName fullName
optFullName :: Text -> Text -> StyledString
ttyFromGroup :: GroupName -> ContactName -> StyledString
ttyFromGroup g c = styled (Colored Yellow) $ "#" <> g <> " " <> c <> "> "
ttyToGroup :: GroupName -> StyledString
ttyToGroup g = styled (Colored Cyan) $ "#" <> g <> " "
optFullName :: ContactName -> Text -> StyledString
optFullName localDisplayName fullName
| localDisplayName == fullName = ""
| T.null fullName || localDisplayName == fullName = ""
| otherwise = plain (" (" <> fullName <> ")")
highlight :: StyledFormat a => a -> StyledString
@@ -217,8 +268,5 @@ highlight = styled (Colored Cyan)
highlight' :: String -> StyledString
highlight' = highlight
-- ttyFromGroup :: Group -> Contact -> StyledString
-- ttyFromGroup (Group g) (Contact a) = styled (Colored Yellow) $ "#" <> g <> " " <> a <> "> "
styleTime :: String -> StyledString
styleTime = Styled [SetColor Foreground Vivid Black]