diff --git a/apps/multiplatform/android/src/main/java/chat/simplex/app/SimplexApp.kt b/apps/multiplatform/android/src/main/java/chat/simplex/app/SimplexApp.kt index 49edde55bb..6adaa1d4e0 100644 --- a/apps/multiplatform/android/src/main/java/chat/simplex/app/SimplexApp.kt +++ b/apps/multiplatform/android/src/main/java/chat/simplex/app/SimplexApp.kt @@ -37,7 +37,7 @@ import java.util.concurrent.TimeUnit const val TAG = "SIMPLEX" -class SimplexApp: Application(), LifecycleEventObserver, Configuration.Provider { +class SimplexApp: Application(), LifecycleEventObserver { val chatModel: ChatModel get() = chatController.chatModel @@ -66,7 +66,7 @@ class SimplexApp: Application(), LifecycleEventObserver, Configuration.Provider } } context = this - initHaskell() + initHaskell(packageName) initMultiplatform() runMigrations() tmpDir.deleteRecursively() @@ -391,9 +391,4 @@ class SimplexApp: Application(), LifecycleEventObserver, Configuration.Provider } } } - - // Fix for an exception: - // WorkManager is not initialized properly. You have explicitly disabled WorkManagerInitializer in your manifest, have not manually called WorkManager#initialize at this point, and your Application does not implement Configuration.Provider. - override val workManagerConfiguration: Configuration - get() = Configuration.Builder().build() } diff --git a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/AppCommon.android.kt b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/AppCommon.android.kt index 8cd51e8298..cd1672f3e9 100644 --- a/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/AppCommon.android.kt +++ b/apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/AppCommon.android.kt @@ -31,22 +31,19 @@ lateinit var androidAppContext: Context var mainActivity: WeakReference = WeakReference(null) var callActivity: WeakReference = WeakReference(null) -fun initHaskell() { - val socketName = "chat.simplex.app.local.socket.address.listen.native.cmd2" + Random.nextLong(100000) +fun initHaskell(packageName: String) { val s = Semaphore(0) thread(name="stdout/stderr pipe") { Log.d(TAG, "starting server") - var server: LocalServerSocket? = null - for (i in 0..100) { - try { - server = LocalServerSocket(socketName + i) - break - } catch (e: IOException) { - Log.e(TAG, e.stackTraceToString()) - } - } - if (server == null) { - throw Error("Unable to setup local server socket. Contact developers") + val server: LocalServerSocket + try { + server = LocalServerSocket(packageName) + } catch (e: IOException) { + Log.e(TAG, e.stackTraceToString()) + Log.e(TAG, "Unable to setup local server socket. Contact developers") + s.release() + // Will not have logs from backend + return@thread } Log.d(TAG, "started server") s.release() @@ -60,7 +57,7 @@ fun initHaskell() { Log.d(TAG, "starting receiver loop") while (true) { val line = input.readLine() ?: break - Log.w("$TAG (stdout/stderr)", line) + Log.w(TAG, "(stdout/stderr) $line") logbuffer.add(line) } Log.w(TAG, "exited receiver loop") @@ -70,7 +67,7 @@ fun initHaskell() { System.loadLibrary("app-lib") s.acquire() - pipeStdOutToSocket(socketName) + pipeStdOutToSocket(packageName) initHS() } diff --git a/cabal.project b/cabal.project index 51b35e0db7..7fb9f6d353 100644 --- a/cabal.project +++ b/cabal.project @@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: f5e666ae4f41351d5d5ac416cd6fb1d5fadc8ab7 + tag: 309ef3766cc6b69e0c3aa0c140faab25383b732a source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index ec230ee09e..52dd21e8cd 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."f5e666ae4f41351d5d5ac416cd6fb1d5fadc8ab7" = "1cq9apm9vp40v4ck0wcbis4463q3cjd9fbx5511hhh6lah6llifc"; + "https://github.com/simplex-chat/simplexmq.git"."309ef3766cc6b69e0c3aa0c140faab25383b732a" = "1ch03kizvsq3m5jwravyil529mc0lcfwj43czb1nhykbg8yb3cjv"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index fb5c4b4962..9157ac7509 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -106,7 +106,7 @@ import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), Migrati import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..)) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations -import Simplex.Messaging.Client (NetworkConfig (..), ProxyClientError (..), SocksMode (SMAlways), defaultNetworkConfig) +import Simplex.Messaging.Client (NetworkConfig (..), ProxyClientError (..), SocksMode (SMAlways), defaultNetworkConfig, textToHostMode) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import qualified Simplex.Messaging.Crypto.File as CF @@ -120,7 +120,7 @@ import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.ServiceScheme (ServiceScheme (..)) import qualified Simplex.Messaging.TMap as TM import Simplex.Messaging.Transport (TransportError (..)) -import Simplex.Messaging.Transport.Client (defaultSocksProxy) +import Simplex.Messaging.Transport.Client (defaultSocksProxyWithAuth) import Simplex.Messaging.Util import Simplex.Messaging.Version import Simplex.RemoteControl.Invitation (RCInvitation (..), RCSignedInvitation (..)) @@ -342,11 +342,11 @@ newChatController userServers user' = useServers config protocol <$> withTransaction chatStore (`getProtocolServers` user') updateNetworkConfig :: NetworkConfig -> SimpleNetCfg -> NetworkConfig -updateNetworkConfig cfg SimpleNetCfg {socksProxy, socksMode, smpProxyMode_, smpProxyFallback_, tcpTimeout_, logTLSErrors} = +updateNetworkConfig cfg SimpleNetCfg {socksProxy, socksMode, hostMode, requiredHostMode, smpProxyMode_, smpProxyFallback_, tcpTimeout_, logTLSErrors} = let cfg1 = maybe cfg (\smpProxyMode -> cfg {smpProxyMode}) smpProxyMode_ cfg2 = maybe cfg1 (\smpProxyFallback -> cfg1 {smpProxyFallback}) smpProxyFallback_ cfg3 = maybe cfg2 (\tcpTimeout -> cfg2 {tcpTimeout, tcpConnectTimeout = (tcpTimeout * 3) `div` 2}) tcpTimeout_ - in cfg3 {socksProxy, socksMode, logTLSErrors} + in cfg3 {socksProxy, socksMode, hostMode, requiredHostMode, logTLSErrors} withChatLock :: String -> CM a -> CM a withChatLock name action = asks chatLock >>= \l -> withLock l name action @@ -995,7 +995,7 @@ processChatCommand' vr = \case Just err -> pure $ itemIdWithoutFile err Nothing -> case fileSource of Just CryptoFile {filePath} -> do - exists <- doesFileExist . maybe filePath ( filePath) =<< chatReadVar filesFolder + exists <- doesFileExist =<< lift (toFSFilePath filePath) pure $ if exists then (Just itemId, Nothing) else itemIdWithoutFile FFEMissing Nothing -> pure $ itemIdWithoutFile FFEMissing where @@ -1079,27 +1079,28 @@ processChatCommand' vr = \case Just CIFFUnknown -> ciff Just prevCIFF -> Just prevCIFF forwardContent :: ChatItem c d -> MsgContent -> CM (Maybe (MsgContent, Maybe CryptoFile)) - forwardContent ChatItem {file = Nothing} mc = pure $ Just (mc, Nothing) - forwardContent ChatItem {file = Just ciFile} mc = case ciFile of - CIFile {fileName, fileSource = Just fromCF@CryptoFile {filePath}} -> - chatReadVar filesFolder >>= \case - Nothing -> - ifM (doesFileExist filePath) (pure $ Just (mc, Just fromCF)) (pure contentWithoutFile) - Just filesFolder -> do - let fsFromPath = filesFolder filePath - ifM - (doesFileExist fsFromPath) - ( do - fsNewPath <- liftIO $ filesFolder `uniqueCombine` fileName - liftIO $ B.writeFile fsNewPath "" -- create empty file - encrypt <- chatReadVar encryptLocalFiles - cfArgs <- if encrypt then Just <$> (atomically . CF.randomArgs =<< asks random) else pure Nothing - let toCF = CryptoFile fsNewPath cfArgs - -- to keep forwarded file in case original is deleted - liftIOEither $ runExceptT $ withExceptT (ChatError . CEInternalError . show) $ copyCryptoFile (fromCF {filePath = fsFromPath} :: CryptoFile) toCF - pure $ Just (mc, Just (toCF {filePath = takeFileName fsNewPath} :: CryptoFile)) - ) - (pure contentWithoutFile) + forwardContent ChatItem {file} mc = case file of + Nothing -> pure $ Just (mc, Nothing) + Just CIFile {fileName, fileStatus, fileSource = Just fromCF@CryptoFile {filePath}} + | ciFileLoaded fileStatus -> + chatReadVar filesFolder >>= \case + Nothing -> + ifM (doesFileExist filePath) (pure $ Just (mc, Just fromCF)) (pure contentWithoutFile) + Just filesFolder -> do + let fsFromPath = filesFolder filePath + ifM + (doesFileExist fsFromPath) + ( do + fsNewPath <- liftIO $ filesFolder `uniqueCombine` fileName + liftIO $ B.writeFile fsNewPath "" -- create empty file + encrypt <- chatReadVar encryptLocalFiles + cfArgs <- if encrypt then Just <$> (atomically . CF.randomArgs =<< asks random) else pure Nothing + let toCF = CryptoFile fsNewPath cfArgs + -- to keep forwarded file in case original is deleted + liftIOEither $ runExceptT $ withExceptT (ChatError . CEInternalError . show) $ copyCryptoFile (fromCF {filePath = fsFromPath} :: CryptoFile) toCF + pure $ Just (mc, Just (toCF {filePath = takeFileName fsNewPath} :: CryptoFile)) + ) + (pure contentWithoutFile) _ -> pure contentWithoutFile where contentWithoutFile = case mc of @@ -3444,7 +3445,7 @@ callStatusItemContent user Contact {contactId} chatItemId receivedStatus = do -- used during file transfer for actual operations with file system toFSFilePath :: FilePath -> CM' FilePath toFSFilePath f = - maybe f ( f) <$> (readTVarIO =<< asks filesFolder) + maybe f ( f) <$> (chatReadVar' filesFolder) setFileToEncrypt :: RcvFileTransfer -> CM RcvFileTransfer setFileToEncrypt ft@RcvFileTransfer {fileId} = do @@ -3566,7 +3567,9 @@ receiveViaCompleteFD user fileId RcvFileDescr {fileDescrText, fileDescrComplete} relaysNotApproved :: [XFTPServer] -> CM () relaysNotApproved unknownSrvs = do aci_ <- resetRcvCIFileStatus user fileId CIFSRcvInvitation - forM_ aci_ $ \aci -> toView $ CRChatItemUpdated user aci + forM_ aci_ $ \aci -> do + cleanupACIFile aci + toView $ CRChatItemUpdated user aci throwChatError $ CEFileNotApproved fileId unknownSrvs getNetworkConfig :: CM' NetworkConfig @@ -4290,14 +4293,22 @@ processAgentMsgRcvFile _corrId aFileId msg = do RFERR e | e == FILE NOT_APPROVED -> do aci_ <- resetRcvCIFileStatus user fileId CIFSRcvAborted + forM_ aci_ cleanupACIFile agentXFTPDeleteRcvFile aFileId fileId forM_ aci_ $ \aci -> toView $ CRChatItemUpdated user aci | otherwise -> do - ci <- withStore $ \db -> do + aci_ <- withStore $ \db -> do liftIO $ updateFileCancelled db user fileId (CIFSRcvError $ agentFileError e) lookupChatItemByFileId db vr user fileId + forM_ aci_ cleanupACIFile agentXFTPDeleteRcvFile aFileId fileId - toView $ CRRcvFileError user ci e ft + toView $ CRRcvFileError user aci_ e ft + +cleanupACIFile :: AChatItem -> CM () +cleanupACIFile (AChatItem _ _ _ ChatItem {file = Just CIFile {fileSource = Just CryptoFile {filePath}}}) = do + fsFilePath <- lift $ toFSFilePath filePath + removeFile fsFilePath `catchChatError` \_ -> pure () +cleanupACIFile _ = pure () processAgentMessageConn :: VersionRangeChat -> User -> ACorrId -> ConnId -> AEvent 'AEConn -> CM () processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = do @@ -8309,14 +8320,16 @@ chatCommandP = <|> ("yes" $> TMEEnableKeepTTL) <|> ("no" $> TMEDisableKeepTTL) netCfgP = do - socksProxy <- "socks=" *> ("off" $> Nothing <|> "on" $> Just defaultSocksProxy <|> Just <$> strP) + socksProxy <- "socks=" *> ("off" $> Nothing <|> "on" $> Just defaultSocksProxyWithAuth <|> Just <$> strP) socksMode <- " socks-mode=" *> strP <|> pure SMAlways + hostMode <- " host-mode=" *> (textToHostMode . safeDecodeUtf8 <$?> A.takeTill (== ' ')) <|> pure (defaultHostMode socksProxy) + requiredHostMode <- " required-host-mode" *> onOffP <|> pure False smpProxyMode_ <- optional $ " smp-proxy=" *> strP smpProxyFallback_ <- optional $ " smp-proxy-fallback=" *> strP t_ <- optional $ " timeout=" *> A.decimal logTLSErrors <- " log=" *> onOffP <|> pure False let tcpTimeout_ = (1000000 *) <$> t_ - pure $ SimpleNetCfg {socksProxy, socksMode, smpProxyMode_, smpProxyFallback_, tcpTimeout_, logTLSErrors} + pure $ SimpleNetCfg {socksProxy, socksMode, hostMode, requiredHostMode, smpProxyMode_, smpProxyFallback_, tcpTimeout_, logTLSErrors} dbKeyP = nonEmptyKey <$?> strP nonEmptyKey k@(DBEncryptionKey s) = if BA.null s then Left "empty key" else Right k dbEncryptionConfig currentKey newKey = DBEncryptionConfig {currentKey, newKey, keepKey = Just False} diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 99739cc6bf..1e00172cea 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -76,7 +76,7 @@ import Simplex.Messaging.Agent.Protocol import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation, SQLiteStore, UpMigration, withTransaction, withTransactionPriority) import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..)) import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB -import Simplex.Messaging.Client (SMPProxyFallback (..), SMPProxyMode (..), SocksMode (..)) +import Simplex.Messaging.Client (HostMode (..), SMPProxyFallback (..), SMPProxyMode (..), SocksMode (..)) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..)) import qualified Simplex.Messaging.Crypto.File as CF @@ -87,7 +87,7 @@ import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, p import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, NtfServer, ProtocolType (..), ProtocolTypeI, QueueId, SMPMsgMeta (..), SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServer, userProtocol) import Simplex.Messaging.TMap (TMap) import Simplex.Messaging.Transport (TLS, simplexMQVersion) -import Simplex.Messaging.Transport.Client (SocksProxy, TransportHost) +import Simplex.Messaging.Transport.Client (SocksProxyWithAuth, TransportHost) import Simplex.Messaging.Util (allFinally, catchAllErrors, catchAllErrors', tryAllErrors, tryAllErrors', (<$$>)) import Simplex.RemoteControl.Client import Simplex.RemoteControl.Invitation (RCSignedInvitation, RCVerifiedInvitation) @@ -984,8 +984,10 @@ data AppFilePathsConfig = AppFilePathsConfig deriving (Show) data SimpleNetCfg = SimpleNetCfg - { socksProxy :: Maybe SocksProxy, + { socksProxy :: Maybe SocksProxyWithAuth, socksMode :: SocksMode, + hostMode :: HostMode, + requiredHostMode :: Bool, smpProxyMode_ :: Maybe SMPProxyMode, smpProxyFallback_ :: Maybe SMPProxyFallback, tcpTimeout_ :: Maybe Int, @@ -994,7 +996,7 @@ data SimpleNetCfg = SimpleNetCfg deriving (Show) defaultSimpleNetCfg :: SimpleNetCfg -defaultSimpleNetCfg = SimpleNetCfg Nothing SMAlways Nothing Nothing Nothing False +defaultSimpleNetCfg = SimpleNetCfg Nothing SMAlways HMOnionViaSocks True Nothing Nothing Nothing False data ContactSubStatus = ContactSubStatus { contact :: Contact, @@ -1472,7 +1474,7 @@ $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "GLP") ''GroupLinkPlan) $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CP") ''ConnectionPlan) -$(JQ.deriveJSON defaultJSON ''ForwardConfirmation) +$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "FC") ''ForwardConfirmation) $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "CE") ''ChatErrorType) diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 2b21857408..50e68e5bf4 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -35,7 +35,7 @@ import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1, encodeUtf8) -import Data.Time.Clock (UTCTime, diffUTCTime, nominalDay, NominalDiffTime) +import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, nominalDay) import Data.Type.Equality import Data.Typeable (Typeable) import Database.SQLite.Simple.FromField (FromField (..)) @@ -596,7 +596,7 @@ ciFileLoaded = \case CIFSInvalid {} -> False data ForwardFileError = FFENotAccepted FileTransferId | FFEInProgress | FFEFailed | FFEMissing - deriving (Eq, Ord) + deriving (Eq, Ord) ciFileForwardError :: FileTransferId -> CIFileStatus d -> Maybe ForwardFileError ciFileForwardError fId = \case diff --git a/src/Simplex/Chat/Options.hs b/src/Simplex/Chat/Options.hs index 0b5961b042..cd44966cc2 100644 --- a/src/Simplex/Chat/Options.hs +++ b/src/Simplex/Chat/Options.hs @@ -13,6 +13,7 @@ module Simplex.Chat.Options coreChatOptsP, getChatOpts, protocolServersP, + defaultHostMode, ) where @@ -20,6 +21,7 @@ import Control.Logger.Simple (LogLevel (..)) import qualified Data.Attoparsec.ByteString.Char8 as A import Data.ByteArray (ScrubbedBytes) import qualified Data.ByteString.Char8 as B +import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) @@ -27,11 +29,11 @@ import Numeric.Natural (Natural) import Options.Applicative import Simplex.Chat.Controller (ChatLogLevel (..), SimpleNetCfg (..), updateStr, versionNumber, versionString) import Simplex.FileTransfer.Description (mb) -import Simplex.Messaging.Client (SocksMode (..)) +import Simplex.Messaging.Client (HostMode (..), SocksMode (..), textToHostMode) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (parseAll) import Simplex.Messaging.Protocol (ProtoServerWithAuth, ProtocolTypeI, SMPServerWithAuth, XFTPServerWithAuth) -import Simplex.Messaging.Transport.Client (defaultSocksProxy) +import Simplex.Messaging.Transport.Client (SocksProxyWithAuth (..), SocksAuth (..), defaultSocksProxyWithAuth) import System.FilePath (combine) data ChatOpts = ChatOpts @@ -123,7 +125,7 @@ coreChatOptsP appDir defaultDbFileName = do <> value [] ) socksProxy <- - flag' (Just defaultSocksProxy) (short 'x' <> help "Use local SOCKS5 proxy at :9050") + flag' (Just defaultSocksProxyWithAuth) (short 'x' <> help "Use local SOCKS5 proxy at :9050") <|> option strParse ( long "socks-proxy" @@ -139,6 +141,19 @@ coreChatOptsP appDir defaultDbFileName = do <> help "Use SOCKS5 proxy: always (default), onion (with onion-only relays)" <> value SMAlways ) + hostMode_ <- + optional $ + option + parseHostMode + ( long "host-mode" + <> metavar "HOST_MODE" + <> help "Preferred server host type: onion (when SOCKS proxy with isolate-by-auth is used), public" + ) + requiredHostMode <- + switch + ( long "required-host-mode" + <> help "Refuse connection if preferred server host type is not available" + ) smpProxyMode_ <- optional $ option @@ -226,7 +241,17 @@ coreChatOptsP appDir defaultDbFileName = do dbKey, smpServers, xftpServers, - simpleNetCfg = SimpleNetCfg {socksProxy, socksMode, smpProxyMode_, smpProxyFallback_, tcpTimeout_ = Just $ useTcpTimeout socksProxy t, logTLSErrors}, + simpleNetCfg = + SimpleNetCfg + { socksProxy, + socksMode, + hostMode = fromMaybe (defaultHostMode socksProxy) hostMode_, + requiredHostMode, + smpProxyMode_, + smpProxyFallback_, + tcpTimeout_ = Just $ useTcpTimeout socksProxy t, + logTLSErrors + }, logLevel, logConnections = logConnections || logLevel <= CLLInfo, logServerHosts = logServerHosts || logLevel <= CLLInfo, @@ -240,6 +265,11 @@ coreChatOptsP appDir defaultDbFileName = do useTcpTimeout p t = 1000000 * if t > 0 then t else maybe 7 (const 15) p defaultDbFilePath = combine appDir defaultDbFileName +defaultHostMode :: Maybe SocksProxyWithAuth -> HostMode +defaultHostMode = \case + Just (SocksProxyWithAuth SocksIsolateByAuth _) -> HMOnionViaSocks; + _ -> HMPublic + chatOptsP :: FilePath -> FilePath -> Parser ChatOpts chatOptsP appDir defaultDbFileName = do coreOptions <- coreChatOptsP appDir defaultDbFileName @@ -360,6 +390,9 @@ parseProtocolServers = eitherReader $ parseAll protocolServersP . B.pack strParse :: StrEncoding a => ReadM a strParse = eitherReader $ parseAll strP . encodeUtf8 . T.pack +parseHostMode :: ReadM HostMode +parseHostMode = eitherReader $ textToHostMode . T.pack + parseServerPort :: ReadM (Maybe String) parseServerPort = eitherReader $ parseAll serverPortP . B.pack diff --git a/tests/ChatTests/Forward.hs b/tests/ChatTests/Forward.hs index 8f1595fd6c..3b861a8417 100644 --- a/tests/ChatTests/Forward.hs +++ b/tests/ChatTests/Forward.hs @@ -681,6 +681,7 @@ testMultiForwardFiles = copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test.jpg" copyFile "./tests/fixtures/test.pdf" "./tests/tmp/alice_app_files/test.pdf" copyFile "./tests/fixtures/test_1MB.pdf" "./tests/tmp/alice_app_files/test_1MB.pdf" + copyFile "./tests/fixtures/logo.jpg" "./tests/tmp/alice_app_files/logo.jpg" setRelativePaths bob "./tests/tmp/bob_app_files" "./tests/tmp/bob_xftp" setRelativePaths cath "./tests/tmp/cath_app_files" "./tests/tmp/cath_xftp" connectUsers alice bob @@ -699,7 +700,8 @@ testMultiForwardFiles = cm2 = "{\"filePath\": \"test.jpg\", \"msgContent\": {\"type\": \"image\", \"image\":\"" <> T.unpack img <> "\", \"text\": \"\"}}" cm3 = "{\"filePath\": \"test.pdf\", \"msgContent\": {\"type\": \"file\", \"text\": \"\"}}" cm4 = "{\"filePath\": \"test_1MB.pdf\", \"msgContent\": {\"type\": \"file\", \"text\": \"message with large file\"}}" - alice ##> ("/_send @2 json [" <> cm1 <> "," <> cm2 <> "," <> cm3 <> "," <> cm4 <> "]") + cm5 = "{\"filePath\": \"logo.jpg\", \"msgContent\": {\"type\": \"image\", \"image\":\"" <> T.unpack img <> "\", \"text\": \"\"}}" + alice ##> ("/_send @2 json [" <> intercalate "," [cm1, cm2, cm3, cm4, cm5] <> "]") alice <# "@bob message without file" @@ -713,6 +715,9 @@ testMultiForwardFiles = alice <# "/f @bob test_1MB.pdf" alice <## "use /fc 3 to cancel sending" + alice <# "/f @bob logo.jpg" + alice <## "use /fc 4 to cancel sending" + bob <# "alice> message without file" bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)" @@ -725,16 +730,20 @@ testMultiForwardFiles = bob <# "alice> sends file test_1MB.pdf (1017.7 KiB / 1042157 bytes)" bob <## "use /fr 3 [/ | ] to receive it" + bob <# "alice> sends file logo.jpg (31.3 KiB / 32080 bytes)" + bob <## "use /fr 4 [/ | ] to receive it" + alice <## "completed uploading file 1 (test.jpg) for bob" alice <## "completed uploading file 2 (test.pdf) for bob" alice <## "completed uploading file 3 (test_1MB.pdf) for bob" + alice <## "completed uploading file 4 (logo.jpg) for bob" -- IDs to forward let msgId1 = (read msgIdZero :: Int) + 1 - msgIds = intercalate "," $ map show [msgId1, msgId1 + 1, msgId1 + 2, msgId1 + 3, msgId1 + 4] + msgIds = intercalate "," $ map (show . (msgId1 +)) [0..5] bob ##> ("/_forward plan @2 " <> msgIds) - bob <## "Files can be received: 1, 2, 3" - bob <## "4 message(s) out of 5 can be forwarded" + bob <## "Files can be received: 1, 2, 3, 4" + bob <## "5 message(s) out of 6 can be forwarded" bob ##> "/fr 1" bob @@ -744,8 +753,8 @@ testMultiForwardFiles = bob <## "completed receiving file 1 (test.jpg) from alice" bob ##> ("/_forward plan @2 " <> msgIds) - bob <## "Files can be received: 2, 3" - bob <## "4 message(s) out of 5 can be forwarded" + bob <## "Files can be received: 2, 3, 4" + bob <## "5 message(s) out of 6 can be forwarded" bob ##> "/fr 2" bob @@ -764,7 +773,7 @@ testMultiForwardFiles = -- forward file bob ##> ("/_forward plan @2 " <> msgIds) - bob <## "Files can be received: 3" + bob <## "Files can be received: 3, 4" bob <## "all messages can be forwarded" bob ##> ("/_forward @3 @2 " <> msgIds) @@ -778,16 +787,19 @@ testMultiForwardFiles = bob <# "@cath <- @alice" bob <## " test_1.jpg" bob <# "/f @cath test_1.jpg" - bob <## "use /fc 4 to cancel sending" + bob <## "use /fc 5 to cancel sending" bob <# "@cath <- @alice" bob <## " test_1.pdf" bob <# "/f @cath test_1.pdf" - bob <## "use /fc 5 to cancel sending" + bob <## "use /fc 6 to cancel sending" bob <# "@cath <- @alice" bob <## " message with large file" + bob <# "@cath <- @alice" + bob <## "" + -- messages printed for cath cath <# "bob> -> forwarded" cath <## " hi" @@ -808,9 +820,12 @@ testMultiForwardFiles = cath <# "bob> -> forwarded" cath <## " message with large file" + cath <# "bob> -> forwarded" + cath <## "" + -- file transfer - bob <## "completed uploading file 4 (test_1.jpg) for cath" - bob <## "completed uploading file 5 (test_1.pdf) for cath" + bob <## "completed uploading file 5 (test_1.jpg) for cath" + bob <## "completed uploading file 6 (test_1.pdf) for cath" cath ##> "/fr 1" cath @@ -843,6 +858,17 @@ testMultiForwardFiles = ] bob <## "completed receiving file 3 (test_1MB.pdf) from alice" + bob ##> ("/_forward plan @2 " <> msgIds) + bob <## "Files can be received: 4" + bob <## "all messages can be forwarded" + + bob ##> "/fr 4" + bob + <### [ "saving file 4 from alice to logo.jpg", + "started receiving file 4 (logo.jpg) from alice" + ] + bob <## "completed receiving file 4 (logo.jpg) from alice" + bob ##> ("/_forward plan @2 " <> msgIds) bob <## "all messages can be forwarded" @@ -854,7 +880,7 @@ testMultiForwardFiles = removeFile "./tests/tmp/bob_app_files/test.pdf" bob ##> ("/_forward plan @2 " <> msgIds) bob <## "2 file(s) are missing" - bob <## "4 message(s) out of 5 can be forwarded" + bob <## "5 message(s) out of 6 can be forwarded" -- deleting original file doesn't delete forwarded file checkActionDeletesFile "./tests/tmp/bob_app_files/test.jpg" $ do