access servers via SOCKS proxy (#482)
* access servers via SOCKS proxy * config to pass tcp timeout and option SOCKS5 proxy to the agent
This commit is contained in:
parent
e07121266a
commit
d788c3ca95
|
@ -17,7 +17,9 @@ servers :: InitialAgentServers
|
|||
servers =
|
||||
InitialAgentServers
|
||||
{ smp = L.fromList ["smp://bU0K-bRg24xWW__lS0umO1Zdw_SXqpJNtm1_RrPLViE=@localhost:5223"],
|
||||
ntf = []
|
||||
ntf = [],
|
||||
socksProxy = Nothing,
|
||||
tcpTimeout = 5000000
|
||||
}
|
||||
|
||||
logCfg :: LogConfig
|
||||
|
|
|
@ -55,6 +55,7 @@ dependencies:
|
|||
- process == 1.6.*
|
||||
- random >= 1.1 && < 1.3
|
||||
- simple-logger == 0.1.*
|
||||
- socks == 0.6.*
|
||||
- sqlite-simple == 0.4.*
|
||||
- stm == 2.5.*
|
||||
- template-haskell == 2.16.*
|
||||
|
|
|
@ -0,0 +1,26 @@
|
|||
# Accessing SMP servers via Tor
|
||||
|
||||
## Problem
|
||||
|
||||
While SMP protocol is focussed on minimizing application-level meta-data by using pair-wise identifiers instead of user profile identifiers, it is important for many users to protect their IP addresses.
|
||||
|
||||
Further, even if IP addresses are hidden by onion routing, clients should be able to choose to use a separate TCP connection to subscribe to each queue, even though it increases traffic and battery consumption, as otherwise the servers can observe multiple queues accessed by the same client.
|
||||
|
||||
## Solution and requirements
|
||||
|
||||
While some users may want to access SMP servers via tor, some other users (even their contacts) may want the opposite - e.g., if they use the network when accessing Tor would be suspicious (or blocked).
|
||||
|
||||
Therefore we need to support the connections when one of the user accesses the same server via Tor (and, possibly, via onion address), while another user accesses this server without Tor.
|
||||
|
||||
At the same time the user accessing the server via Tor may not want that their contacts access this server without Tor, and it also may be possible that the server is not available under a normal (not .onion) address.
|
||||
|
||||
The proposed options for connecting via Tor are:
|
||||
|
||||
1. Access servers via Socks proxy: no/yes (specify port?)
|
||||
2. Use .onion addresses: no/when available/warn/always
|
||||
3. Require senders to use .onion addresses: yes/no
|
||||
4. Use separate TCP connection for each queue
|
||||
|
||||
While it should be possible for SMP servers to have two addresses (with and without Tor), the queues should only use one server address - if the queue started being accessed via .onion address it should not be possible to access it via a normal address. Queue addresses in connection invitations should support dual server addresses (when senders are not required ot use .onion address).
|
||||
|
||||
At the same time, the queue with the normal addresses can be accessed with and without Tor, depending on the current device settings.
|
|
@ -127,6 +127,7 @@ library
|
|||
, process ==1.6.*
|
||||
, random >=1.1 && <1.3
|
||||
, simple-logger ==0.1.*
|
||||
, socks ==0.6.*
|
||||
, sqlite-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
, template-haskell ==2.16.*
|
||||
|
@ -188,6 +189,7 @@ executable ntf-server
|
|||
, random >=1.1 && <1.3
|
||||
, simple-logger ==0.1.*
|
||||
, simplexmq
|
||||
, socks ==0.6.*
|
||||
, sqlite-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
, template-haskell ==2.16.*
|
||||
|
@ -249,6 +251,7 @@ executable smp-agent
|
|||
, random >=1.1 && <1.3
|
||||
, simple-logger ==0.1.*
|
||||
, simplexmq
|
||||
, socks ==0.6.*
|
||||
, sqlite-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
, template-haskell ==2.16.*
|
||||
|
@ -310,6 +313,7 @@ executable smp-server
|
|||
, random >=1.1 && <1.3
|
||||
, simple-logger ==0.1.*
|
||||
, simplexmq
|
||||
, socks ==0.6.*
|
||||
, sqlite-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
, template-haskell ==2.16.*
|
||||
|
@ -390,6 +394,7 @@ test-suite smp-server-test
|
|||
, random >=1.1 && <1.3
|
||||
, simple-logger ==0.1.*
|
||||
, simplexmq
|
||||
, socks ==0.6.*
|
||||
, sqlite-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
, template-haskell ==2.16.*
|
||||
|
|
|
@ -91,6 +91,7 @@ import Data.Text.Encoding
|
|||
import Data.Tuple (swap)
|
||||
import Data.Word (Word16)
|
||||
import qualified Database.SQLite.Simple as DB
|
||||
import Network.Socks5 (SocksConf)
|
||||
import Simplex.Messaging.Agent.Env.SQLite
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
import Simplex.Messaging.Agent.RetryInterval
|
||||
|
@ -130,6 +131,8 @@ data AgentClient = AgentClient
|
|||
smpClients :: TMap SMPServer SMPClientVar,
|
||||
ntfServers :: TVar [NtfServer],
|
||||
ntfClients :: TMap NtfServer NtfClientVar,
|
||||
useSocksProxy :: TVar (Maybe SocksConf),
|
||||
useTcpTimeout :: TVar (Int),
|
||||
subscrSrvrs :: TMap SMPServer (TMap ConnId RcvQueue),
|
||||
pendingSubscrSrvrs :: TMap SMPServer (TMap ConnId RcvQueue),
|
||||
subscrConns :: TMap ConnId SMPServer,
|
||||
|
@ -170,7 +173,7 @@ data AgentState = ASActive | ASSuspending | ASSuspended
|
|||
deriving (Eq, Show)
|
||||
|
||||
newAgentClient :: InitialAgentServers -> Env -> STM AgentClient
|
||||
newAgentClient InitialAgentServers {smp, ntf} agentEnv = do
|
||||
newAgentClient InitialAgentServers {smp, ntf, socksProxy, tcpTimeout} agentEnv = do
|
||||
let qSize = tbqSize $ config agentEnv
|
||||
active <- newTVar True
|
||||
rcvQ <- newTBQueue qSize
|
||||
|
@ -180,6 +183,8 @@ newAgentClient InitialAgentServers {smp, ntf} agentEnv = do
|
|||
smpClients <- TM.empty
|
||||
ntfServers <- newTVar ntf
|
||||
ntfClients <- TM.empty
|
||||
useSocksProxy <- newTVar socksProxy
|
||||
useTcpTimeout <- newTVar tcpTimeout
|
||||
subscrSrvrs <- TM.empty
|
||||
pendingSubscrSrvrs <- TM.empty
|
||||
subscrConns <- TM.empty
|
||||
|
@ -197,7 +202,7 @@ newAgentClient InitialAgentServers {smp, ntf} agentEnv = do
|
|||
asyncClients <- newTVar []
|
||||
clientId <- stateTVar (clientCounter agentEnv) $ \i -> let i' = i + 1 in (i', i')
|
||||
lock <- newTMVar ()
|
||||
return AgentClient {active, rcvQ, subQ, msgQ, smpServers, smpClients, ntfServers, ntfClients, subscrSrvrs, pendingSubscrSrvrs, subscrConns, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, ntfNetworkOp, rcvNetworkOp, msgDeliveryOp, sndNetworkOp, databaseOp, agentState, getMsgLocks, reconnections, asyncClients, clientId, agentEnv, lock}
|
||||
return AgentClient {active, rcvQ, subQ, msgQ, smpServers, smpClients, ntfServers, ntfClients, useSocksProxy, useTcpTimeout, subscrSrvrs, pendingSubscrSrvrs, subscrConns, connMsgsQueued, smpQueueMsgQueues, smpQueueMsgDeliveries, ntfNetworkOp, rcvNetworkOp, msgDeliveryOp, sndNetworkOp, databaseOp, agentState, getMsgLocks, reconnections, asyncClients, clientId, agentEnv, lock}
|
||||
|
||||
agentDbPath :: AgentClient -> FilePath
|
||||
agentDbPath AgentClient {agentEnv = Env {store = SQLiteStore {dbFilePath}}} = dbFilePath
|
||||
|
@ -224,7 +229,7 @@ getSMPServerClient c@AgentClient {active, smpClients, msgQ} srv = do
|
|||
where
|
||||
connectClient :: m SMPClient
|
||||
connectClient = do
|
||||
cfg <- asks $ smpCfg . config
|
||||
cfg <- atomically . updateClientConfig c =<< asks (smpCfg . config)
|
||||
u <- askUnliftIO
|
||||
liftEitherError (protocolClientError SMP) (getProtocolClient srv cfg (Just msgQ) $ clientDisconnected u)
|
||||
|
||||
|
@ -296,7 +301,7 @@ getNtfServerClient c@AgentClient {active, ntfClients} srv = do
|
|||
where
|
||||
connectClient :: m NtfClient
|
||||
connectClient = do
|
||||
cfg <- asks $ ntfCfg . config
|
||||
cfg <- atomically . updateClientConfig c =<< asks (ntfCfg . config)
|
||||
liftEitherError (protocolClientError NTF) (getProtocolClient srv cfg Nothing clientDisconnected)
|
||||
|
||||
clientDisconnected :: IO ()
|
||||
|
@ -357,6 +362,12 @@ newProtocolClient c srv clients connectClient reconnectClient clientVar = tryCon
|
|||
ri <- asks $ reconnectInterval . config
|
||||
withRetryInterval ri $ \loop -> void $ tryConnectClient (const reconnectClient) loop
|
||||
|
||||
updateClientConfig :: AgentClient -> ProtocolClientConfig -> STM ProtocolClientConfig
|
||||
updateClientConfig AgentClient {useSocksProxy, useTcpTimeout} cfg = do
|
||||
socksProxy <- readTVar useSocksProxy
|
||||
tcpTimeout <- readTVar useTcpTimeout
|
||||
pure (cfg :: ProtocolClientConfig) {socksProxy, tcpTimeout}
|
||||
|
||||
closeAgentClient :: MonadIO m => AgentClient -> m ()
|
||||
closeAgentClient c = liftIO $ do
|
||||
atomically $ writeTVar (active c) False
|
||||
|
@ -372,7 +383,7 @@ closeAgentClient c = liftIO $ do
|
|||
clear smpQueueMsgQueues
|
||||
clear getMsgLocks
|
||||
where
|
||||
clientTimeout sel = tcpTimeout . sel . config $ agentEnv c
|
||||
clientTimeout sel = (tcpTimeout :: ProtocolClientConfig -> Int) . sel . config $ agentEnv c
|
||||
clear :: (AgentClient -> TMap k a) -> IO ()
|
||||
clear sel = atomically $ writeTVar (sel c) M.empty
|
||||
|
||||
|
|
|
@ -30,6 +30,7 @@ import Data.List.NonEmpty (NonEmpty)
|
|||
import Data.Time.Clock (NominalDiffTime, nominalDay)
|
||||
import Data.Word (Word16)
|
||||
import Network.Socket
|
||||
import Network.Socks5 (SocksConf)
|
||||
import Numeric.Natural
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
import Simplex.Messaging.Agent.RetryInterval
|
||||
|
@ -43,6 +44,7 @@ import Simplex.Messaging.Protocol (NtfServer)
|
|||
import Simplex.Messaging.TMap (TMap)
|
||||
import qualified Simplex.Messaging.TMap as TM
|
||||
import Simplex.Messaging.Transport (TLS, Transport (..))
|
||||
import Simplex.Messaging.Transport.Client (defaultSMPPort)
|
||||
import Simplex.Messaging.Version
|
||||
import System.Random (StdGen, newStdGen)
|
||||
import UnliftIO (Async)
|
||||
|
@ -53,7 +55,9 @@ type AgentMonad m = (MonadUnliftIO m, MonadReader Env m, MonadError AgentErrorTy
|
|||
|
||||
data InitialAgentServers = InitialAgentServers
|
||||
{ smp :: NonEmpty SMPServer,
|
||||
ntf :: [NtfServer]
|
||||
ntf :: [NtfServer],
|
||||
socksProxy :: Maybe SocksConf,
|
||||
tcpTimeout :: Int
|
||||
}
|
||||
|
||||
data AgentConfig = AgentConfig
|
||||
|
@ -98,7 +102,7 @@ defaultAgentConfig =
|
|||
tbqSize = 64,
|
||||
dbFile = "smp-agent.db",
|
||||
yesToMigrations = False,
|
||||
smpCfg = defaultClientConfig {defaultTransport = ("5223", transport @TLS)},
|
||||
smpCfg = defaultClientConfig {defaultTransport = (show defaultSMPPort, transport @TLS)},
|
||||
ntfCfg = defaultClientConfig {defaultTransport = ("443", transport @TLS)},
|
||||
reconnectInterval = defaultReconnectInterval,
|
||||
helloTimeout = 2 * nominalDay,
|
||||
|
|
|
@ -70,6 +70,7 @@ import Data.List.NonEmpty (NonEmpty)
|
|||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Network.Socket (ServiceName)
|
||||
import Network.Socks5 (SocksConf)
|
||||
import Numeric.Natural
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Protocol as SMP
|
||||
|
@ -118,6 +119,8 @@ data ProtocolClientConfig = ProtocolClientConfig
|
|||
tcpTimeout :: Int,
|
||||
-- | TCP keep-alive options, Nothing to skip enabling keep-alive
|
||||
tcpKeepAlive :: Maybe KeepAliveOpts,
|
||||
-- | use SOCKS5 proxy
|
||||
socksProxy :: Maybe SocksConf,
|
||||
-- | period for SMP ping commands (microseconds)
|
||||
smpPing :: Int,
|
||||
-- | SMP client-server protocol version range
|
||||
|
@ -132,6 +135,7 @@ defaultClientConfig =
|
|||
defaultTransport = ("443", transport @TLS),
|
||||
tcpTimeout = 5_000_000,
|
||||
tcpKeepAlive = Just defaultKeepAliveOpts,
|
||||
socksProxy = Nothing,
|
||||
smpPing = 600_000_000, -- 10min
|
||||
smpServerVRange = supportedSMPServerVRange
|
||||
}
|
||||
|
@ -149,7 +153,7 @@ type Response msg = Either ProtocolClientError msg
|
|||
-- A single queue can be used for multiple 'SMPClient' instances,
|
||||
-- as 'SMPServerTransmission' includes server information.
|
||||
getProtocolClient :: forall msg. Protocol msg => ProtoServer msg -> ProtocolClientConfig -> Maybe (TBQueue (ServerTransmission msg)) -> IO () -> IO (Either ProtocolClientError (ProtocolClient msg))
|
||||
getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tcpKeepAlive, smpPing, smpServerVRange} msgQ disconnected =
|
||||
getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tcpKeepAlive, socksProxy, smpPing, smpServerVRange} msgQ disconnected =
|
||||
(atomically mkProtocolClient >>= runClient useTransport)
|
||||
`catch` \(e :: IOException) -> pure . Left $ PCEIOError e
|
||||
where
|
||||
|
@ -180,7 +184,7 @@ getProtocolClient protocolServer cfg@ProtocolClientConfig {qSize, tcpTimeout, tc
|
|||
thVar <- newEmptyTMVarIO
|
||||
action <-
|
||||
async $
|
||||
runTransportClient (host protocolServer) port' (Just $ keyHash protocolServer) tcpKeepAlive (client t c thVar)
|
||||
runTransportClient socksProxy (host protocolServer) port' (Just $ keyHash protocolServer) tcpKeepAlive (client t c thVar)
|
||||
`finally` atomically (putTMVar thVar $ Left PCENetworkError)
|
||||
th_ <- tcpTimeout `timeout` atomically (takeTMVar thVar)
|
||||
pure $ case th_ of
|
||||
|
|
|
@ -667,7 +667,7 @@ instance StrEncoding SrvLoc where
|
|||
strP = SrvLoc <$> host <*> (port <|> pure "")
|
||||
where
|
||||
host = B.unpack <$> A.takeWhile1 (A.notInClass ":#,;/ ")
|
||||
port = B.unpack <$> (A.char ':' *> A.takeWhile1 A.isDigit)
|
||||
port = show <$> (A.char ':' *> (A.decimal :: Parser Int))
|
||||
|
||||
-- | Transmission correlation ID.
|
||||
newtype CorrId = CorrId {bs :: ByteString} deriving (Eq, Ord, Show)
|
||||
|
|
|
@ -4,6 +4,7 @@ module Simplex.Messaging.Transport.Client
|
|||
( runTransportClient,
|
||||
runTLSTransportClient,
|
||||
smpClientHandshake,
|
||||
defaultSMPPort,
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -12,32 +13,43 @@ import Control.Monad.IO.Unlift
|
|||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.Default (def)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Data.X509 as X
|
||||
import qualified Data.X509.CertificateStore as XS
|
||||
import Data.X509.Validation (Fingerprint (..))
|
||||
import qualified Data.X509.Validation as XV
|
||||
import GHC.IO.Exception (IOErrorType (..))
|
||||
import Network.Socket
|
||||
import Network.Socks5
|
||||
import qualified Network.TLS as T
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Transport
|
||||
import Simplex.Messaging.Transport.KeepAlive
|
||||
import System.IO.Error
|
||||
import Text.Read (readMaybe)
|
||||
import UnliftIO.Exception (IOException)
|
||||
import qualified UnliftIO.Exception as E
|
||||
|
||||
-- | Connect to passed TCP host:port and pass handle to the client.
|
||||
runTransportClient :: (Transport c, MonadUnliftIO m) => HostName -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a
|
||||
runTransportClient :: (Transport c, MonadUnliftIO m) => Maybe SocksConf -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a
|
||||
runTransportClient = runTLSTransportClient supportedParameters Nothing
|
||||
|
||||
runTLSTransportClient :: (Transport c, MonadUnliftIO m) => T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a
|
||||
runTLSTransportClient tlsParams caStore_ host port keyHash keepAliveOpts client = do
|
||||
runTLSTransportClient :: (Transport c, MonadUnliftIO m) => T.Supported -> Maybe XS.CertificateStore -> Maybe SocksConf -> HostName -> ServiceName -> Maybe C.KeyHash -> Maybe KeepAliveOpts -> (c -> m a) -> m a
|
||||
runTLSTransportClient tlsParams caStore_ socksConf_ host port keyHash keepAliveOpts client = do
|
||||
let clientParams = mkTLSClientParams tlsParams caStore_ host port keyHash
|
||||
c <- liftIO $ startTCPClient host port clientParams keepAliveOpts
|
||||
connectTCP = maybe connectTCPClient connectSocksClient socksConf_
|
||||
c <- liftIO $ connectTLSClient connectTCP host port clientParams keepAliveOpts
|
||||
client c `E.finally` liftIO (closeConnection c)
|
||||
|
||||
startTCPClient :: forall c. Transport c => HostName -> ServiceName -> T.ClientParams -> Maybe KeepAliveOpts -> IO c
|
||||
startTCPClient host port clientParams keepAliveOpts = withSocketsDo $ resolve >>= tryOpen err
|
||||
connectTLSClient :: forall c. Transport c => (HostName -> ServiceName -> IO Socket) -> HostName -> ServiceName -> T.ClientParams -> Maybe KeepAliveOpts -> IO c
|
||||
connectTLSClient tcpClient host port clientParams keepAliveOpts = do
|
||||
sock <- tcpClient host port
|
||||
mapM_ (setSocketKeepAlive sock) keepAliveOpts
|
||||
ctx <- connectTLS clientParams sock
|
||||
getClientConnection ctx
|
||||
|
||||
connectTCPClient :: HostName -> ServiceName -> IO Socket
|
||||
connectTCPClient host port = withSocketsDo $ resolve >>= tryOpen err
|
||||
where
|
||||
err :: IOException
|
||||
err = mkIOError NoSuchThing "no address" Nothing Nothing
|
||||
|
@ -47,20 +59,24 @@ startTCPClient host port clientParams keepAliveOpts = withSocketsDo $ resolve >>
|
|||
let hints = defaultHints {addrSocketType = Stream}
|
||||
in getAddrInfo (Just hints) (Just host) (Just port)
|
||||
|
||||
tryOpen :: IOException -> [AddrInfo] -> IO c
|
||||
tryOpen :: IOException -> [AddrInfo] -> IO Socket
|
||||
tryOpen e [] = E.throwIO e
|
||||
tryOpen _ (addr : as) =
|
||||
E.try (open addr) >>= either (`tryOpen` as) pure
|
||||
|
||||
open :: AddrInfo -> IO c
|
||||
open :: AddrInfo -> IO Socket
|
||||
open addr = do
|
||||
sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
|
||||
connect sock $ addrAddress addr
|
||||
mapM_ (setSocketKeepAlive sock) keepAliveOpts
|
||||
ctx <- connectTLS clientParams sock
|
||||
getClientConnection ctx
|
||||
pure sock
|
||||
|
||||
-- readCertificateStore :: FilePath -> IO (Maybe CertificateStore)
|
||||
defaultSMPPort :: PortNumber
|
||||
defaultSMPPort = 5223
|
||||
|
||||
connectSocksClient :: SocksConf -> HostName -> ServiceName -> IO Socket
|
||||
connectSocksClient socksProxy host _port = do
|
||||
let port = if null _port then defaultSMPPort else fromMaybe defaultSMPPort $ readMaybe _port
|
||||
fst <$> socksConnect socksProxy (SocksAddress (SocksAddrDomainName $ B.pack host) port)
|
||||
|
||||
mkTLSClientParams :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe C.KeyHash -> T.ClientParams
|
||||
mkTLSClientParams supported caStore_ host port keyHash_ = do
|
||||
|
|
|
@ -122,7 +122,7 @@ sendRequest HTTP2Client {reqQ, config} req = do
|
|||
|
||||
runHTTP2Client :: T.Supported -> Maybe XS.CertificateStore -> HostName -> ServiceName -> Maybe KeepAliveOpts -> ((Request -> (Response -> IO ()) -> IO ()) -> IO ()) -> IO ()
|
||||
runHTTP2Client tlsParams caStore host port keepAliveOpts client =
|
||||
runTLSTransportClient tlsParams caStore host port Nothing keepAliveOpts $ \c ->
|
||||
runTLSTransportClient tlsParams caStore Nothing host port Nothing keepAliveOpts $ \c ->
|
||||
withTlsConfig c 16384 (`run` client)
|
||||
where
|
||||
run = H.run $ ClientConfig "https" (B.pack host) 20
|
||||
|
|
|
@ -68,7 +68,7 @@ ntfTestStoreLogFile = "tests/tmp/ntf-server-store.log"
|
|||
|
||||
testNtfClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
|
||||
testNtfClient client =
|
||||
runTransportClient testHost ntfTestPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
|
||||
runTransportClient Nothing testHost ntfTestPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
|
||||
liftIO (runExceptT $ ntfClientHandshake h testKeyHash supportedNTFServerVRange) >>= \case
|
||||
Right th -> client th
|
||||
Left e -> error $ show e
|
||||
|
|
|
@ -165,7 +165,9 @@ initAgentServers :: InitialAgentServers
|
|||
initAgentServers =
|
||||
InitialAgentServers
|
||||
{ smp = L.fromList [testSMPServer],
|
||||
ntf = ["ntf://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6001"]
|
||||
ntf = ["ntf://LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI=@localhost:6001"],
|
||||
socksProxy = Nothing,
|
||||
tcpTimeout = 5000000
|
||||
}
|
||||
|
||||
initAgentServers2 :: InitialAgentServers
|
||||
|
@ -215,7 +217,7 @@ withSmpAgent t = withSmpAgentOn t (agentTestPort, testPort, testDB)
|
|||
|
||||
testSMPAgentClientOn :: (Transport c, MonadUnliftIO m) => ServiceName -> (c -> m a) -> m a
|
||||
testSMPAgentClientOn port' client = do
|
||||
runTransportClient agentTestHost port' (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h -> do
|
||||
runTransportClient Nothing agentTestHost port' (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h -> do
|
||||
line <- liftIO $ getLn h
|
||||
if line == "Welcome to SMP agent v" <> B.pack simplexMQVersion
|
||||
then client h
|
||||
|
|
|
@ -56,7 +56,7 @@ testServerStatsBackupFile = "tests/tmp/smp-server-stats.log"
|
|||
|
||||
testSMPClient :: (Transport c, MonadUnliftIO m) => (THandle c -> m a) -> m a
|
||||
testSMPClient client =
|
||||
runTransportClient testHost testPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
|
||||
runTransportClient Nothing testHost testPort (Just testKeyHash) (Just defaultKeepAliveOpts) $ \h ->
|
||||
liftIO (runExceptT $ smpClientHandshake h testKeyHash supportedSMPServerVRange) >>= \case
|
||||
Right th -> client th
|
||||
Left e -> error $ show e
|
||||
|
|
Reference in New Issue