mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-09-14 17:26:03 +00:00
Alain Brenzikofer
2b2d2d4e0c
resolveNameMsg read the version off thParams', which on the PFWD path is the proxy's session, not the client's. It takes the version as an argument now, so each call site passes its own — the forwarded one uses fwdVersion. reservedReasonOf matched the reason words before capping, so "internal review" became NRRUnknown "internal", which encodes back as NRRInternal. Capping precedes the match, so what is kept encodes to what it decoded. Four agent tests still pinned NAME NOT_FOUND from a 404 stub, and two spec statements still described the old mapping. A registrar that does not record labels cannot answer a hashed query, which the resolver README now says.
164 lines
7.7 KiB
Haskell
164 lines
7.7 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedLists #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE PatternSynonyms #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
|
|
|
module AgentTests.ResolveNameTests (resolveNameTests) where
|
|
|
|
import AgentTests.FunctionalAPITests (withAgent)
|
|
import Control.Monad.Except (runExceptT)
|
|
import qualified Data.ByteString.Lazy as LB
|
|
import Data.List (isInfixOf)
|
|
import Network.HTTP.Types (Status, status200, status404, status502)
|
|
import NamesResolverServer (memCfg, memCfg2, memProxyCfg, withNames)
|
|
import qualified NamesResolverServer as NRS
|
|
import SMPAgentClient
|
|
import SMPClient
|
|
import SMPNamesTests (availableBody, registeredBody, 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)
|
|
import Simplex.Messaging.Protocol (SMPServer)
|
|
import qualified Simplex.Messaging.Protocol as SMP
|
|
import Simplex.Messaging.SimplexName (SimplexDomain (..), SimplexTLD (..))
|
|
import Simplex.Messaging.Transport
|
|
import Test.Hspec hiding (fit, it)
|
|
import Util (it)
|
|
|
|
nameSrvCfg :: SMPServer -> ServerCfg 'SMP.PSMP
|
|
nameSrvCfg = presetServerCfg True ServerRoles {storage = True, proxy = False, names = True} (Just 1) . SMP.noAuthSrv
|
|
|
|
proxySrvCfg :: SMPServer -> ServerCfg 'SMP.PSMP
|
|
proxySrvCfg = presetServerCfg True ServerRoles {storage = True, proxy = True, names = False} (Just 1) . SMP.noAuthSrv
|
|
|
|
oneSrv :: ServerCfg 'SMP.PSMP -> InitialAgentServers
|
|
oneSrv cfg_ = (initAgentServersProxy_ SPMNever SPFProhibit) {smp = [(1, [cfg_])]}
|
|
|
|
withDirectResolver :: (Status, LB.ByteString) -> (AgentClient -> IO a) -> IO a
|
|
withDirectResolver (st, body) k =
|
|
NRS.withResolverServer (NRS.resolveResp st body) $ \port _ ->
|
|
withSmpServerConfigOn (transport @TLS) (withNames port memCfg) testPort $ \_ ->
|
|
withAgent 1 agentCfg (oneSrv (nameSrvCfg testSMPServer)) testDB k
|
|
|
|
withProxyAndResolver :: (Status, LB.ByteString) -> (AgentClient -> IO a) -> IO a
|
|
withProxyAndResolver (st, body) k =
|
|
NRS.withResolverServer (NRS.resolveResp st body) $ \port _ ->
|
|
withSmpServerConfigOn (transport @TLS) memProxyCfg testPort $ \_ ->
|
|
withSmpServerConfigOn (transport @TLS) (withNames port memCfg2) testPort2 $ \_ ->
|
|
withAgent 1 agentCfg proxyServers testDB k
|
|
where
|
|
-- only testSMPServer2 (the resolver) has the names role; testSMPServer is the proxy
|
|
proxyServers = (initAgentServersProxy_ SPMAlways SPFProhibit) {smp = [(1, [proxySrvCfg testSMPServer, nameSrvCfg testSMPServer2])]}
|
|
|
|
withNoResolver :: (AgentClient -> IO a) -> IO a
|
|
withNoResolver k =
|
|
withSmpServerConfigOn (transport @TLS) memCfg testPort $ \_ ->
|
|
withAgent 1 agentCfg (oneSrv (nameSrvCfg testSMPServer)) testDB k
|
|
|
|
withNoNameServers :: (AgentClient -> IO a) -> IO a
|
|
withNoNameServers k = withAgent 1 agentCfg (oneSrv (proxySrvCfg testSMPServer)) testDB k
|
|
|
|
resolveNameTests :: Spec
|
|
resolveNameTests = do
|
|
describe "direct path (SPMNever)" $
|
|
it "a resolver error propagates as SMP host (NAME RESOLVER)" testDirectResolverErr
|
|
describe "proxy path (SPMAlways)" $
|
|
it "a resolver error propagates via proxy as SMP <proxyHost> (NAME RESOLVER)" testProxyResolverErr
|
|
describe "TLDTesting path" $
|
|
it "NAME RESOLVER for TLDTesting too" testTestingTldResolverErr
|
|
describe "TLDWeb path" $
|
|
it "NAME RESOLVER for TLDWeb too" testWebTldResolverErr
|
|
describe "no resolver configured" $
|
|
it "answers NAME NO_RESOLVER" testNoResolver
|
|
describe "no names servers (names role off everywhere)" $
|
|
it "fails agent-side with NO_NAME_SERVERS" testNoNameServers
|
|
describe "backing resolver failure" $
|
|
it "surfaces as SMP host (NAME (RESOLVER ..))" testBackendError
|
|
describe "success path" $
|
|
it "returns NameRecord" testDirectSuccess
|
|
describe "name availability" $
|
|
it "an unregistered name answers as available" testAvailSuccess
|
|
|
|
testAvailSuccess :: HasCallStack => IO ()
|
|
testAvailSuccess =
|
|
withDirectResolver (status200, availableBody) $ \c -> do
|
|
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
|
|
case r of
|
|
Right (SMP.NRAvailable {}) -> pure ()
|
|
_ -> expectationFailure $ "expected Right NRAvailable, got: " <> show r
|
|
|
|
-- | 404 is a resolver that predates /v2/resolve: no status from that endpoint
|
|
-- means "not registered", since an unregistered name answers NRAvailable.
|
|
testDirectResolverErr :: HasCallStack => IO ()
|
|
testDirectResolverErr =
|
|
withDirectResolver (status404, "{}") $ \c -> do
|
|
r <- runExceptT $ resolveSimplexName 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
|
|
|
|
testProxyResolverErr :: HasCallStack => IO ()
|
|
testProxyResolverErr =
|
|
withProxyAndResolver (status404, "{}") $ \c -> do
|
|
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
|
|
case r of
|
|
Left (SMP host (SMP.NAME (SMP.RESOLVER _))) | testPort `isInfixOf` host -> pure ()
|
|
_ -> expectationFailure $ "expected Left (SMP <proxyHost:" <> testPort <> "> (NAME (RESOLVER _))), got: " <> show r
|
|
|
|
testTestingTldResolverErr :: HasCallStack => IO ()
|
|
testTestingTldResolverErr =
|
|
withDirectResolver (status404, "{}") $ \c -> do
|
|
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDTesting "bob" [])
|
|
case r of
|
|
Left (SMP _ (SMP.NAME (SMP.RESOLVER _))) -> pure ()
|
|
_ -> expectationFailure $ "expected Left (SMP _ (NAME (RESOLVER _))), got: " <> show r
|
|
|
|
testWebTldResolverErr :: HasCallStack => IO ()
|
|
testWebTldResolverErr =
|
|
withDirectResolver (status404, "{}") $ \c -> do
|
|
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDWeb "example.com" [])
|
|
case r of
|
|
Left (SMP _ (SMP.NAME (SMP.RESOLVER _))) -> pure ()
|
|
_ -> expectationFailure $ "expected Left (SMP _ (NAME (RESOLVER _))), got: " <> show r
|
|
|
|
testNoResolver :: HasCallStack => IO ()
|
|
testNoResolver =
|
|
withNoResolver $ \c -> do
|
|
r <- runExceptT $ resolveSimplexName 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
|
|
|
|
testNoNameServers :: HasCallStack => IO ()
|
|
testNoNameServers =
|
|
withNoNameServers $ \c -> do
|
|
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
|
|
case r of
|
|
Left NO_NAME_SERVERS -> pure ()
|
|
_ -> expectationFailure $ "expected Left NO_NAME_SERVERS, got: " <> show r
|
|
|
|
testBackendError :: HasCallStack => IO ()
|
|
testBackendError =
|
|
withDirectResolver (status502, "{}") $ \c -> do
|
|
r <- runExceptT $ resolveSimplexName 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
|
|
|
|
testDirectSuccess :: HasCallStack => IO ()
|
|
testDirectSuccess =
|
|
withDirectResolver (status200, registeredBody testNameRecord) $ \c -> do
|
|
r <- runExceptT $ resolveSimplexName c NRMInteractive 1 (SimplexDomain TLDSimplex "alice" [])
|
|
case r of
|
|
Right (SMP.NRRegistered {nameRecord}) -> nameRecord `shouldBe` testNameRecord
|
|
_ -> expectationFailure $ "expected Right NRRegistered, got: " <> show r
|