chat: resolveOnUserServers iterates user SMP servers for RSLV

simplex-chat.cabal

@@ -583,6 +583,7 @@ test-suite simplex-chat-test
       ProtocolTests
       RandomServers
       RemoteTests
+      ResolveNameTests
       ValidNames
       ViewTests
       API.Docs.Commands

src/Simplex/Chat/Library/Commands.hs

@@ -98,7 +98,7 @@ import Simplex.Messaging.Agent.Store.Interface (execSQL)
 import Simplex.Messaging.Agent.Store.Shared (upMigration)
 import qualified Simplex.Messaging.Agent.Store.DB as DB
 import Simplex.Messaging.Agent.Store.Interface (getCurrentMigrations)
-import Simplex.Messaging.Client (NetworkConfig (..), NetworkRequestMode (..), NetworkTimeout (..), SMPWebPortServers (..), SocksMode (SMAlways), textToHostMode)
+import Simplex.Messaging.Client (NetworkConfig (..), NetworkRequestMode (..), NetworkTimeout (..), ProxyClientError (..), SMPWebPortServers (..), SocksMode (SMAlways), pattern NRMInteractive, textToHostMode)
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.ShortLink as SL
 import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
@@ -107,7 +107,8 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), patt
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (base64P)
-import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), MsgFlags (..), NtfServer, ProtoServerWithAuth (..), ProtocolServer, ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), SubscriptionMode (..), UserProtocol, userProtocol)
+import Simplex.Messaging.Protocol (AProtoServerWithAuth (..), AProtocolType (..), MsgFlags (..), NameRecord, NtfServer, ProtoServerWithAuth (..), ProtocolServer, ProtocolType (..), ProtocolTypeI (..), SMPServer, SProtocolType (..), SubscriptionMode (..), UserProtocol, userProtocol)
+import qualified Simplex.Messaging.Protocol as SMP
 import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
 import qualified Simplex.Messaging.TMap as TM
 import Simplex.Messaging.Transport.Client (defaultSocksProxyWithAuth)
@@ -4624,6 +4625,62 @@ processChatCommand vr nm = \case
       gVar <- asks random
       liftIO $ SharedMsgId <$> encodedRandomBytes gVar 12
 
+-- | Failure modes for 'resolveOnUserServers' / 'iterateResolvers'.
+data ResolveError
+  = -- | No enabled SMP server speaks RSLV (every one returned CMD PROHIBITED, or no servers configured).
+    ResolverUnavailable
+  | -- | AUTH from a name-capable server. Every name server reads the same on-chain state, so we trust the first one's no.
+    NameNotRegistered
+  | -- | Last non-PROHIBITED, non-AUTH error (network, proxy, timeout). Surface to user so they can retry.
+    ResolverTransport AgentErrorType
+  deriving (Eq, Show)
+
+-- | Return the user's enabled SMP servers (preset and custom, excluding deleted).
+-- Mirrors the filter applied by 'useServers' before configuring the agent.
+enabledSMPServersForUser :: User -> CM [SMPServer]
+enabledSMPServersForUser user =
+  mapMaybe enabledSrv <$> withFastStore' (\db -> getProtocolServers db SPSMP user)
+  where
+    enabledSrv UserServer {server = ProtoServerWithAuth srv _, enabled, deleted}
+      | enabled && not deleted = Just srv
+      | otherwise = Nothing
+
+-- | Resolve a SimpleX name by trying the user's enabled SMP servers in order.
+-- AUTH from any name-capable server is treated as definitive NotFound: every
+-- name server reads the same on-chain state, so cross-server consensus is
+-- redundant for MVP. CMD PROHIBITED indicates the server doesn't speak
+-- namesSMPVersion; skip and try the next.
+resolveOnUserServers :: User -> SimplexNameDomain -> CM (Either ResolveError NameRecord)
+resolveOnUserServers user@User {userId} domain = do
+  srvs <- enabledSMPServersForUser user
+  a <- asks smpAgent
+  iterateResolvers srvs $ \srv ->
+    liftIO . runExceptT $ resolveSimplexName a NRMInteractive userId srv domain
+
+-- | Pure iteration logic for 'resolveOnUserServers'. Extracted so tests can
+-- supply a stub resolver without standing up a real agent / proxy.
+iterateResolvers ::
+  Monad m =>
+  [SMPServer] ->
+  (SMPServer -> m (Either AgentErrorType NameRecord)) ->
+  m (Either ResolveError NameRecord)
+iterateResolvers servers resolve = go servers Nothing
+  where
+    go [] lastErr = pure $ Left $ maybe ResolverUnavailable ResolverTransport lastErr
+    go (srv : rest) prevErr =
+      resolve srv >>= \case
+        Right nr -> pure $ Right nr
+        Left e
+          | isNotRegistered e -> pure $ Left NameNotRegistered
+          | isUnsupported e -> go rest prevErr
+          | otherwise -> go rest (Just e)
+    isNotRegistered = \case
+      SMP _ SMP.AUTH -> True
+      _ -> False
+    isUnsupported = \case
+      PROXY _ _ (ProxyProtocolError (SMP.CMD SMP.PROHIBITED)) -> True
+      _ -> False
+
 data ConnectViaContactResult
   = CVRConnectedContact Contact
   | CVRSentInvitation Connection (Maybe Profile)

tests/ResolveNameTests.hs

