From 46c6f5e615082bd34c88723053fbee6cd2addc56 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Fri, 16 Jun 2023 13:43:06 +0100 Subject: [PATCH] cli: option to auto-accept files (#2540) * cli: option to auto-accept files * auto-accept works * test * add missing field --- src/Simplex/Chat.hs | 26 +++++++++++++++++--------- src/Simplex/Chat/Controller.hs | 1 + src/Simplex/Chat/Mobile.hs | 1 + src/Simplex/Chat/Options.hs | 12 ++++++++++++ tests/ChatClient.hs | 1 + tests/ChatTests/Files.hs | 28 ++++++++++++++++++++++++++++ 6 files changed, 60 insertions(+), 9 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index b983c1926..c457f474f 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -112,6 +112,7 @@ defaultChatConfig = fileChunkSize = 15780, -- do not change xftpDescrPartSize = 14000, inlineFiles = defaultInlineFilesConfig, + autoAcceptFileSize = 0, xftpFileConfig = Just defaultXFTPFileConfig, tempDir = Nothing, showReactions = False, @@ -158,9 +159,9 @@ createChatDatabase filePrefix key confirmMigrations = runExceptT $ 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, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, showReactions, allowInstantFiles} sendToast = do - let inlineFiles' = if allowInstantFiles then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False} - config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles'} +newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agentConfig = aCfg, defaultServers, inlineFiles, tempDir} ChatOpts {coreOptions = CoreChatOpts {smpServers, xftpServers, networkConfig, logLevel, logConnections, logServerHosts, logFile, tbqSize}, optFilesFolder, showReactions, allowInstantFiles, autoAcceptFileSize} sendToast = do + let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False} + config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles', autoAcceptFileSize} sendNotification = fromMaybe (const $ pure ()) sendToast firstTime = dbNew chatStore activeTo <- newTVarIO ActiveNone @@ -3332,8 +3333,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do let ExtMsgContent _ _ itemTTL live_ = mcExtMsgContent mc timed_ = rcvContactCITimed ct itemTTL live = fromMaybe False live_ - ciFile_ <- processFileInvitation fInv_ content $ \db -> createRcvFileTransfer db userId ct - ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ timed_ live + file_ <- processFileInvitation fInv_ content $ \db -> createRcvFileTransfer db userId ct + ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live + autoAcceptFile file_ whenContactNtfs user ct $ do showMsgToast (c <> "> ") content formattedText setActive $ ActiveC c @@ -3344,6 +3346,11 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do toView $ CRNewChatItem user (AChatItem SCTDirect SMDRcv (DirectChat ct) ci {reactions}) pure ci + autoAcceptFile :: Maybe (RcvFileTransfer, CIFile 'MDRcv) -> m () + autoAcceptFile = mapM_ $ \(ft, CIFile {fileSize}) -> do + ChatConfig {autoAcceptFileSize = sz} <- asks config + when (sz > fileSize) $ receiveFile' user ft Nothing Nothing >>= toView + messageFileDescription :: Contact -> SharedMsgId -> FileDescr -> MsgMeta -> m () messageFileDescription ct@Contact {contactId} sharedMsgId fileDescr msgMeta = do checkIntegrityCreateItem (CDDirectRcv ct) msgMeta @@ -3380,7 +3387,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do cancelGroupMessageFile _gInfo _m _sharedMsgId _msgMeta = do pure () - processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv)) + processFileInvitation :: Maybe FileInvitation -> MsgContent -> (DB.Connection -> FileInvitation -> Maybe InlineFileMode -> Integer -> ExceptT StoreError IO RcvFileTransfer) -> m (Maybe (RcvFileTransfer, CIFile 'MDRcv)) processFileInvitation fInv_ mc createRcvFT = forM fInv_ $ \fInv@FileInvitation {fileName, fileSize} -> do ChatConfig {fileChunkSize} <- asks config inline <- receiveInlineMode fInv (Just mc) fileChunkSize @@ -3392,7 +3399,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do withStore' $ \db -> startRcvInlineFT db user ft fPath inline pure (Just fPath, CIFSRcvAccepted) _ -> pure (Nothing, CIFSRcvInvitation) - pure CIFile {fileId, fileName, fileSize, filePath, fileStatus, fileProtocol} + pure (ft, CIFile {fileId, fileName, fileSize, filePath, fileStatus, fileProtocol}) messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> Maybe Int -> Maybe Bool -> m () messageUpdate ct@Contact {contactId, localDisplayName = c} sharedMsgId mc msg@RcvMessage {msgId} msgMeta ttl live_ = do @@ -3503,8 +3510,9 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do let ExtMsgContent _ _ itemTTL live_ = mcExtMsgContent mc timed_ = rcvGroupCITimed gInfo itemTTL live = fromMaybe False live_ - ciFile_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m - ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) ciFile_ timed_ live + file_ <- processFileInvitation fInv_ content $ \db -> createRcvGroupFileTransfer db userId m + ChatItem {formattedText} <- newChatItem (CIRcvMsgContent content) (snd <$> file_) timed_ live + autoAcceptFile file_ let g = groupName' gInfo whenGroupNtfs user gInfo $ do showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 951ddb773..54ec85543 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -103,6 +103,7 @@ data ChatConfig = ChatConfig fileChunkSize :: Integer, xftpDescrPartSize :: Int, inlineFiles :: InlineFilesConfig, + autoAcceptFileSize :: Integer, xftpFileConfig :: Maybe XFTPFileConfig, -- Nothing - XFTP is disabled tempDir :: Maybe FilePath, showReactions :: Bool, diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 10badd0e2..eab0cf4d6 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -130,6 +130,7 @@ mobileChatOpts dbFilePrefix dbKey = optFilesFolder = Nothing, showReactions = False, allowInstantFiles = True, + autoAcceptFileSize = 0, muteNotifications = True, maintenance = True } diff --git a/src/Simplex/Chat/Options.hs b/src/Simplex/Chat/Options.hs index e16beb9d4..0b39b8dd4 100644 --- a/src/Simplex/Chat/Options.hs +++ b/src/Simplex/Chat/Options.hs @@ -22,6 +22,7 @@ import qualified Data.ByteString.Char8 as B import Numeric.Natural (Natural) import Options.Applicative import Simplex.Chat.Controller (ChatLogLevel (..), updateStr, versionNumber, versionString) +import Simplex.FileTransfer.Description (mb) import Simplex.Messaging.Client (NetworkConfig (..), defaultNetworkConfig) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (parseAll) @@ -37,6 +38,7 @@ data ChatOpts = ChatOpts optFilesFolder :: Maybe FilePath, showReactions :: Bool, allowInstantFiles :: Bool, + autoAcceptFileSize :: Integer, muteNotifications :: Bool, maintenance :: Bool } @@ -236,6 +238,15 @@ chatOptsP appDir defaultDbFileName = do <> short 'f' <> help "Send and receive instant files without acceptance" ) + autoAcceptFileSize <- + flag' (mb 1) (short 'a' <> help "Automatically accept files up to 1MB") + <|> option + auto + ( long "auto-accept-files" + <> metavar "FILE_SIZE" + <> help "Automatically accept files up to specified size" + <> value 0 + ) muteNotifications <- switch ( long "mute" @@ -256,6 +267,7 @@ chatOptsP appDir defaultDbFileName = do optFilesFolder, showReactions, allowInstantFiles, + autoAcceptFileSize, muteNotifications, maintenance } diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index b81356908..6cc5cc1d0 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -74,6 +74,7 @@ testOpts = optFilesFolder = Nothing, showReactions = True, allowInstantFiles = True, + autoAcceptFileSize = 0, muteNotifications = True, maintenance = False } diff --git a/tests/ChatTests/Files.hs b/tests/ChatTests/Files.hs index 9ecf95a72..83c99b0c1 100644 --- a/tests/ChatTests/Files.hs +++ b/tests/ChatTests/Files.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PostfixOperators #-} @@ -68,6 +69,7 @@ chatFileTests = do xit' "receive file marked to receive on chat start" testXFTPMarkToReceive it "error receiving file" testXFTPRcvError it "cancel receiving file, repeat receive" testXFTPCancelRcvRepeat + it "should accept file automatically with CLI option" testAutoAcceptFile runTestFileTransfer :: HasCallStack => TestCC -> TestCC -> IO () runTestFileTransfer alice bob = do @@ -1386,6 +1388,32 @@ testXFTPCancelRcvRepeat = where cfg = testCfg {xftpFileConfig = Just $ XFTPFileConfig {minFileSize = 0}, tempDir = Just "./tests/tmp"} +testAutoAcceptFile :: HasCallStack => FilePath -> IO () +testAutoAcceptFile = + testChatCfgOpts2 cfg opts aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do + connectUsers alice bob + bob ##> "/_files_folder ./tests/tmp/bob_files" + bob <## "ok" + alice #> "/f @bob ./tests/fixtures/test.jpg" + alice <## "use /fc 1 to cancel sending" + alice <## "completed uploading file 1 (test.jpg) for bob" + bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)" + bob <## "use /fr 1 [/ | ] to receive it" + bob <## "saving file 1 from alice to test.jpg" + bob <## "started receiving file 1 (test.jpg) from alice" + bob <## "completed receiving file 1 (test.jpg) from alice" + (bob "/f @bob ./tests/fixtures/test_1MB.pdf" + alice <## "use /fc 2 to cancel sending" + alice <## "completed uploading file 2 (test_1MB.pdf) for bob" + bob <# "alice> sends file test_1MB.pdf (1017.7 KiB / 1042157 bytes)" + bob <## "use /fr 2 [/ | ] to receive it" + -- no auto accept for large files + (bob IO [String] xftpCLI params = lines <$> capture_ (withArgs params xftpClientCLI)