Merge branch 'master' into master-android

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()
 }

apps/multiplatform/common/src/androidMain/kotlin/chat/simplex/common/platform/AppCommon.android.kt

@@ -31,22 +31,19 @@ lateinit var androidAppContext: Context
 var mainActivity: WeakReference<FragmentActivity> = WeakReference(null)
 var callActivity: WeakReference<ComponentActivity> = 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()
 }

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

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

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}

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)
 

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

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
 

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 [<dir>/ | <path>] to receive it"
 
+      bob <# "alice> sends file logo.jpg (31.3 KiB / 32080 bytes)"
+      bob <## "use /fr 4 [<dir>/ | <path>] 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