core: only send voice messages without acceptance (#1444)

* core: only send voice messages without acceptance

* remove some unnecessary changes

* update

* refactor receiveInlineMode

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

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

src/Simplex/Chat/Mobile.hs

@@ -129,6 +129,7 @@ mobileChatOpts =
       chatCmd = "",
       chatCmdDelay = 3,
       chatServerPort = Nothing,
+      allowInstantFiles = True,
       maintenance = True
     }
 

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

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_

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"]

tests/ChatClient.hs

@@ -59,6 +59,7 @@ testOpts =
       chatCmd = "",
       chatCmdDelay = 3,
       chatServerPort = Nothing,
+      allowInstantFiles = True,
       maintenance = False
     }
 

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 [<dir>/ | <path>] 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 [<dir>/ | <path>] 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