@@ -0,0 +1,91 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+module ResolveNameTests (resolveNameTests) where
+
+import Data.Functor.Identity (Identity (..))
+import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
+import qualified Data.Map.Strict as M
+import Simplex.Chat.Library.Commands (ResolveError (..), iterateResolvers)
+import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Agent.Protocol (AgentErrorType (..))
+import Simplex.Messaging.Client (ProxyClientError (..))
+import Simplex.Messaging.Protocol (NameRecord (..), SMPServer, mkNameOwner, pattern SMPServer)
+import qualified Simplex.Messaging.Protocol as SMP
+import Test.Hspec
+
+-- | iterateResolvers is the testable core of resolveOnUserServers: it walks
+-- a list of candidate SMP servers, querying a resolver per server, applying
+-- the AUTH-is-NotFound and PROHIBITED-is-skip rules from the plan.
+resolveNameTests :: Spec
+resolveNameTests = describe "iterateResolvers" $ do
+  it "returns the first server's NameRecord on hit" $ do
+    let r = runIdentity $ iterateResolvers [srv1, srv2] $ \_ -> pure $ Right sampleRecord
+    r `shouldBe` Right sampleRecord
+  it "skips CMD PROHIBITED servers and uses the next one's success" $ do
+    callsRef <- newIORef []
+    r <- iterateResolvers [srv1, srv2] (recording callsRef stubProhibitedThenHit)
+    r `shouldBe` Right sampleRecord
+    -- both servers must be consulted, in order
+    readIORef callsRef `shouldReturn` [srv1, srv2]
+  it "treats AUTH as definitive NameNotRegistered and stops iteration" $ do
+    callsRef <- newIORef []
+    r <- iterateResolvers [srv1, srv2] (recording callsRef stubAuthThenHit)
+    r `shouldBe` Left NameNotRegistered
+    -- second server must NOT be consulted: AUTH is authoritative
+    readIORef callsRef `shouldReturn` [srv1]
+  it "returns ResolverUnavailable when every server is non-name-capable" $ do
+    let r = runIdentity $ iterateResolvers [srv1, srv2] (\_ -> pure $ Left prohibitedErr)
+    r `shouldBe` Left ResolverUnavailable
+  it "returns ResolverTransport when only transport-style errors are seen" $ do
+    let r = runIdentity $ iterateResolvers [srv1, srv2] (\_ -> pure $ Left timeoutErr)
+    case r of
+      Left (ResolverTransport _) -> pure ()
+      other -> expectationFailure $ "expected ResolverTransport, got " <> show other
+  it "returns ResolverUnavailable on an empty server list" $ do
+    let r = runIdentity $ iterateResolvers [] (\_ -> pure $ Right sampleRecord)
+    r `shouldBe` Left ResolverUnavailable
+
+-- | Wrap a resolver to record which servers it was called for.
+recording :: IORef [SMPServer] -> (SMPServer -> IO (Either AgentErrorType NameRecord)) -> SMPServer -> IO (Either AgentErrorType NameRecord)
+recording ref f srv = modifyIORef' ref (<> [srv]) >> f srv
+
+stubProhibitedThenHit :: SMPServer -> IO (Either AgentErrorType NameRecord)
+stubProhibitedThenHit srv = pure $ M.findWithDefault (Right sampleRecord) srv $ M.fromList [(srv1, Left prohibitedErr)]
+
+stubAuthThenHit :: SMPServer -> IO (Either AgentErrorType NameRecord)
+stubAuthThenHit srv = pure $ M.findWithDefault (Right sampleRecord) srv $ M.fromList [(srv1, Left authErr)]
+
+srv1 :: SMPServer
+srv1 = SMPServer "smp1.example" "5223" (C.KeyHash "\1\2\3\4")
+
+srv2 :: SMPServer
+srv2 = SMPServer "smp2.example" "5223" (C.KeyHash "\5\6\7\8")
+
+sampleRecord :: NameRecord
+sampleRecord =
+  NameRecord
+    { nrDisplayName = "alice",
+      -- mkNameOwner enforces the 20-byte invariant; this string is intentionally 20 ASCII bytes.
+      nrOwner = either error id $ mkNameOwner "owner-bytes-1234567x",
+      nrChannelLinks = [],
+      nrContactLinks = [],
+      nrAdminAddress = Nothing,
+      nrAdminEmail = Nothing,
+      nrExpiry = 0,
+      nrIsTest = True
+    }
+
+-- AUTH from a name-capable destination relay: surfaces as SMP host AUTH
+-- (see Simplex.Messaging.Agent.Client.protocolClientError).
+authErr :: AgentErrorType
+authErr = SMP "smp1.example" SMP.AUTH
+
+-- CMD PROHIBITED on the PFWD path: surfaces as PROXY ... (ProxyProtocolError ...).
+prohibitedErr :: AgentErrorType
+prohibitedErr = PROXY "proxy.example" "smp1.example" (ProxyProtocolError (SMP.CMD SMP.PROHIBITED))
+
+-- A generic transport-style failure that should bubble up as ResolverTransport
+-- when no name-capable server was reached.
+timeoutErr :: AgentErrorType
+timeoutErr = INTERNAL "simulated network timeout"

tests/Test.hs

@@ -19,6 +19,7 @@ import ProtocolTests
 import OperatorTests
 import RandomServers
 import RemoteTests
+import ResolveNameTests
 import Test.Hspec hiding (it)
 import UnliftIO.Temporary (withTempDirectory)
 import ValidNames
@@ -69,6 +70,7 @@ main = do
       describe "Message batching" batchingTests
       describe "Operators" operatorTests
       describe "Random servers" randomServersTests
+      describe "Resolve SimpleX name" resolveNameTests
 #if defined(dbPostgres)
       createdDropDb . around testBracket
 #else