core: commands to get/set network configuration (#839)

apps/simplex-chat/Main.hs

@@ -3,13 +3,12 @@
 module Main where
 
 import Control.Concurrent (threadDelay)
-import Network.Socks5 (SocksConf (..))
 import Server
 import Simplex.Chat.Controller (versionNumber)
 import Simplex.Chat.Core
 import Simplex.Chat.Options
 import Simplex.Chat.Terminal
-import Simplex.Chat.View (serializeChatResponse)
+import Simplex.Chat.View (serializeChatResponse, viewSocksProxy)
 import System.Directory (getAppUserDataDirectory)
 import System.Terminal (withTerminal)
 
@@ -31,10 +30,11 @@ main = do
       threadDelay $ chatCmdDelay opts * 1000000
 
 welcome :: ChatOpts -> IO ()
-welcome ChatOpts {dbFilePrefix, socksProxy} = do
-  putStrLn $ "SimpleX Chat v" ++ versionNumber
-  putStrLn $ "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db"
-  case socksProxy of
-    Just (SocksConf s _) -> putStrLn $ "using SOCKS5 proxy " <> show s
-    _ -> putStrLn "use -x CLI option to connect via SOCKS5 at :9050"
-  putStrLn "type \"/help\" or \"/h\" for usage info"
+welcome ChatOpts {dbFilePrefix, socksProxy} =
+  mapM_
+    putStrLn
+    [ "SimpleX Chat v" ++ versionNumber,
+      "db: " <> dbFilePrefix <> "_chat.db, " <> dbFilePrefix <> "_agent.db",
+      viewSocksProxy socksProxy,
+      "type \"/help\" or \"/h\" for usage info"
+    ]

cabal.project

@@ -5,7 +5,7 @@ constraints: zip +disable-bzip2 +disable-zstd
 source-repository-package
     type: git
     location: https://github.com/simplex-chat/simplexmq.git
-    tag: d788c3ca95f74d7ec2d737f3ef3ad8dc69d32abc
+    tag: fcaddb7848543baf64786d531cdd629488a462e4
 
 source-repository-package
     type: git

scripts/nix/sha256map.nix

@@ -1,5 +1,5 @@
 {
-  "https://github.com/simplex-chat/simplexmq.git"."d788c3ca95f74d7ec2d737f3ef3ad8dc69d32abc" = "0sxaf8by830cc2pfkpn1bkfyr68b9iz901pihip12r9g6v3asssh";
+  "https://github.com/simplex-chat/simplexmq.git"."fcaddb7848543baf64786d531cdd629488a462e4" = "1p3vl87i0jd8qjnak8nykvpbg6h7kby4z3wxx8wdmbjvjkw4x190";
   "https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp";
   "https://github.com/simplex-chat/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj";
   "https://github.com/zw3rk/android-support.git"."3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb" = "1r6jyxbim3dsvrmakqfyxbd6ms6miaghpbwyl0sr6dzwpgaprz97";

simplex-chat.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           simplex-chat
-version:        3.0.0
+version:        3.1.0
 category:       Web, System, Services, Cryptography
 homepage:       https://github.com/simplex-chat/simplex-chat#readme
 author:         simplex.chat

src/Simplex/Chat.hs

@@ -56,7 +56,7 @@ import Simplex.Chat.Store
 import Simplex.Chat.Types
 import Simplex.Chat.Util (safeDecodeUtf8, uncurry3)
 import Simplex.Messaging.Agent as Agent
-import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), defaultAgentConfig)
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), NetworkConfig (..), defaultAgentConfig)
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
@@ -65,6 +65,7 @@ import Simplex.Messaging.Parsers (base64P, parseAll)
 import Simplex.Messaging.Protocol (ErrorType (..), MsgBody, MsgFlags (..), NtfServer)
 import qualified Simplex.Messaging.Protocol as SMP
 import qualified Simplex.Messaging.TMap as TM
+import Simplex.Messaging.Transport.Client (defaultSocksProxy)
 import Simplex.Messaging.Util
 import System.Exit (exitFailure, exitSuccess)
 import System.FilePath (combine, splitExtensions, takeFileName)
@@ -91,8 +92,7 @@ defaultChatConfig =
         InitialAgentServers
           { smp = _defaultSMPServers,
             ntf = _defaultNtfServers,
-            socksProxy = Nothing,
-            tcpTimeout = 5000000
+            netCfg = NetworkConfig {socksProxy = Nothing, tcpTimeout = 5000000}
           },
       tbqSize = 64,
       fileChunkSize = 15780,
