This commit is contained in:
Evgeny @ SimpleX Chat
2026-07-11 06:56:00 +00:00
parent 1e190aac81
commit 52a4a64248
2 changed files with 11 additions and 12 deletions
+9 -10
View File
@@ -12,7 +12,7 @@
module AgentTests.ResolveNameTests (resolveNameTests) where
import AgentTests.FunctionalAPITests (withAgent)
import AgentTests.FunctionalAPITests (AgentClient (..), withAgent)
import Control.Monad.Except (runExceptT)
import qualified Data.Aeson as J
import qualified Data.ByteString.Lazy as LB
@@ -24,7 +24,6 @@ import SMPAgentClient
import SMPClient
import SMPNamesTests (testNameRecord)
import Simplex.Messaging.Agent (resolveSimplexName)
import Simplex.Messaging.Agent.Client (AgentClient)
import Simplex.Messaging.Agent.Env.SQLite (InitialAgentServers (..), ServerCfg, ServerRoles (..), presetServerCfg)
import Simplex.Messaging.Agent.Protocol (AgentErrorType (..))
import Simplex.Messaging.Client (SMPProxyFallback (..), SMPProxyMode (..), pattern NRMInteractive)
@@ -90,7 +89,7 @@ resolveNameTests = do
testDirectNotFound :: HasCallStack => IO ()
testDirectNotFound =
withDirectResolver (status404, "{}") $ \c -> do
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
r <- runExceptT $ resolveSimplexName (client c) NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
case r of
Left (SMP _ (SMP.NAME SMP.NOT_FOUND)) -> pure ()
_ -> expectationFailure $ "expected Left (SMP _ (NAME NOT_FOUND)), got: " <> show r
@@ -98,7 +97,7 @@ testDirectNotFound =
testProxyNotFound :: HasCallStack => IO ()
testProxyNotFound =
withProxyAndResolver (status404, "{}") $ \c -> do
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
r <- runExceptT $ resolveSimplexName (client c) NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
case r of
Left (SMP host (SMP.NAME SMP.NOT_FOUND)) | testPort `isInfixOf` host -> pure ()
_ -> expectationFailure $ "expected Left (SMP <proxyHost:" <> testPort <> "> (NAME NOT_FOUND)), got: " <> show r
@@ -106,7 +105,7 @@ testProxyNotFound =
testTestingTldNotFound :: HasCallStack => IO ()
testTestingTldNotFound =
withDirectResolver (status404, "{}") $ \c -> do
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDTesting "bob" [])
r <- runExceptT $ resolveSimplexName (client c) NRMInteractive 1 (SimplexDomain TLDTesting "bob" [])
case r of
Left (SMP _ (SMP.NAME SMP.NOT_FOUND)) -> pure ()
_ -> expectationFailure $ "expected Left (SMP _ (NAME NOT_FOUND)), got: " <> show r
@@ -114,7 +113,7 @@ testTestingTldNotFound =
testWebTldNotFound :: HasCallStack => IO ()
testWebTldNotFound =
withDirectResolver (status404, "{}") $ \c -> do
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDWeb "example.com" [])
r <- runExceptT $ resolveSimplexName (client c) NRMInteractive 1 (SimplexDomain TLDWeb "example.com" [])
case r of
Left (SMP _ (SMP.NAME SMP.NOT_FOUND)) -> pure ()
_ -> expectationFailure $ "expected Left (SMP _ (NAME NOT_FOUND)), got: " <> show r
@@ -122,7 +121,7 @@ testWebTldNotFound =
testNoResolver :: HasCallStack => IO ()
testNoResolver =
withNoResolver $ \c -> do
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
r <- runExceptT $ resolveSimplexName (client c) NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
case r of
Left (SMP _ (SMP.NAME SMP.NO_RESOLVER)) -> pure ()
_ -> expectationFailure $ "expected Left (SMP _ (NAME NO_RESOLVER)), got: " <> show r
@@ -130,7 +129,7 @@ testNoResolver =
testNoNameServers :: HasCallStack => IO ()
testNoNameServers =
withNoNameServers $ \c -> do
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
r <- runExceptT $ resolveSimplexName (client c) NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
case r of
Left NO_NAME_SERVERS -> pure ()
_ -> expectationFailure $ "expected Left NO_NAME_SERVERS, got: " <> show r
@@ -138,7 +137,7 @@ testNoNameServers =
testBackendError :: HasCallStack => IO ()
testBackendError =
withDirectResolver (status502, "{}") $ \c -> do
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
r <- runExceptT $ resolveSimplexName (client c) NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
case r of
Left (SMP _ (SMP.NAME (SMP.RESOLVER _))) -> pure ()
_ -> expectationFailure $ "expected Left (SMP _ (NAME (RESOLVER ..))), got: " <> show r
@@ -146,7 +145,7 @@ testBackendError =
testDirectSuccess :: HasCallStack => IO ()
testDirectSuccess =
withDirectResolver (status200, J.encode testNameRecord) $ \c -> do
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
r <- runExceptT $ resolveSimplexName (client c) NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
case r of
Right nr -> nr `shouldBe` testNameRecord
_ -> expectationFailure $ "expected Right NameRecord, got: " <> show r
+2 -2
View File
@@ -520,14 +520,14 @@ testAgentClientReconnectAfterCancel :: IO ()
testAgentClientReconnectAfterCancel =
withAgent 1 agentCfg agentServersLeak testDB $ \a -> do
withStallingServerOn testPort2 $ do
t <- async $ runExceptT $ A.createConnection a NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe
t <- async $ runExceptT $ A.createConnection (client a) NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe
threadDelay 1000000 -- let the connect to the stalling relay start, then kill it mid-flight
cancel t
withSmpServerConfigOn (transport @TLS) cfgJ2 testPort2 $ \_ -> do
testSMPClient_ "127.0.0.1" testPort2 proxyVRangeV8 Nothing $ \(th :: THandleSMP TLS 'TClient) -> do
(_, _, reply) <- sendRecv th (Nothing, "0", NoEntity, SMP.PING)
reply `shouldBe` Right SMP.PONG -- the relay is up and reachable, so a timeout can only be the poisoned var
r <- timeout 8000000 $ runExceptT $ A.createConnection a NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe
r <- timeout 8000000 $ runExceptT $ A.createConnection (client a) NRMInteractive 1 True True SCMInvitation Nothing Nothing CR.IKPQOn SMSubscribe
case r of
Just (Right _) -> pure ()
_ -> expectationFailure $ "agent failed to connect after a cancelled connect; got: " <> show r