diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 3d07f6cfdf..bac1018dbd 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1018,7 +1018,7 @@ processChatCommand = \case SendMessageBroadcast msg -> withUser $ \user -> do contacts <- withStore' (`getUserContacts` user) withChatLock "sendMessageBroadcast" . procCmd $ do - let mc = MCText $ safeDecodeUtf8 msg + let mc = MCText msg cts = filter (\ct -> isReady ct && directOrUsed ct) contacts forM_ cts $ \ct -> void @@ -1030,8 +1030,8 @@ processChatCommand = \case CRBroadcastSent user mc (length cts) <$> liftIO getZonedTime SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \user@User {userId} -> do contactId <- withStore $ \db -> getContactIdByName db user cName - quotedItemId <- withStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir (safeDecodeUtf8 quotedMsg) - let mc = MCText $ safeDecodeUtf8 msg + quotedItemId <- withStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg + let mc = MCText msg processChatCommand . APISendMessage (ChatRef CTDirect contactId) False $ ComposedMessage Nothing (Just quotedItemId) mc DeleteMessage chatName deletedMsg -> withUser $ \user -> do chatRef <- getChatRef user chatName @@ -1039,16 +1039,16 @@ processChatCommand = \case processChatCommand $ APIDeleteChatItem chatRef deletedItemId CIDMBroadcast DeleteMemberMessage gName mName deletedMsg -> withUser $ \user -> do (gId, mId) <- getGroupAndMemberId user gName mName - deletedItemId <- withStore $ \db -> getGroupChatItemIdByText db user gId (Just mName) $ safeDecodeUtf8 deletedMsg + deletedItemId <- withStore $ \db -> getGroupChatItemIdByText db user gId (Just mName) deletedMsg processChatCommand $ APIDeleteMemberChatItem gId mId deletedItemId EditMessage chatName editedMsg msg -> withUser $ \user -> do chatRef <- getChatRef user chatName editedItemId <- getSentChatItemIdByText user chatRef editedMsg - let mc = MCText $ safeDecodeUtf8 msg + let mc = MCText msg processChatCommand $ APIUpdateChatItem chatRef editedItemId False mc UpdateLiveMessage chatName chatItemId live msg -> withUser $ \user -> do chatRef <- getChatRef user chatName - let mc = MCText $ safeDecodeUtf8 msg + let mc = MCText msg processChatCommand $ APIUpdateChatItem chatRef chatItemId live mc APINewGroup userId gProfile -> withUserId userId $ \user -> do gVar <- asks idsDrg @@ -1217,8 +1217,8 @@ processChatCommand = \case processChatCommand $ APIGetGroupLink groupId SendGroupMessageQuote gName cName quotedMsg msg -> withUser $ \user -> do groupId <- withStore $ \db -> getGroupIdByName db user gName - quotedItemId <- withStore $ \db -> getGroupChatItemIdByText db user groupId cName (safeDecodeUtf8 quotedMsg) - let mc = MCText $ safeDecodeUtf8 msg + quotedItemId <- withStore $ \db -> getGroupChatItemIdByText db user groupId cName quotedMsg + let mc = MCText msg processChatCommand . APISendMessage (ChatRef CTGroup groupId) False $ ComposedMessage Nothing (Just quotedItemId) mc LastChats count_ -> withUser' $ \user -> do chats <- withStore' $ \db -> getChatPreviews db user False @@ -1386,10 +1386,10 @@ processChatCommand = \case code' <- getConnectionCode $ aConnId conn withStore' $ \db -> setConnectionVerified db user connId Nothing pure $ CRConnectionVerified user False code' - getSentChatItemIdByText :: User -> ChatRef -> ByteString -> m Int64 + getSentChatItemIdByText :: User -> ChatRef -> Text -> m Int64 getSentChatItemIdByText user@User {userId, localDisplayName} (ChatRef cType cId) msg = case cType of - CTDirect -> withStore $ \db -> getDirectChatItemIdByText db userId cId SMDSnd (safeDecodeUtf8 msg) - CTGroup -> withStore $ \db -> getGroupChatItemIdByText db user cId (Just localDisplayName) (safeDecodeUtf8 msg) + CTDirect -> withStore $ \db -> getDirectChatItemIdByText db userId cId SMDSnd msg + CTGroup -> withStore $ \db -> getGroupChatItemIdByText db user cId (Just localDisplayName) msg _ -> throwChatError $ CECommandError "not supported" connectViaContact :: User -> ConnectionRequestUri 'CMContact -> m ChatResponse connectViaContact user@User {userId} cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do @@ -1543,7 +1543,7 @@ processChatCommand = \case setActive $ ActiveG localDisplayName sendTextMessage chatName msg live = withUser $ \user -> do chatRef <- getChatRef user chatName - let mc = MCText $ safeDecodeUtf8 msg + let mc = MCText msg processChatCommand . APISendMessage chatRef live $ ComposedMessage Nothing Nothing mc sndContactCITimed :: Bool -> Contact -> m (Maybe CITimed) sndContactCITimed live = mapM (sndCITimed_ live) . contactTimedTTL @@ -4056,29 +4056,29 @@ chatCommandP = "/_group_profile #" *> (APIUpdateGroupProfile <$> A.decimal <* A.space <*> jsonP), ("/group_profile " <|> "/gp ") *> char_ '#' *> (UpdateGroupNames <$> displayName <* A.space <*> groupProfile), ("/group_profile " <|> "/gp ") *> char_ '#' *> (ShowGroupProfile <$> displayName), - "/group_descr " *> char_ '#' *> (UpdateGroupDescription <$> displayName <*> optional (A.space *> (jsonP <|> textP))), + "/group_descr " *> char_ '#' *> (UpdateGroupDescription <$> displayName <*> optional (A.space *> msgTextP)), "/_create link #" *> (APICreateGroupLink <$> A.decimal), "/_delete link #" *> (APIDeleteGroupLink <$> A.decimal), "/_get link #" *> (APIGetGroupLink <$> A.decimal), "/create link #" *> (CreateGroupLink <$> displayName), "/delete link #" *> (DeleteGroupLink <$> displayName), "/show link #" *> (ShowGroupLink <$> displayName), - (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <*> pure Nothing <*> quotedMsg <*> A.takeByteString), - (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> A.takeByteString), + (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <*> pure Nothing <*> quotedMsg <*> msgTextP), + (">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> msgTextP), "/_contacts " *> (APIListContacts <$> A.decimal), "/contacts" $> ListContacts, "/_connect " *> (APIConnect <$> A.decimal <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)), "/_connect " *> (APIAddContact <$> A.decimal), ("/connect " <|> "/c ") *> (Connect <$> ((Just <$> strP) <|> A.takeByteString $> Nothing)), ("/connect" <|> "/c") $> AddContact, - SendMessage <$> chatNameP <* A.space <*> A.takeByteString, - "/live " *> (SendLiveMessage <$> chatNameP <*> (A.space *> A.takeByteString <|> pure "")), + SendMessage <$> chatNameP <* A.space <*> msgTextP, + "/live " *> (SendLiveMessage <$> chatNameP <*> (A.space *> msgTextP <|> pure "")), (">@" <|> "> @") *> sendMsgQuote (AMsgDirection SMDRcv), (">>@" <|> ">> @") *> sendMsgQuote (AMsgDirection SMDSnd), - ("\\ " <|> "\\") *> (DeleteMessage <$> chatNameP <* A.space <*> A.takeByteString), - ("\\\\ #" <|> "\\\\#") *> (DeleteMemberMessage <$> displayName <* A.space <* char_ '@' <*> displayName <* A.space <*> A.takeByteString), - ("! " <|> "!") *> (EditMessage <$> chatNameP <* A.space <*> (quotedMsg <|> pure "") <*> A.takeByteString), - "/feed " *> (SendMessageBroadcast <$> A.takeByteString), + ("\\ " <|> "\\") *> (DeleteMessage <$> chatNameP <* A.space <*> textP), + ("\\\\ #" <|> "\\\\#") *> (DeleteMemberMessage <$> displayName <* A.space <* char_ '@' <*> displayName <* A.space <*> textP), + ("! " <|> "!") *> (EditMessage <$> chatNameP <* A.space <*> (quotedMsg <|> pure "") <*> msgTextP), + "/feed " *> (SendMessageBroadcast <$> msgTextP), ("/chats" <|> "/cs") *> (LastChats <$> (" all" $> Nothing <|> Just <$> (A.space *> A.decimal <|> pure 20))), ("/tail" <|> "/t") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP <*> pure Nothing), ("/search" <|> "/?") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP <*> (Just <$> (A.space *> stringP))), @@ -4139,8 +4139,8 @@ chatCommandP = msgContentP = "text " *> mcTextP <|> "json " *> jsonP ciDeleteMode = "broadcast" $> CIDMBroadcast <|> "internal" $> CIDMInternal displayName = safeDecodeUtf8 <$> (B.cons <$> A.satisfy refChar <*> A.takeTill (== ' ')) - sendMsgQuote msgDir = SendMessageQuote <$> displayName <* A.space <*> pure msgDir <*> quotedMsg <*> A.takeByteString - quotedMsg = A.char '(' *> A.takeTill (== ')') <* A.char ')' <* optional A.space + sendMsgQuote msgDir = SendMessageQuote <$> displayName <* A.space <*> pure msgDir <*> quotedMsg <*> msgTextP + quotedMsg = safeDecodeUtf8 <$> (A.char '(' *> A.takeTill (== ')') <* A.char ')') <* optional A.space refChar c = c > ' ' && c /= '#' && c /= '@' liveMessageP = " live=" *> onOffP <|> pure False onOffP = ("on" $> True) <|> ("off" $> False) @@ -4162,6 +4162,7 @@ chatCommandP = n <- (A.space *> A.takeByteString) <|> pure "" pure $ if B.null n then name else safeDecodeUtf8 n textP = safeDecodeUtf8 <$> A.takeByteString + msgTextP = jsonP <|> textP stringP = T.unpack . safeDecodeUtf8 <$> A.takeByteString filePath = stringP memberRole = diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 2390d40dd1..70240aff77 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -293,14 +293,14 @@ data ChatCommand | AddressAutoAccept (Maybe AutoAccept) | AcceptContact ContactName | RejectContact ContactName - | SendMessage ChatName ByteString - | SendLiveMessage ChatName ByteString - | SendMessageQuote {contactName :: ContactName, msgDir :: AMsgDirection, quotedMsg :: ByteString, message :: ByteString} - | SendMessageBroadcast ByteString -- UserId (not used in UI) - | DeleteMessage ChatName ByteString - | DeleteMemberMessage GroupName ContactName ByteString - | EditMessage {chatName :: ChatName, editedMsg :: ByteString, message :: ByteString} - | UpdateLiveMessage {chatName :: ChatName, chatItemId :: ChatItemId, liveMessage :: Bool, message :: ByteString} + | SendMessage ChatName Text + | SendLiveMessage ChatName Text + | SendMessageQuote {contactName :: ContactName, msgDir :: AMsgDirection, quotedMsg :: Text, message :: Text} + | SendMessageBroadcast Text -- UserId (not used in UI) + | DeleteMessage ChatName Text + | DeleteMemberMessage GroupName ContactName Text + | EditMessage {chatName :: ChatName, editedMsg :: Text, message :: Text} + | UpdateLiveMessage {chatName :: ChatName, chatItemId :: ChatItemId, liveMessage :: Bool, message :: Text} | APINewGroup UserId GroupProfile | NewGroup GroupProfile | AddMember GroupName ContactName GroupMemberRole @@ -318,7 +318,7 @@ data ChatCommand | CreateGroupLink GroupName | DeleteGroupLink GroupName | ShowGroupLink GroupName - | SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: ByteString, message :: ByteString} + | SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: Text, message :: Text} | LastChats (Maybe Int) -- UserId (not used in UI) | LastMessages (Maybe ChatName) Int (Maybe String) -- UserId (not used in UI) | LastChatItemId (Maybe ChatName) Int -- UserId (not used in UI) diff --git a/src/Simplex/Chat/Terminal/Input.hs b/src/Simplex/Chat/Terminal/Input.hs index 1ea3dc0cd0..f405416c51 100644 --- a/src/Simplex/Chat/Terminal/Input.hs +++ b/src/Simplex/Chat/Terminal/Input.hs @@ -23,7 +23,7 @@ import Simplex.Chat.Controller import Simplex.Chat.Messages import Simplex.Chat.Styled import Simplex.Chat.Terminal.Output -import Simplex.Messaging.Util (safeDecodeUtf8, whenM) +import Simplex.Messaging.Util (whenM) import System.Exit (exitSuccess) import System.Terminal hiding (insertChars) import UnliftIO.STM @@ -61,7 +61,7 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do startLiveMessage :: Either a ChatCommand -> ChatResponse -> IO () startLiveMessage (Right (SendLiveMessage chatName msg)) (CRNewChatItem _ (AChatItem cType SMDSnd _ ChatItem {meta = CIMeta {itemId}})) = do whenM (isNothing <$> readTVarIO liveMessageState) $ do - let s = T.unpack $ safeDecodeUtf8 msg + let s = T.unpack msg int = case cType of SCTGroup -> 5000000; _ -> 3000000 :: Int liveThreadId <- mkWeakThreadId =<< runLiveMessage int `forkFinally` const (atomically $ writeTVar liveMessageState Nothing) promptThreadId <- mkWeakThreadId =<< forkIO blinkLivePrompt @@ -110,8 +110,7 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do sendUpdatedLiveMessage :: ChatController -> String -> LiveMessage -> Bool -> IO ChatResponse sendUpdatedLiveMessage cc sentMsg LiveMessage {chatName, chatItemId} live = do - let bs = encodeUtf8 $ T.pack sentMsg - cmd = UpdateLiveMessage chatName chatItemId live bs + let cmd = UpdateLiveMessage chatName chatItemId live $ T.pack sentMsg either (CRChatCmdError Nothing) id <$> runExceptT (processChatCommand cmd) `runReaderT` cc runTerminalInput :: ChatTerminal -> ChatController -> IO () @@ -238,8 +237,8 @@ updateTermState ac live tw (key, ms) ts@TerminalState {inputString = s, inputPos Left _ -> inp Right cmd -> case cmd of SendMessage {} -> "! " <> inp - SendMessageQuote {contactName, message} -> T.unpack $ "! @" <> contactName <> " " <> safeDecodeUtf8 message - SendGroupMessageQuote {groupName, message} -> T.unpack $ "! #" <> groupName <> " " <> safeDecodeUtf8 message + SendMessageQuote {contactName, message} -> T.unpack $ "! @" <> contactName <> " " <> message + SendGroupMessageQuote {groupName, message} -> T.unpack $ "! #" <> groupName <> " " <> message _ -> inp setPosition p' = ts' (s, p') prevWordPos diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 0e6d535b15..7754ccf2e7 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -32,6 +32,7 @@ chatDirectTests = do it "direct message delete" testDirectMessageDelete it "direct live message" testDirectLiveMessage it "repeat AUTH errors disable contact" testRepeatAuthErrorsDisableContact + it "should send multiline message" testMultilineMessage describe "SMP servers" $ do it "get and set SMP servers" testGetSetSMPServers it "test SMP server connection" testTestSMPServerConnection @@ -369,6 +370,23 @@ testRepeatAuthErrorsDisableContact = alice #> "@bob hey" alice <## "[bob, contactId: 2, connId: 1] error: connection authorization failed - this could happen if connection was deleted, secured with different credentials, or due to a bug - please re-create the connection" +testMultilineMessage :: HasCallStack => FilePath -> IO () +testMultilineMessage = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do + connectUsers alice bob + connectUsers alice cath + alice `send` "@bob \"hello\\nthere\"" -- @bob "hello\nthere" + alice <# "@bob hello" + alice <## "there" + bob <# "alice> hello" + bob <## "there" + alice `send` "/feed \"hello\\nthere\"" -- /feed "hello\nthere" + alice <##. "/feed (2)" + alice <## "there" + bob <# "alice> hello" + bob <## "there" + cath <# "alice> hello" + cath <## "there" + testGetSetSMPServers :: HasCallStack => FilePath -> IO () testGetSetSMPServers = testChat2 aliceProfile bobProfile $