@@ -130,7 +130,8 @@ newChatController chatStore user cfg@ChatConfig {agentConfig = aCfg, tbqSize, de
   firstTime <- not <$> doesFileExist f
   currentUser <- newTVarIO user
   servers <- resolveServers defaultServers
-  smpAgent <- getSMPAgentClient aCfg {dbFile = dbFilePrefix <> "_agent.db"} servers {socksProxy, tcpTimeout}
+  let netCfg = NetworkConfig {socksProxy, tcpTimeout}
+  smpAgent <- getSMPAgentClient aCfg {dbFile = dbFilePrefix <> "_agent.db"} servers {netCfg}
   agentAsync <- newTVarIO Nothing
   idsDrg <- newTVarIO =<< drgNew
   inputQ <- newTBQueueIO tbqSize
@@ -597,6 +598,8 @@ processChatCommand = \case
     ChatConfig {defaultServers = InitialAgentServers {smp = defaultSMPServers}} <- asks config
     withAgent $ \a -> setSMPServers a (fromMaybe defaultSMPServers (nonEmpty smpServers))
     pure CRCmdOk
+  APISetNetworkConfig cfg -> withUser $ \_ -> withAgent (`setNetworkConfig` cfg) $> CRCmdOk
+  APIGetNetworkConfig -> CRNetworkConfig <$> withUser (\_ -> withAgent getNetworkConfig)
   APIContactInfo contactId -> withUser $ \User {userId} -> do
     ct <- withStore $ \db -> getContact db userId contactId
     CRContactInfo ct <$> withAgent (`getConnectionServers` contactConnId ct)
@@ -2453,6 +2456,9 @@ chatCommandP =
       "/smp_servers default" $> SetUserSMPServers [],
       "/smp_servers " *> (SetUserSMPServers <$> smpServersP),
       "/smp_servers" $> GetUserSMPServers,
+      "/_network " *> (APISetNetworkConfig <$> jsonP),
+      ("/network " <|> "/net ") *> (APISetNetworkConfig <$> netCfgP),
+      ("/network" <|> "/net") $> APIGetNetworkConfig,
       "/_info #" *> (APIGroupMemberInfo <$> A.decimal <* A.space <*> A.decimal),
       "/_info @" *> (APIContactInfo <$> A.decimal),
       ("/info #" <|> "/i #") *> (GroupMemberInfo <$> displayName <* A.space <* optional (A.char '@') <*> displayName),
@@ -2550,6 +2556,11 @@ chatCommandP =
     chatNameP' = ChatName <$> (chatTypeP <|> pure CTDirect) <*> displayName
     chatRefP = ChatRef <$> chatTypeP <*> A.decimal
     msgCountP = A.space *> A.decimal <|> pure 10
+    netCfgP = do
+      socksProxy <- "socks=" *> ("off" $> Nothing <|> "on" $> Just defaultSocksProxy <|> Just <$> strP)
+      t_ <- optional $ " timeout=" *> A.decimal
+      let tcpTimeout = 1000000 * fromMaybe (maybe 5 (const 10) socksProxy) t_
+      pure $ NetworkConfig {socksProxy, tcpTimeout}
 
 adminContactReq :: ConnReqContact
 adminContactReq =

src/Simplex/Chat/Controller.hs

@@ -34,7 +34,7 @@ import Simplex.Chat.Protocol
 import Simplex.Chat.Store (StoreError)
 import Simplex.Chat.Types
 import Simplex.Messaging.Agent (AgentClient)
-import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, InitialAgentServers)
+import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, InitialAgentServers, NetworkConfig)
 import Simplex.Messaging.Agent.Protocol
 import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore)
 import qualified Simplex.Messaging.Crypto as C
@@ -143,6 +143,8 @@ data ChatCommand
   | APIListMembers GroupId
   | GetUserSMPServers
   | SetUserSMPServers [SMPServer]
+  | APISetNetworkConfig NetworkConfig
+  | APIGetNetworkConfig
   | APIContactInfo ContactId
   | APIGroupMemberInfo GroupId GroupMemberId
   | ContactInfo ContactName
@@ -203,6 +205,7 @@ data ChatResponse
   | CRLastMessages {chatItems :: [AChatItem]}
   | CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
   | CRUserSMPServers {smpServers :: [SMPServer]}
+  | CRNetworkConfig {networkConfig :: NetworkConfig}
   | CRContactInfo {contact :: Contact, connectionStats :: ConnectionStats}
   | CRGroupMemberInfo {groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats}
   | CRNewChatItem {chatItem :: AChatItem}

src/Simplex/Chat/Options.hs

@@ -13,20 +13,18 @@ where
 
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.ByteString.Char8 as B
-import Data.Maybe (fromMaybe)
-import Network.Socket (HostAddress, SockAddr (..), tupleToHostAddress)
-import Network.Socks5 (SocksConf, defaultSocksConf)
 import Options.Applicative
 import Simplex.Chat.Controller (updateStr, versionStr)
 import Simplex.Messaging.Agent.Protocol (SMPServer)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (parseAll)
