dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-24 19:35:33 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: multi forward api (#4704)

Browse Source
This commit is contained in:
spaced4ndy
2024-08-22 21:36:35 +04:00
committed by GitHub
parent c485837910
commit 791489e943
21 changed files with 601 additions and 343 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+470 -282
View File
File diff suppressed because it is too large Load Diff
src/Simplex/Chat/Bot.hs
+4 -3
View File
@@ -11,6 +11,7 @@ import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Text as T
import Simplex.Chat.Controller
import Simplex.Chat.Core
@@ -31,7 +32,7 @@ chatBotRepl welcome answer _user cc = do
CRContactConnected _ contact _ -> do
contactConnected contact
void $ sendMessage cc contact welcome
CRNewChatItem _ (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content = mc@CIRcvMsgContent {}}) -> do
CRNewChatItems {chatItems = (AChatItem _ SMDRcv (DirectChat contact) ChatItem {content = mc@CIRcvMsgContent {}}) : _} -> do
let msg = T.unpack $ ciContentToText mc
void $ sendMessage cc contact =<< answer contact msg
_ -> pure ()
@@ -68,8 +69,8 @@ sendComposedMessage cc = sendComposedMessage' cc . contactId'
sendComposedMessage' :: ChatController -> ContactId -> Maybe ChatItemId -> MsgContent -> IO ()
sendComposedMessage' cc ctId quotedItemId msgContent = do
let cm = ComposedMessage {fileSource = Nothing, quotedItemId, msgContent}
sendChatCmd cc (APISendMessage (ChatRef CTDirect ctId) False Nothing cm) >>= \case
CRNewChatItem {} -> printLog cc CLLInfo $ "sent message to contact ID " <> show ctId
sendChatCmd cc (APISendMessages (ChatRef CTDirect ctId) False Nothing (cm :| [])) >>= \case
CRNewChatItems {} -> printLog cc CLLInfo $ "sent message to contact ID " <> show ctId
r -> putStrLn $ "unexpected send message response: " <> show r
deleteMessage :: ChatController -> Contact -> ChatItemId -> IO ()
src/Simplex/Chat/Controller.hs
+4 -5
View File
@@ -292,13 +292,13 @@ data ChatCommand
| APIGetChat ChatRef ChatPagination (Maybe String)
| APIGetChatItems ChatPagination (Maybe String)
| APIGetChatItemInfo ChatRef ChatItemId
| APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessage :: ComposedMessage}
| APICreateChatItem {noteFolderId :: NoteFolderId, composedMessage :: ComposedMessage}
| APISendMessages {chatRef :: ChatRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessages :: NonEmpty ComposedMessage}
| APICreateChatItems {noteFolderId :: NoteFolderId, composedMessages :: NonEmpty ComposedMessage}
| APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent}
| APIDeleteChatItem ChatRef (NonEmpty ChatItemId) CIDeleteMode
| APIDeleteMemberChatItem GroupId (NonEmpty ChatItemId)
| APIChatItemReaction {chatRef :: ChatRef, chatItemId :: ChatItemId, add :: Bool, reaction :: MsgReaction}
| APIForwardChatItem {toChatRef :: ChatRef, fromChatRef :: ChatRef, chatItemId :: ChatItemId, ttl :: Maybe Int}
| APIForwardChatItems {toChatRef :: ChatRef, fromChatRef :: ChatRef, chatItemIds :: NonEmpty ChatItemId, ttl :: Maybe Int}
| APIUserRead UserId
| UserRead
| APIChatRead ChatRef (Maybe (ChatItemId, ChatItemId))
@@ -597,7 +597,7 @@ data ChatResponse
| CRContactCode {user :: User, contact :: Contact, connectionCode :: Text}
| CRGroupMemberCode {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionCode :: Text}
| CRConnectionVerified {user :: User, verified :: Bool, expectedCode :: Text}
| CRNewChatItem {user :: User, chatItem :: AChatItem}
| CRNewChatItems {user :: User, chatItems :: [AChatItem]}
| CRChatItemStatusUpdated {user :: User, chatItem :: AChatItem}
| CRChatItemUpdated {user :: User, chatItem :: AChatItem}
| CRChatItemNotChanged {user :: User, chatItem :: AChatItem}
@@ -1178,7 +1178,6 @@ data ChatErrorType
| CEInlineFileProhibited {fileId :: FileTransferId}
| CEInvalidQuote
| CEInvalidForward
| CEForwardNoFile
| CEInvalidChatItemUpdate
| CEInvalidChatItemDelete
| CEHasCurrentCall
src/Simplex/Chat/Messages/Batch.hs
+6 -4
View File
@@ -17,16 +17,18 @@ import Simplex.Chat.Messages
data MsgBatch = MsgBatch ByteString [SndMessage]
-- | Batches [SndMessage] into batches of ByteStrings in form of JSON arrays.
-- | Batches SndMessages in [Either ChatError SndMessage] into batches of ByteStrings in form of JSON arrays.
-- Preserves original errors in the list.
-- Does not check if the resulting batch is a valid JSON.
-- If a single element is passed, it is returned as is (a JSON string).
-- If an element exceeds maxLen, it is returned as ChatError.
batchMessages :: Int -> [SndMessage] -> [Either ChatError MsgBatch]
batchMessages :: Int -> [Either ChatError SndMessage] -> [Either ChatError MsgBatch]
batchMessages maxLen = addBatch . foldr addToBatch ([], [], 0, 0)
where
msgBatch batch = Right (MsgBatch (encodeMessages batch) batch)
addToBatch :: SndMessage -> ([Either ChatError MsgBatch], [SndMessage], Int, Int) -> ([Either ChatError MsgBatch], [SndMessage], Int, Int)
addToBatch msg@SndMessage {msgBody} acc@(batches, batch, len, n)
addToBatch :: Either ChatError SndMessage -> ([Either ChatError MsgBatch], [SndMessage], Int, Int) -> ([Either ChatError MsgBatch], [SndMessage], Int, Int)
addToBatch (Left err) acc = (Left err : addBatch acc, [], 0, 0) -- step over original error
addToBatch (Right msg@SndMessage {msgBody}) acc@(batches, batch, len, n)
| batchLen <= maxLen = (batches, msg : batch, len', n + 1)
| msgLen <= maxLen = (addBatch acc, [msg], msgLen, 1)
| otherwise = (errLarge msg : addBatch acc, [], 0, 0)
src/Simplex/Chat/Store/Files.hs
+5 -5
View File
@@ -966,20 +966,20 @@ lookupFileTransferRedirectMeta db User {userId} fileId = do
redirects <- DB.query db "SELECT file_id FROM files WHERE user_id = ? AND redirect_file_id = ?" (userId, fileId)
rights <$> mapM (runExceptT . getFileTransferMeta_ db userId . fromOnly) redirects
createLocalFile :: ToField (CIFileStatus d) => CIFileStatus d -> DB.Connection -> User -> NoteFolder -> ChatItemId -> UTCTime -> CryptoFile -> Integer -> Integer -> IO Int64
createLocalFile fileStatus db User {userId} NoteFolder {noteFolderId} chatItemId itemTs CryptoFile {filePath, cryptoArgs} fileSize fileChunkSize = do
createLocalFile :: ToField (CIFileStatus d) => CIFileStatus d -> DB.Connection -> User -> NoteFolder -> UTCTime -> CryptoFile -> Integer -> Integer -> IO Int64
createLocalFile fileStatus db User {userId} NoteFolder {noteFolderId} itemTs CryptoFile {filePath, cryptoArgs} fileSize fileChunkSize = do
DB.execute
db
[sql|
INSERT INTO files
( user_id, note_folder_id, chat_item_id,
( user_id, note_folder_id,
file_name, file_path, file_size,
file_crypto_key, file_crypto_nonce,
chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at
)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?)
VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?)
|]
( (userId, noteFolderId, chatItemId)
( (userId, noteFolderId)
:. (takeFileName filePath, filePath, fileSize)
:. maybe (Nothing, Nothing) (\(CFArgs key nonce) -> (Just key, Just nonce)) cryptoArgs
:. (fileChunkSize, Nothing :: Maybe InlineFileMode, fileStatus, FPLocal, itemTs, itemTs)
src/Simplex/Chat/Terminal/Input.hs
+2 -2
View File
@@ -69,7 +69,7 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
Nothing -> setActive ct ""
Just rhId -> updateRemoteUser ct u rhId
CRChatItems u chatName_ _ -> whenCurrUser cc u $ mapM_ (setActive ct . chatActiveTo) chatName_
CRNewChatItem u (AChatItem _ SMDSnd cInfo _) -> whenCurrUser cc u $ setActiveChat ct cInfo
CRNewChatItems u ((AChatItem _ SMDSnd cInfo _) : _) -> whenCurrUser cc u $ setActiveChat ct cInfo
CRChatItemUpdated u (AChatItem _ SMDSnd cInfo _) -> whenCurrUser cc u $ setActiveChat ct cInfo
CRChatItemsDeleted u ((ChatItemDeletion (AChatItem _ _ cInfo _) _) : _) _ _ -> whenCurrUser cc u $ setActiveChat ct cInfo
CRContactDeleted u c -> whenCurrUser cc u $ unsetActiveContact ct c
@@ -93,7 +93,7 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
Right SendMessageBroadcast {} -> True
_ -> False
startLiveMessage :: Either a ChatCommand -> ChatResponse -> IO ()
startLiveMessage (Right (SendLiveMessage chatName msg)) (CRNewChatItem _ (AChatItem cType SMDSnd _ ChatItem {meta = CIMeta {itemId}})) = do
startLiveMessage (Right (SendLiveMessage chatName msg)) (CRNewChatItems {chatItems = [AChatItem cType SMDSnd _ ChatItem {meta = CIMeta {itemId}}]}) = do
whenM (isNothing <$> readTVarIO liveMessageState) $ do
let s = T.unpack msg
int = case cType of SCTGroup -> 5000000; _ -> 3000000 :: Int
src/Simplex/Chat/Terminal/Main.hs
+1 -1
View File
@@ -44,7 +44,7 @@ simplexChatCLI' cfg opts@ChatOpts {chatCmd, chatCmdLog, chatCmdDelay, chatServer
when (chatCmdLog /= CCLNone) . void . forkIO . forever $ do
(_, _, r') <- atomically . readTBQueue $ outputQ cc
case r' of
CRNewChatItem {} -> printResponse r'
CRNewChatItems {} -> printResponse r'
_ -> when (chatCmdLog == CCLAll) $ printResponse r'
sendChatCmdStr cc chatCmd >>= printResponse
threadDelay $ chatCmdDelay * 1000000
src/Simplex/Chat/Terminal/Output.hs
+3 -2
View File
@@ -147,7 +147,7 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} Cha
forever $ do
(_, outputRH, r) <- atomically $ readTBQueue outputQ
case r of
CRNewChatItem u ci -> when markRead $ markChatItemRead u ci
CRNewChatItems u (ci : _) -> when markRead $ markChatItemRead u ci -- At the moment of writing received items are created one at a time
CRChatItemUpdated u ci -> when markRead $ markChatItemRead u ci
CRRemoteHostConnected {remoteHost = RemoteHostInfo {remoteHostId}} -> getRemoteUser remoteHostId
CRRemoteHostStopped {remoteHostId_} -> mapM_ removeRemoteUser remoteHostId_
@@ -175,7 +175,8 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems, logFilePath} Cha
responseNotification :: ChatTerminal -> ChatController -> ChatResponse -> IO ()
responseNotification t@ChatTerminal {sendNotification} cc = \case
CRNewChatItem u (AChatItem _ SMDRcv cInfo ci@ChatItem {chatDir, content = CIRcvMsgContent mc, formattedText}) ->
-- At the moment of writing received items are created one at a time
CRNewChatItems u ((AChatItem _ SMDRcv cInfo ci@ChatItem {chatDir, content = CIRcvMsgContent mc, formattedText}) : _) ->
when (chatDirNtf u cInfo chatDir $ isMention ci) $ do
whenCurrUser cc u $ setActiveChat t cInfo
case (cInfo, chatDir) of
src/Simplex/Chat/View.hs
+4 -2
View File
@@ -120,7 +120,10 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
CRConnectionVerified u verified code -> ttyUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code]
CRContactCode u ct code -> ttyUser u $ viewContactCode ct code testView
CRGroupMemberCode u g m code -> ttyUser u $ viewGroupMemberCode g m code testView
CRNewChatItem u (AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewChatItem chat item False ts tz <> viewItemReactions item
CRNewChatItems u chatItems ->
concatMap
(\(AChatItem _ _ chat item) -> ttyUser u $ unmuted u chat item $ viewChatItem chat item False ts tz <> viewItemReactions item)
chatItems
CRChatItems u _ chatItems -> ttyUser u $ concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts tz <> viewItemReactions item) chatItems
CRChatItemInfo u ci ciInfo -> ttyUser u $ viewChatItemInfo ci ciInfo tz
CRChatItemId u itemId -> ttyUser u [plain $ maybe "no item" show itemId]
@@ -2025,7 +2028,6 @@ viewChatError isCmd logLevel testView = \case
CEInlineFileProhibited _ -> ["A small file sent without acceptance - you can enable receiving such files with -f option."]
CEInvalidQuote -> ["cannot reply to this message"]
CEInvalidForward -> ["cannot forward this message"]
CEForwardNoFile -> ["cannot forward this message, file not found"]
CEInvalidChatItemUpdate -> ["cannot update this item"]
CEInvalidChatItemDelete -> ["cannot delete this item"]
CEHasCurrentCall -> ["call already in progress"]