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

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