diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index cde8bcf0e..997998393 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1219,7 +1219,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage XFile fInv -> processFileInvitation' ct fInv msg msgMeta XFileCancel sharedMsgId -> xFileCancel ct sharedMsgId msgMeta XInfo p -> xInfo ct p - XGrpInv gInv -> processGroupInvitation ct gInv + XGrpInv gInv -> processGroupInvitation ct gInv msg msgMeta XInfoProbe probe -> xInfoProbe ct probe XInfoProbeCheck probeHash -> xInfoProbeCheck ct probeHash XInfoProbeOk probe -> xInfoProbeOk ct probe @@ -1709,13 +1709,16 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage checkIntegrityCreateItem (CDGroupRcv gInfo m) msgMeta toView . CRNewChatItem $ AChatItem SCTGroup SMDRcv (GroupChat gInfo) ci - processGroupInvitation :: Contact -> GroupInvitation -> m () - processGroupInvitation ct@Contact {localDisplayName = c} inv@(GroupInvitation (MemberIdRole fromMemId fromRole) (MemberIdRole memId memRole) _ _) = do + processGroupInvitation :: Contact -> GroupInvitation -> RcvMessage -> MsgMeta -> m () + processGroupInvitation ct@Contact {localDisplayName = c} inv@(GroupInvitation (MemberIdRole fromMemId fromRole) (MemberIdRole memId memRole) _ _) msg msgMeta = do + checkIntegrityCreateItem (CDDirectRcv ct) msgMeta when (fromRole < GRAdmin || fromRole < memRole) $ throwChatError (CEGroupContactRole c) when (fromMemId == memId) $ throwChatError CEGroupDuplicateMemberId - gInfo@GroupInfo {localDisplayName = gName} <- withStore $ \db -> createGroupInvitation db user ct inv - toView $ CRReceivedGroupInvitation gInfo ct memRole - showToast ("#" <> gName <> " " <> c <> "> ") "invited you to join the group" + GroupInfo {groupId, localDisplayName, groupProfile} <- withStore $ \db -> createGroupInvitation db user ct inv + let content = CIGroupInvitation (CIGroupInfo {groupId, localDisplayName, groupProfile}) memRole + ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta content Nothing + toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci + showToast ("#" <> localDisplayName <> " " <> c <> "> ") "invited you to join the group" checkIntegrityCreateItem :: forall c. ChatTypeI c => ChatDirection c 'MDRcv -> MsgMeta -> m () checkIntegrityCreateItem cd MsgMeta {integrity, broker = (_, brokerTs)} = case integrity of diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index d9b6bc3f8..7f920c904 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -259,7 +259,6 @@ data ChatResponse | CRContactSubError {contact :: Contact, chatError :: ChatError} | CRContactSubSummary {contactSubscriptions :: [ContactSubStatus]} | CRGroupInvitation {groupInfo :: GroupInfo} - | CRReceivedGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole} | CRUserJoinedGroup {groupInfo :: GroupInfo} | CRJoinedGroupMember {groupInfo :: GroupInfo, member :: GroupMember} | CRJoinedGroupMemberConnecting {groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember} diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index e3bad5659..dc395b72d 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -495,6 +495,10 @@ ciDeleteModeToText = \case CIDMBroadcast -> "this item is deleted (broadcast)" CIDMInternal -> "this item is deleted (internal)" +ciGroupInvitationToText :: CIGroupInfo -> GroupMemberRole -> Text +ciGroupInvitationToText CIGroupInfo {groupProfile = GroupProfile {displayName, fullName}} role = + "invitation to join group " <> displayName <> optionalFullName displayName fullName <> " as " <> (safeDecodeUtf8 . strEncode $ role) + -- This type is used both in API and in DB, so we use different JSON encodings for the database and for the API data CIContent (d :: MsgDirection) where CISndMsgContent :: MsgContent -> CIContent 'MDSnd @@ -504,9 +508,21 @@ data CIContent (d :: MsgDirection) where CISndCall :: CICallStatus -> Int -> CIContent 'MDSnd CIRcvCall :: CICallStatus -> Int -> CIContent 'MDRcv CIRcvIntegrityError :: MsgErrorType -> CIContent 'MDRcv + CIGroupInvitation :: CIGroupInfo -> GroupMemberRole -> CIContent 'MDRcv deriving instance Show (CIContent d) +data CIGroupInfo = CIGroupInfo + { groupId :: GroupId, + localDisplayName :: GroupName, + groupProfile :: GroupProfile + } + deriving (Eq, Show, Generic, FromJSON) + +instance ToJSON CIGroupInfo where + toJSON = J.genericToJSON J.defaultOptions + toEncoding = J.genericToEncoding J.defaultOptions + ciContentToText :: CIContent d -> Text ciContentToText = \case CISndMsgContent mc -> msgContentText mc @@ -516,6 +532,7 @@ ciContentToText = \case CISndCall status duration -> "outgoing call: " <> ciCallInfoText status duration CIRcvCall status duration -> "incoming call: " <> ciCallInfoText status duration CIRcvIntegrityError err -> msgIntegrityError err + CIGroupInvitation groupInfo memberRole -> ciGroupInvitationToText groupInfo memberRole msgIntegrityError :: MsgErrorType -> Text msgIntegrityError = \case @@ -560,6 +577,7 @@ data JSONCIContent | JCISndCall {status :: CICallStatus, duration :: Int} -- duration in seconds | JCIRcvCall {status :: CICallStatus, duration :: Int} | JCIRcvIntegrityError {msgError :: MsgErrorType} + | JCIGroupInvitation {groupInfo :: CIGroupInfo, memberRole :: GroupMemberRole} deriving (Generic) instance FromJSON JSONCIContent where @@ -578,6 +596,7 @@ jsonCIContent = \case CISndCall status duration -> JCISndCall {status, duration} CIRcvCall status duration -> JCIRcvCall {status, duration} CIRcvIntegrityError err -> JCIRcvIntegrityError err + CIGroupInvitation groupInfo memberRole -> JCIGroupInvitation {groupInfo, memberRole} aciContentJSON :: JSONCIContent -> ACIContent aciContentJSON = \case @@ -588,6 +607,7 @@ aciContentJSON = \case JCISndCall {status, duration} -> ACIContent SMDSnd $ CISndCall status duration JCIRcvCall {status, duration} -> ACIContent SMDRcv $ CIRcvCall status duration JCIRcvIntegrityError err -> ACIContent SMDRcv $ CIRcvIntegrityError err + JCIGroupInvitation {groupInfo, memberRole} -> ACIContent SMDRcv $ CIGroupInvitation groupInfo memberRole -- platform independent data DBJSONCIContent @@ -598,6 +618,7 @@ data DBJSONCIContent | DBJCISndCall {status :: CICallStatus, duration :: Int} | DBJCIRcvCall {status :: CICallStatus, duration :: Int} | DBJCIRcvIntegrityError {msgError :: MsgErrorType} + | DBJCIGroupInvitation {groupInfo :: CIGroupInfo, memberRole :: GroupMemberRole} deriving (Generic) instance FromJSON DBJSONCIContent where @@ -616,6 +637,7 @@ dbJsonCIContent = \case CISndCall status duration -> DBJCISndCall {status, duration} CIRcvCall status duration -> DBJCIRcvCall {status, duration} CIRcvIntegrityError err -> DBJCIRcvIntegrityError err + CIGroupInvitation groupInfo memberRole -> DBJCIGroupInvitation {groupInfo, memberRole} aciContentDBJSON :: DBJSONCIContent -> ACIContent aciContentDBJSON = \case @@ -626,6 +648,7 @@ aciContentDBJSON = \case DBJCISndCall {status, duration} -> ACIContent SMDSnd $ CISndCall status duration DBJCIRcvCall {status, duration} -> ACIContent SMDRcv $ CIRcvCall status duration DBJCIRcvIntegrityError err -> ACIContent SMDRcv $ CIRcvIntegrityError err + DBJCIGroupInvitation {groupInfo, memberRole} -> ACIContent SMDRcv $ CIGroupInvitation groupInfo memberRole data CICallStatus = CISCallPending diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 158b1d720..97fdbc8d0 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -23,6 +23,7 @@ import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Int (Int64) import Data.Text (Text) +import qualified Data.Text as T import Data.Time.Clock (UTCTime) import Data.Typeable import Database.SQLite.Simple (ResultError (..), SQLData (..)) @@ -166,6 +167,11 @@ type ContactName = Text type GroupName = Text +optionalFullName :: ContactName -> Text -> Text +optionalFullName localDisplayName fullName + | T.null fullName || localDisplayName == fullName = "" + | otherwise = " (" <> fullName <> ")" + data Group = Group {groupInfo :: GroupInfo, members :: [GroupMember]} deriving (Eq, Show, Generic) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 42c3d0324..be2248ce9 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -133,7 +133,6 @@ responseToView testView = \case (errors, subscribed) = partition (isJust . contactError) summary CRGroupInvitation GroupInfo {localDisplayName = ldn, groupProfile = GroupProfile {fullName}} -> [groupInvitation ldn fullName] - CRReceivedGroupInvitation g c role -> viewReceivedGroupInvitation g c role CRUserJoinedGroup g -> [ttyGroup' g <> ": you joined the group"] CRJoinedGroupMember g m -> [ttyGroup' g <> ": " <> ttyMember m <> " joined the group "] CRJoinedGroupMemberConnecting g host m -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"] @@ -214,6 +213,7 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case cha CIRcvDeleted _ -> [] CIRcvCall {} -> [] CIRcvIntegrityError err -> viewRcvIntegrityError from err meta + CIGroupInvitation g role -> viewReceivedGroupInvitation g c role where from = ttyFromContact' c where @@ -230,6 +230,7 @@ viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case cha CIRcvDeleted _ -> [] CIRcvCall {} -> [] CIRcvIntegrityError err -> viewRcvIntegrityError from err meta + CIGroupInvitation {} -> [] -- should be not possible where from = ttyFromGroup' g m where @@ -386,10 +387,10 @@ viewCannotResendInvitation GroupInfo {localDisplayName = gn} c = "to re-send invitation: " <> highlight ("/rm " <> gn <> " " <> c) <> ", " <> highlight ("/a " <> gn <> " " <> c) ] -viewReceivedGroupInvitation :: GroupInfo -> Contact -> GroupMemberRole -> [StyledString] -viewReceivedGroupInvitation g c role = - [ ttyFullGroup g <> ": " <> ttyContact' c <> " invites you to join the group as " <> plain (strEncode role), - "use " <> highlight ("/j " <> groupName' g) <> " to accept" +viewReceivedGroupInvitation :: CIGroupInfo -> Contact -> GroupMemberRole -> [StyledString] +viewReceivedGroupInvitation CIGroupInfo {localDisplayName = g, groupProfile = GroupProfile {fullName}} c role = + [ ttyGroup g <> optFullName g fullName <> ": " <> ttyContact' c <> " invites you to join the group as " <> plain (strEncode role), + "use " <> highlight ("/j " <> g) <> " to accept" ] groupPreserved :: GroupInfo -> [StyledString] @@ -877,9 +878,7 @@ ttyFilePath :: FilePath -> StyledString ttyFilePath = plain optFullName :: ContactName -> Text -> StyledString -optFullName localDisplayName fullName - | T.null fullName || localDisplayName == fullName = "" - | otherwise = plain (" (" <> fullName <> ")") +optFullName localDisplayName fullName = plain $ optionalFullName localDisplayName fullName highlight :: StyledFormat a => a -> StyledString highlight = styled $ colored Cyan diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 7a9f0de3b..afcdadab4 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -459,9 +459,9 @@ testGroup = versionTestMatrix3 runTestGroup alice #$> ("/_get chat #1 count=100", chat, [(1, "hello"), (0, "hi there"), (0, "hey team")]) alice #$> ("/_get chat #1 after=1 count=100", chat, [(0, "hi there"), (0, "hey team")]) alice #$> ("/_get chat #1 before=3 count=100", chat, [(1, "hello"), (0, "hi there")]) - bob @@@ [("@cath", "hey"), ("#team", "hey team"), ("@alice", "")] + bob @@@ [("@cath", "hey"), ("#team", "hey team"), ("@alice", "invitation to join group team as admin")] bob #$> ("/_get chat #1 count=100", chat, [(0, "hello"), (1, "hi there"), (0, "hey team")]) - cath @@@ [("@bob", "hey"), ("#team", "hey team"), ("@alice", "")] + cath @@@ [("@bob", "hey"), ("#team", "hey team"), ("@alice", "invitation to join group team as admin")] cath #$> ("/_get chat #1 count=100", chat, [(0, "hello"), (0, "hi there"), (1, "hey team")]) alice #$> ("/_read chat #1 from=1 to=100", id, "ok") bob #$> ("/_read chat #1 from=1 to=100", id, "ok") @@ -942,7 +942,7 @@ testGroupMessageDelete = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do createGroup3 "team" alice bob cath - -- msg id 1 + -- alice: msg id 1, bob, cath: msg id 2 (1 is group invitation) alice #> "#team hello!" concurrently_ (bob <# "#team alice> hello!") @@ -958,7 +958,7 @@ testGroupMessageDelete = alice #$> ("/_send #1 json {\"quotedItemId\": 1, \"msgContent\": {\"type\": \"text\", \"text\": \"quoting deleted message\"}}", id, "cannot reply to this message") threadDelay 1000000 - -- msg id 2 + -- alice: msg id 2, bob, cath: msg id 3 bob `send` "> #team @alice (hello) hi alic" bob <# "#team > alice hello!" bob <## " hi alic" @@ -987,7 +987,7 @@ testGroupMessageDelete = bob #$> ("/_get chat #1 count=100", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((1, "hi alic"), Just (0, "hello!"))]) cath #$> ("/_get chat #1 count=100", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((0, "hi alic"), Just (0, "hello!"))]) - bob #$> ("/_update item #1 2 text hi alice", id, "message updated") + bob #$> ("/_update item #1 3 text hi alice", id, "message updated") concurrently_ (alice <# "#team bob> [edited] hi alice") ( do @@ -1000,13 +1000,13 @@ testGroupMessageDelete = cath #$> ("/_get chat #1 count=100", chat', [((0, "this item is deleted (broadcast)"), Nothing), ((0, "hi alice"), Just (0, "hello!"))]) threadDelay 1000000 - -- msg id 3 + -- alice: msg id 3, bob, cath: msg id 4 cath #> "#team how are you?" concurrently_ (alice <# "#team cath> how are you?") (bob <# "#team cath> how are you?") - cath #$> ("/_delete item #1 3 broadcast", id, "message deleted") + cath #$> ("/_delete item #1 4 broadcast", id, "message deleted") concurrently_ (alice <# "#team cath> [deleted] how are you?") (bob <# "#team cath> [deleted] how are you?") @@ -1698,9 +1698,9 @@ testGroupSendImageWithTextAndQuote = alice #$> ("/_get chat #1 count=100", chat'', [((0, "hi team"), Nothing, Nothing), ((1, "hey bob"), Just (0, "hi team"), Just "./tests/fixtures/test.jpg")]) alice @@@ [("#team", "hey bob"), ("@bob", ""), ("@cath", "")] bob #$> ("/_get chat #1 count=100", chat'', [((1, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi team"), Just "./tests/tmp/test.jpg")]) - bob @@@ [("#team", "hey bob"), ("@alice", ""), ("@cath", "")] + bob @@@ [("#team", "hey bob"), ("@cath",""), ("@alice","invitation to join group team as admin")] cath #$> ("/_get chat #1 count=100", chat'', [((0, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (0, "hi team"), Just "./tests/tmp/test_1.jpg")]) - cath @@@ [("#team", "hey bob"), ("@alice", ""), ("@bob", "")] + cath @@@ [("#team", "hey bob"), ("@bob",""), ("@alice","invitation to join group team as admin")] testUserContactLink :: Spec testUserContactLink = versionTestMatrix3 $ \alice bob cath -> do