diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 54d277d26d..ba49a95b45 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -569,6 +569,7 @@ test-suite simplex-chat-test ChatTests.ChatList ChatTests.Direct ChatTests.Files + ChatTests.Forward ChatTests.Groups ChatTests.Local ChatTests.Profiles diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 60907ec3f6..1feaf012a7 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -843,7 +843,7 @@ processChatCommand' vr = \case cci <- getDirectChatItem db user fromChatId itemId pure (ct, cci) mc <- forwardMC ci - file <- forwardCryptoFile ci + file <- forwardCryptoFile ci `catchChatError` \_ -> pure Nothing let ciff = forwardCIFF ci $ CIFFContact (forwardName ct) fromChatId pure (ComposedMessage file Nothing mc, ciff) where @@ -857,7 +857,7 @@ processChatCommand' vr = \case cci <- getGroupChatItem db user fromChatId itemId pure (gInfo, cci) mc <- forwardMC ci - file <- forwardCryptoFile ci + file <- forwardCryptoFile ci `catchChatError` \_ -> pure Nothing let ciff = forwardCIFF ci $ CIFFGroup (forwardName gInfo) fromChatId pure (ComposedMessage file Nothing mc, ciff) where @@ -866,7 +866,7 @@ processChatCommand' vr = \case CTLocal -> do (CChatItem _ ci) <- withStore $ \db -> getLocalChatItem db user fromChatId itemId mc <- forwardMC ci - file <- forwardCryptoFile ci + file <- forwardCryptoFile ci `catchChatError` \_ -> pure Nothing let ciff = forwardCIFF ci $ CIFFNoteFolder "notes" fromChatId pure (ComposedMessage file Nothing mc, ciff) CTContactRequest -> throwChatError $ CECommandError "not supported" @@ -7051,8 +7051,8 @@ 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)), - (">#" <|> "> #") *> (ForwardGroupMessage <$> displayName <* A.char '@' <*> (Just <$> displayName) <* " -> " <*> chatNameP <*> msgTextP), - (">#" <|> "> #") *> (ForwardGroupMessage <$> displayName <*> pure Nothing <* " -> " <*> chatNameP <*> msgTextP), + (">#" <|> "> #") *> (ForwardGroupMessage <$> displayName <* A.char '@' <*> (Just <$> displayName) <* " -> " <*> chatNameP <* A.space <*> msgTextP), + (">#" <|> "> #") *> (ForwardGroupMessage <$> displayName <*> pure Nothing <* " -> " <*> chatNameP <* 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), @@ -7183,7 +7183,7 @@ chatCommandP = quoted cs = A.choice [A.char c *> takeNameTill (== c) <* A.char c | c <- cs] refChar c = c > ' ' && c /= '#' && c /= '@' sendMsgQuote msgDir = SendMessageQuote <$> displayName <* A.space <*> pure msgDir <*> quotedMsg <*> msgTextP - forwardMsgP msgDir = ForwardMessage <$> displayName <*> pure msgDir <* " -> " <*> chatNameP <*> msgTextP + forwardMsgP msgDir = ForwardMessage <$> displayName <*> pure msgDir <* " -> " <*> chatNameP <* A.space <*> msgTextP quotedMsg = safeDecodeUtf8 <$> (A.char '(' *> A.takeTill (== ')') <* A.char ')') <* optional A.space reactionP = MREmoji <$> (mrEmojiChar <$?> (toEmoji <$> A.anyChar)) toEmoji = \case diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index 7b96abc1ce..54582d7c8c 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -86,7 +86,9 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do Right SendLiveMessage {} -> True Right SendFile {} -> True Right SendMessageQuote {} -> True + Right ForwardMessage {} -> True Right SendGroupMessageQuote {} -> True + Right ForwardGroupMessage {} -> True Right SendMessageBroadcast {} -> True _ -> False startLiveMessage :: Either a ChatCommand -> ChatResponse -> IO () diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 38cbfdec16..f99937588f 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -795,8 +795,8 @@ groupQuote g CIQuote {content = qmc, chatDir = quoteDir} = quoteText qmc . ttyQu forwardedFrom :: CIForwardedFrom -> [StyledString] forwardedFrom = \case CIFFUnknown -> ["-> forwarded"] - CIFFContact c _ -> ["-> forwarded from " <> ttyContact c] - CIFFGroup g _ -> ["-> forwarded from " <> ttyGroup g] + CIFFContact c _ -> ["-> from conversation: " <> ttyContact c] + CIFFGroup g _ -> ["-> from conversation: " <> ttyGroup g] CIFFNoteFolder _ _ -> ["-> forwarded from notes"] sentByMember :: GroupInfo -> CIQDirection 'CTGroup -> Maybe GroupMember diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index a827236a15..fd47c54a3e 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -346,8 +346,8 @@ getTermLine cc = 5000000 `timeout` atomically (readTQueue $ termQ cc) >>= \case Just s -> do -- remove condition to always echo virtual terminal - -- when True $ do - when (printOutput cc) $ do + when True $ do + -- when (printOutput cc) $ do name <- userName cc putStrLn $ name <> ": " <> s pure s diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 77d256a240..e8f3838eb6 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -3,6 +3,7 @@ module ChatTests where import ChatTests.ChatList import ChatTests.Direct import ChatTests.Files +import ChatTests.Forward import ChatTests.Groups import ChatTests.Local import ChatTests.Profiles @@ -11,6 +12,7 @@ import Test.Hspec hiding (it) chatTests :: SpecWith FilePath chatTests = do describe "direct tests" chatDirectTests + describe "forward tests" chatForwardTests describe "group tests" chatGroupTests describe "local chats tests" chatLocalChatsTests describe "file tests" chatFileTests diff --git a/tests/ChatTests/Forward.hs b/tests/ChatTests/Forward.hs new file mode 100644 index 0000000000..1895edf37a --- /dev/null +++ b/tests/ChatTests/Forward.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PostfixOperators #-} + +module ChatTests.Forward where + +import ChatClient +import ChatTests.Utils +import Test.Hspec hiding (it) + +chatForwardTests :: SpecWith FilePath +chatForwardTests = do + fdescribe "forward messages" $ do + it "from contact to contact" testForwardContactContact + +testForwardContactContact :: HasCallStack => FilePath -> IO () +testForwardContactContact = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + connectUsers alice bob + connectUsers alice cath + connectUsers bob cath + + alice #> "@bob hi" + bob <# "alice> hi" + + msgId <- lastItemId alice + alice ##> ("/_forward @2 @3 " <> msgId) + alice <# "@cath -> from conversation: bob" + alice <## " hi" + cath <# "alice> -> forwarded" + cath <## " hi" + + alice #> "@bob hey" + bob <# "alice> hey" + + bob `send` "> @alice -> @cath hey" + bob <# "@cath -> from conversation: alice" + bob <## " hey" + cath <# "bob> -> forwarded" + cath <## " hey"