+import Simplex.Messaging.Transport.Client (SocksProxy, defaultSocksProxy)
 import System.FilePath (combine)
 
 data ChatOpts = ChatOpts
   { dbFilePrefix :: String,
     smpServers :: [SMPServer],
-    socksProxy :: Maybe SocksConf,
+    socksProxy :: Maybe SocksProxy,
     tcpTimeout :: Int,
     logConnections :: Bool,
     logAgent :: Bool,
@@ -59,7 +57,7 @@ chatOpts appDir defaultDbFileName = do
   socksProxy <-
     flag' (Just defaultSocksProxy) (short 'x' <> help "use local SOCKS5 proxy at :9050")
       <|> option
-        parseSocksConf
+        parseSocksProxy
         ( long "socks-proxy"
             <> metavar "SOCKS5"
             <> help "`ipv4:port` or `:port` of SOCKS5 proxy"
@@ -126,21 +124,8 @@ chatOpts appDir defaultDbFileName = do
 parseSMPServers :: ReadM [SMPServer]
 parseSMPServers = eitherReader $ parseAll smpServersP . B.pack
 
-defaultSocksHost :: HostAddress
-defaultSocksHost = tupleToHostAddress (127, 0, 0, 1)
-
-defaultSocksProxy :: SocksConf
-defaultSocksProxy = defaultSocksConf $ SockAddrInet 9050 defaultSocksHost
-
-parseSocksConf :: ReadM (Maybe SocksConf)
-parseSocksConf = eitherReader $ parseAll socksConfP . B.pack
-  where
-    socksConfP = do
-      host <- maybe defaultSocksHost tupleToHostAddress <$> optional ipv4P
-      port <- fromMaybe 9050 <$> optional (A.char ':' *> (fromInteger <$> A.decimal))
-      pure . Just . defaultSocksConf $ SockAddrInet port host
-    ipv4P = (,,,) <$> ipNum <*> ipNum <*> ipNum <*> A.decimal
-    ipNum = A.decimal <* A.char '.'
+parseSocksProxy :: ReadM (Maybe SocksProxy)
+parseSocksProxy = eitherReader $ parseAll strP . B.pack
 
 parseServerPort :: ReadM (Maybe String)
 parseServerPort = eitherReader $ parseAll serverPortP . B.pack

src/Simplex/Chat/Terminal.hs

@@ -15,7 +15,7 @@ import Simplex.Chat.Options
 import Simplex.Chat.Terminal.Input
 import Simplex.Chat.Terminal.Notification
 import Simplex.Chat.Terminal.Output
-import Simplex.Messaging.Agent.Env.SQLite (InitialAgentServers (..))
+import Simplex.Messaging.Agent.Env.SQLite (InitialAgentServers (..), NetworkConfig (..))
 import Simplex.Messaging.Util (raceAny_)
 
 terminalChatConfig :: ChatConfig
@@ -30,8 +30,7 @@ terminalChatConfig =
                   "smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im"
                 ],
             ntf = ["ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.simplex.im"],
-            socksProxy = Nothing,
-            tcpTimeout = 5000000
+            netCfg = NetworkConfig {socksProxy = Nothing, tcpTimeout = 5000000}
           }
     }
 

src/Simplex/Chat/View.hs

@@ -36,12 +36,14 @@ import Simplex.Chat.Protocol
 import Simplex.Chat.Store (StoreError (..))
 import Simplex.Chat.Styled
 import Simplex.Chat.Types
+import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))
 import Simplex.Messaging.Agent.Protocol
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON)
 import qualified Simplex.Messaging.Protocol as SMP
+import Simplex.Messaging.Transport.Client (SocksProxy)
 import Simplex.Messaging.Util (bshow)
 import System.Console.ANSI.Types
 
@@ -59,6 +61,7 @@ responseToView testView = \case
   CRApiChat chat -> if testView then testViewChat chat else [plain . bshow $ J.encode chat]
   CRApiParsedMarkdown ft -> [plain . bshow $ J.encode ft]
   CRUserSMPServers smpServers -> viewSMPServers smpServers testView
+  CRNetworkConfig cfg -> viewNetworkConfig cfg
   CRContactInfo ct cStats -> viewContactInfo ct cStats
   CRGroupMemberInfo g m cStats -> viewGroupMemberInfo g m cStats
   CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item False
@@ -487,6 +490,16 @@ viewSMPServers smpServers testView =
         then "no custom SMP servers saved"
         else viewServers smpServers
 
+viewNetworkConfig :: NetworkConfig -> [StyledString]
+viewNetworkConfig NetworkConfig {socksProxy, tcpTimeout} =
+  [plain $ viewSocksProxy socksProxy, "TCP timeout: " <> sShow tcpTimeout]
+
+viewSocksProxy :: Maybe SocksProxy -> String
+viewSocksProxy =
+  maybe
+    "Direct network connection. Use `/network socks=on` command or `-x` CLI option to connect via SOCKS5 at :9050"
+    (("using SOCKS5 proxy " <>) . show)
+
 viewContactInfo :: Contact -> ConnectionStats -> [StyledString]
 viewContactInfo Contact {contactId} stats =
   ["contact ID: " <> sShow contactId] <> viewConnectionStats stats

stack.yaml

@@ -49,7 +49,7 @@ extra-deps:
   # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
   # - ../simplexmq
   - github: simplex-chat/simplexmq
-    commit: d788c3ca95f74d7ec2d737f3ef3ad8dc69d32abc
+    commit: fcaddb7848543baf64786d531cdd629488a462e4
   # - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
   - github: simplex-chat/aeson
     commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7