diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index c0c8e21da3..803dedd6d9 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -132,8 +132,9 @@ createChatDatabase filePrefix key yesToMigrations = do pure ChatDatabase {chatStore, agentStore} newChatController :: ChatDatabase -> Maybe User -> ChatConfig -> ChatOpts -> Maybe (Notification -> IO ()) -> IO ChatController -newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, tbqSize, defaultServers} ChatOpts {smpServers, networkConfig, logConnections, logServerHosts} sendToast = do - let config = cfg {subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers} +newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, tbqSize, defaultServers, inlineFiles} ChatOpts {smpServers, networkConfig, logConnections, logServerHosts, allowInstantFiles} sendToast = do + let inlineFiles' = if allowInstantFiles then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False} + config = cfg {subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles'} sendNotification = fromMaybe (const $ pure ()) sendToast firstTime = dbNew chatStore activeTo <- newTVarIO ActiveNone @@ -305,7 +306,7 @@ processChatCommand = \case where setupSndFileTransfer :: Contact -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta)) setupSndFileTransfer ct = forM file_ $ \file -> do - (fileSize, chSize, fileInline) <- checkSndFile file 1 + (fileSize, chSize, fileInline) <- checkSndFile mc file 1 (agentConnId_, fileConnReq) <- if isJust fileInline then pure (Nothing, Nothing) @@ -351,7 +352,7 @@ processChatCommand = \case where setupSndFileTransfer :: GroupInfo -> Int -> m (Maybe (FileInvitation, CIFile 'MDSnd, FileTransferMeta)) setupSndFileTransfer gInfo n = forM file_ $ \file -> do - (fileSize, chSize, fileInline) <- checkSndFile file $ fromIntegral n + (fileSize, chSize, fileInline) <- checkSndFile mc file $ fromIntegral n let fileName = takeFileName file fileInvitation = FileInvitation {fileName, fileSize, fileConnReq = Nothing, fileInline} fileStatus = if fileInline == Just IFMSent then CIFSSndTransfer else CIFSSndStored @@ -1160,18 +1161,18 @@ processChatCommand = \case contactMember Contact {contactId} = find $ \GroupMember {memberContactId = cId, memberStatus = s} -> cId == Just contactId && s /= GSMemRemoved && s /= GSMemLeft - checkSndFile :: FilePath -> Integer -> m (Integer, Integer, Maybe InlineFileMode) - checkSndFile f n = do + checkSndFile :: MsgContent -> FilePath -> Integer -> m (Integer, Integer, Maybe InlineFileMode) + checkSndFile mc f n = do fsFilePath <- toFSFilePath f unlessM (doesFileExist fsFilePath) . throwChatError $ CEFileNotFound f ChatConfig {fileChunkSize, inlineFiles} <- asks config fileSize <- getFileSize fsFilePath let chunks = - ((- fileSize) `div` fileChunkSize) - pure (fileSize, fileChunkSize, inlineFileMode inlineFiles chunks n) - inlineFileMode InlineFilesConfig {offerChunks, sendChunks, totalSendChunks} chunks n + pure (fileSize, fileChunkSize, inlineFileMode mc inlineFiles chunks n) + inlineFileMode mc InlineFilesConfig {offerChunks, sendChunks, totalSendChunks} chunks n | chunks > offerChunks = Nothing - | chunks > sendChunks || chunks * n > totalSendChunks = Just IFMOffer - | otherwise = Just IFMSent + | chunks <= sendChunks && chunks * n <= totalSendChunks && isVoice mc = Just IFMSent + | otherwise = Just IFMOffer updateProfile :: User -> Profile -> m ChatResponse updateProfile user@User {profile = p@LocalProfile {profileId, localAlias}} p'@Profile {displayName} | p' == fromLocalProfile p = pure CRUserProfileNoChange @@ -2200,7 +2201,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = case featureProhibited forContact ct content of Just f -> void $ newChatItem (CIRcvChatFeatureRejected f) Nothing _ -> do - ciFile_ <- processFileInvitation fileInvitation_ $ \db -> createRcvFileTransfer db userId ct + ciFile_ <- processFileInvitation fileInvitation_ content $ \db -> createRcvFileTransfer db userId ct ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ when (enableNtfs chatSettings) $ showMsgToast (c <> "> ") content formattedText setActive $ ActiveC c @@ -2210,10 +2211,10 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci pure ci - processFileInvitation :: Maybe FileInvitation -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv)) - processFileInvitation fInv_ createRcvFT = forM fInv_ $ \fInv@FileInvitation {fileName, fileSize} -> do + processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv)) + processFileInvitation fInv_ mc createRcvFT = forM fInv_ $ \fInv@FileInvitation {fileName, fileSize} -> do chSize <- asks $ fileChunkSize . config - inline <- receiveInlineMode fInv chSize + inline <- receiveInlineMode fInv (Just mc) chSize ft@RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvFT db fInv inline chSize (filePath, fileStatus) <- case inline of Just IFMSent -> do @@ -2265,7 +2266,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = case groupFeatureProhibited gInfo content of Just f -> void $ newChatItem (CIRcvChatFeatureRejected f) Nothing _ -> do - ciFile_ <- processFileInvitation fInv_ $ \db -> createRcvGroupFileTransfer db userId m + ciFile_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ let g = groupName' gInfo when (enableNtfs chatSettings) $ showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText @@ -2318,7 +2319,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = processFileInvitation' ct@Contact {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg msgMeta = do checkIntegrityCreateItem (CDDirectRcv ct) msgMeta chSize <- asks $ fileChunkSize . config - inline <- receiveInlineMode fInv chSize + inline <- receiveInlineMode fInv Nothing chSize RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvFileTransfer db userId ct fInv inline chSize let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation} ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvMsgContent $ MCFile "") ciFile @@ -2330,7 +2331,7 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = processGroupFileInvitation' :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> MsgMeta -> m () processGroupFileInvitation' gInfo m@GroupMember {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg msgMeta = do chSize <- asks $ fileChunkSize . config - inline <- receiveInlineMode fInv chSize + inline <- receiveInlineMode fInv Nothing chSize RcvFileTransfer {fileId} <- withStore' $ \db -> createRcvGroupFileTransfer db userId m fInv inline chSize let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation} ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent $ MCFile "") ciFile @@ -2339,11 +2340,13 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = showToast ("#" <> g <> " " <> c <> "> ") "wants to send a file" setActive $ ActiveG g - receiveInlineMode :: FileInvitation -> Integer -> m (Maybe InlineFileMode) - receiveInlineMode FileInvitation {fileSize, fileInline} chSize = case fileInline of - inline@(Just _) -> do - rcvChunks <- asks $ receiveChunks . inlineFiles . config - pure $ if fileSize <= rcvChunks * chSize then inline else Nothing + receiveInlineMode :: FileInvitation -> Maybe MsgContent -> Integer -> m (Maybe InlineFileMode) + receiveInlineMode FileInvitation {fileSize, fileInline} mc_ chSize = case fileInline of + Just mode -> do + InlineFilesConfig {receiveChunks, receiveInstant} <- asks $ inlineFiles . config + pure $ if fileSize <= receiveChunks * chSize then inline' receiveInstant else Nothing + where + inline' receiveInstant = if mode == IFMOffer || (receiveInstant && maybe False isVoice mc_) then fileInline else Nothing _ -> pure Nothing xFileCancel :: Contact -> SharedMsgId -> MsgMeta -> m () @@ -2408,6 +2411,9 @@ processAgentMessage (Just user@User {userId}) corrId agentConnId agentMessage = receiveInlineChunk ft chunk meta receiveInlineChunk :: RcvFileTransfer -> FileChunk -> MsgMeta -> m () + receiveInlineChunk RcvFileTransfer {fileId, fileStatus = RFSNew} FileChunk {chunkNo} _ + | chunkNo == 1 = throwChatError $ CEFileLargeSentInline fileId + | otherwise = pure () receiveInlineChunk ft chunk meta = do case chunk of FileChunk {chunkNo} -> when (chunkNo == 1) $ startReceivingFile ft diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index d188201422..7855c562c1 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -81,7 +81,8 @@ data InlineFilesConfig = InlineFilesConfig { offerChunks :: Integer, sendChunks :: Integer, totalSendChunks :: Integer, - receiveChunks :: Integer + receiveChunks :: Integer, + receiveInstant :: Bool } defaultInlineFilesConfig :: InlineFilesConfig @@ -90,7 +91,8 @@ defaultInlineFilesConfig = { offerChunks = 15, -- max when chunks are offered / received with the option - limited to 255 on the encoding level sendChunks = 6, -- max per file when chunks will be sent inline without acceptance totalSendChunks = 30, -- max per conversation when chunks will be sent inline without acceptance - receiveChunks = 8 -- max when chunks are accepted + receiveChunks = 8, -- max when chunks are accepted + receiveInstant = True -- allow receiving instant files, within receiveChunks limit } data ActiveTo = ActiveNone | ActiveC ContactName | ActiveG GroupName @@ -534,6 +536,7 @@ data ChatErrorType | CEFileImageType {filePath :: FilePath} | CEFileImageSize {filePath :: FilePath} | CEFileNotReceived {fileId :: FileTransferId} + | CEFileLargeSentInline {fileId :: FileTransferId} | CEInvalidQuote | CEInvalidChatItemUpdate | CEInvalidChatItemDelete diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index a3c12ce5c5..87210fb588 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -129,6 +129,7 @@ mobileChatOpts = chatCmd = "", chatCmdDelay = 3, chatServerPort = Nothing, + allowInstantFiles = True, maintenance = True } diff --git a/src/Simplex/Chat/Options.hs b/src/Simplex/Chat/Options.hs index e933ac2a3e..9f76a61f12 100644 --- a/src/Simplex/Chat/Options.hs +++ b/src/Simplex/Chat/Options.hs @@ -34,6 +34,7 @@ data ChatOpts = ChatOpts chatCmd :: String, chatCmdDelay :: Int, chatServerPort :: Maybe String, + allowInstantFiles :: Bool, maintenance :: Bool } @@ -126,6 +127,12 @@ chatOpts appDir defaultDbFileName = do <> help "Run chat server on specified port" <> value Nothing ) + allowInstantFiles <- + switch + ( long "--allow-instant-files" + <> short 'f' + <> help "Send and receive instant files without acceptance" + ) maintenance <- switch ( long "maintenance" @@ -144,6 +151,7 @@ chatOpts appDir defaultDbFileName = do chatCmd, chatCmdDelay, chatServerPort, + allowInstantFiles, maintenance } where diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index fc75850427..f45d8a07c6 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -265,6 +265,7 @@ cmToQuotedMsg = \case _ -> Nothing data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCVoice_ | MCFile_ | MCUnknown_ Text + deriving (Eq) instance StrEncoding MsgContentTag where strEncode = \case @@ -341,6 +342,11 @@ durationText duration = | n <= 9 = '0' : show n | otherwise = show n +isVoice :: MsgContent -> Bool +isVoice = \case + MCVoice {} -> True + _ -> False + msgContentTag :: MsgContent -> MsgContentTag msgContentTag = \case MCText _ -> MCText_ diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 6ae7c052cb..b5793e0262 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -1083,6 +1083,7 @@ viewChatError = \case CEFileImageType _ -> ["image type must be jpg, send as a file using " <> highlight' "/f"] CEFileImageSize _ -> ["max image size: " <> sShow maxImageSize <> " bytes, resize it or send as a file using " <> highlight' "/f"] CEFileNotReceived fileId -> ["file " <> sShow fileId <> " not received"] + CEFileLargeSentInline _ -> ["A small file sent without acceptance - you can enable receiving such files automatically with -f option."] CEInvalidQuote -> ["cannot reply to this message"] CEInvalidChatItemUpdate -> ["cannot update this item"] CEInvalidChatItemDelete -> ["cannot delete this item"] diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 11ab2771d7..3af1fcbad9 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -59,6 +59,7 @@ testOpts = chatCmd = "", chatCmdDelay = 3, chatServerPort = Nothing, + allowInstantFiles = True, maintenance = False } diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 991ca8ecc1..ead53c08d2 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -1595,9 +1595,12 @@ testInlineFileTransfer = connectUsers alice bob bob ##> "/_files_folder ./tests/tmp/" bob <## "ok" - alice #> "/f @bob ./tests/fixtures/test.jpg" + alice ##> "/_send @2 json {\"msgContent\":{\"type\":\"voice\", \"duration\":10, \"text\":\"\"}, \"filePath\":\"./tests/fixtures/test.jpg\"}" + alice <# "@bob voice message (00:10)" + alice <# "/f @bob ./tests/fixtures/test.jpg" -- below is not shown in "sent" mode -- alice <## "use /fc 1 to cancel sending" + bob <# "alice> voice message (00:10)" bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)" -- below is not shown in "sent" mode -- bob <## "use /fr 1 [/ | ] to receive it" @@ -1617,18 +1620,21 @@ testSmallInlineFileTransfer = connectUsers alice bob bob ##> "/_files_folder ./tests/tmp/" bob <## "ok" - alice #> "/f @bob ./tests/fixtures/test.txt" + alice ##> "/_send @2 json {\"msgContent\":{\"type\":\"voice\", \"duration\":10, \"text\":\"\"}, \"filePath\":\"./tests/fixtures/logo.jpg\"}" + alice <# "@bob voice message (00:10)" + alice <# "/f @bob ./tests/fixtures/logo.jpg" -- below is not shown in "sent" mode -- alice <## "use /fc 1 to cancel sending" - bob <# "alice> sends file test.txt (11 bytes / 11 bytes)" + bob <# "alice> voice message (00:10)" + bob <# "alice> sends file logo.jpg (31.3 KiB / 32080 bytes)" -- below is not shown in "sent" mode -- bob <## "use /fr 1 [/ | ] to receive it" - bob <## "started receiving file 1 (test.txt) from alice" + bob <## "started receiving file 1 (logo.jpg) from alice" concurrently_ - (alice <## "completed sending file 1 (test.txt) to bob") - (bob <## "completed receiving file 1 (test.txt) from alice") - src <- B.readFile "./tests/fixtures/test.txt" - dest <- B.readFile "./tests/tmp/test.txt" + (alice <## "completed sending file 1 (logo.jpg) to bob") + (bob <## "completed receiving file 1 (logo.jpg) from alice") + src <- B.readFile "./tests/fixtures/logo.jpg" + dest <- B.readFile "./tests/tmp/logo.jpg" dest `shouldBe` src testReceiveInline :: IO () @@ -1791,29 +1797,33 @@ testInlineGroupFileTransfer = bob <## "ok" cath ##> "/_files_folder ./tests/tmp/cath/" cath <## "ok" - alice #> "/f #team ./tests/fixtures/test.jpg" + alice ##> "/_send #1 json {\"msgContent\":{\"type\":\"voice\", \"duration\":10, \"text\":\"\"}, \"filePath\":\"./tests/fixtures/logo.jpg\"}" + alice <# "#team voice message (00:10)" + alice <# "/f #team ./tests/fixtures/logo.jpg" -- below is not shown in "sent" mode -- alice <## "use /fc 1 to cancel sending" concurrentlyN_ [ do alice - <### [ "completed sending file 1 (test.jpg) to bob", - "completed sending file 1 (test.jpg) to cath" + <### [ "completed sending file 1 (logo.jpg) to bob", + "completed sending file 1 (logo.jpg) to cath" ] alice ##> "/fs 1" - alice <##. "sending file 1 (test.jpg) complete", + alice <##. "sending file 1 (logo.jpg) complete", do - bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)" - bob <## "started receiving file 1 (test.jpg) from alice" - bob <## "completed receiving file 1 (test.jpg) from alice", + bob <# "#team alice> voice message (00:10)" + bob <# "#team alice> sends file logo.jpg (31.3 KiB / 32080 bytes)" + bob <## "started receiving file 1 (logo.jpg) from alice" + bob <## "completed receiving file 1 (logo.jpg) from alice", do - cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)" - cath <## "started receiving file 1 (test.jpg) from alice" - cath <## "completed receiving file 1 (test.jpg) from alice" + cath <# "#team alice> voice message (00:10)" + cath <# "#team alice> sends file logo.jpg (31.3 KiB / 32080 bytes)" + cath <## "started receiving file 1 (logo.jpg) from alice" + cath <## "completed receiving file 1 (logo.jpg) from alice" ] - src <- B.readFile "./tests/fixtures/test.jpg" - dest1 <- B.readFile "./tests/tmp/bob/test.jpg" - dest2 <- B.readFile "./tests/tmp/cath/test.jpg" + src <- B.readFile "./tests/fixtures/logo.jpg" + dest1 <- B.readFile "./tests/tmp/bob/logo.jpg" + dest2 <- B.readFile "./tests/tmp/cath/logo.jpg" dest1 `shouldBe` src dest2 `shouldBe` src where @@ -1828,29 +1838,33 @@ testSmallInlineGroupFileTransfer = bob <## "ok" cath ##> "/_files_folder ./tests/tmp/cath/" cath <## "ok" - alice #> "/f #team ./tests/fixtures/test.txt" + alice ##> "/_send #1 json {\"msgContent\":{\"type\":\"voice\", \"duration\":10, \"text\":\"\"}, \"filePath\":\"./tests/fixtures/logo.jpg\"}" + alice <# "#team voice message (00:10)" + alice <# "/f #team ./tests/fixtures/logo.jpg" -- below is not shown in "sent" mode -- alice <## "use /fc 1 to cancel sending" concurrentlyN_ [ do alice - <### [ "completed sending file 1 (test.txt) to bob", - "completed sending file 1 (test.txt) to cath" + <### [ "completed sending file 1 (logo.jpg) to bob", + "completed sending file 1 (logo.jpg) to cath" ] alice ##> "/fs 1" - alice <##. "sending file 1 (test.txt) complete", + alice <##. "sending file 1 (logo.jpg) complete", do - bob <# "#team alice> sends file test.txt (11 bytes / 11 bytes)" - bob <## "started receiving file 1 (test.txt) from alice" - bob <## "completed receiving file 1 (test.txt) from alice", + bob <# "#team alice> voice message (00:10)" + bob <# "#team alice> sends file logo.jpg (31.3 KiB / 32080 bytes)" + bob <## "started receiving file 1 (logo.jpg) from alice" + bob <## "completed receiving file 1 (logo.jpg) from alice", do - cath <# "#team alice> sends file test.txt (11 bytes / 11 bytes)" - cath <## "started receiving file 1 (test.txt) from alice" - cath <## "completed receiving file 1 (test.txt) from alice" + cath <# "#team alice> voice message (00:10)" + cath <# "#team alice> sends file logo.jpg (31.3 KiB / 32080 bytes)" + cath <## "started receiving file 1 (logo.jpg) from alice" + cath <## "completed receiving file 1 (logo.jpg) from alice" ] - src <- B.readFile "./tests/fixtures/test.txt" - dest1 <- B.readFile "./tests/tmp/bob/test.txt" - dest2 <- B.readFile "./tests/tmp/cath/test.txt" + src <- B.readFile "./tests/fixtures/logo.jpg" + dest1 <- B.readFile "./tests/tmp/bob/logo.jpg" + dest2 <- B.readFile "./tests/tmp/cath/logo.jpg" dest1 `shouldBe` src dest2 `shouldBe` src diff --git a/tests/fixtures/logo.jpg b/tests/fixtures/logo.jpg new file mode 100644 index 0000000000..bd9291fd21 Binary files /dev/null and b/tests/fixtures/logo.jpg differ