smp-server: support namespaces (#1784)

* smp-server: namespaces resolver scaffolding

* smp-server: Names resolver hardening + cleanup

* smp-server: fuse parallel dispatchers

* smp-server: JSON wire format for NameRecord + Names.hs restructure

* smp-server: redact RpcAuth in Show

* smp-server: JSON wire fixups + spec rewrite + small cleanups

* plan: prepend implementation-diverged banner

* move SimplexName into shared module

* smp-server: name + contract whitelist on RSLV

* smp-server: address audit findings (canonical JSON, INI guards, SSRF, TLD case, shutdown)

* smp-server: round 2 audit fixes (label case, response cap, ipv6 link-local)

* smp-server: round 3 audit fixes (SSRF coverage, drop noop closeManager, CSV order)

* smp-server: round 4 audit fixes (0X-hex host, expanded IPv6 forms, pingEndpoint timeout)

* smp-server: hardcode TldRegistries (drop registry_tld_* INI keys)

* smp-server: round 6 audit fixes (IPv6 SSRF, redirects, ASCII labels)

- Reject IPv6 aliases of 169.254.169.254 (IPv4-compatible / IPv4-mapped /
  6to4 / NAT64) via numeric range check on parsed IPv6.
- Disable HTTP redirects on the Eth RPC request.
- Restrict SimplexName labels to ASCII (Cyrillic/Greek/full-width otherwise
  hash to different on-chain records and diverge from UTS-46 registrars).
- pingEndpoint: only JsonRpcErr means "reachable"; transport/decode failures
  fail startup. boundedIniInt: readMaybe over partial read.
- Add 127.0.0.0/8 and 0.0.0.0 to isLoopback.
- Replace hand-rolled hex helpers with Data.ByteArray.Encoding; raise
  managerConnCount to match rpcMaxConcurrency; hex Show for NameOwner.
- Fuse parallel http/https when into unless+case; drop reverse/re-reverse
  in mkDomain TLDWeb; first AbiInvariantViolated; Nothing <$ decodeAddress;
  forM_ (eitherToMaybe ...); >>= chain in NameOwner FromJSON.
- Drop dead imports/exports/pragmas and two restating comments.
- Tests: factor unsafeOwner/unsafeLink, addr1/2/3, testNamesConfig; add
  non-ASCII label rejection coverage.

* namespace: bound parser input to 253 bytes (DoS defense)

The bare-name fallback and bareDomain parser would otherwise consume
arbitrarily many non-space bytes via takeWhile1 before any validation
or length check. A crafted multi-megabyte token would be decoded as
UTF-8 and re-parsed in full before being rejected.

Introduce `boundedNonSpace` (scan with 253-byte cap) at the two
takeWhile1 sites. Inputs longer than 253 bytes leave residue that
parseOnly's implicit endOfInput rejects, so the parser fails fast
without ever allocating the full input.

The bound is the DNS full-domain limit, chosen for being a familiar
ceiling generous enough to cover any realistic SimpleX name (longest
plausible @user.subdomain.simplex stays well under 100 bytes). No
per-label cap — SimpleX names don't go through DNS label resolution
and there's no semantic reason to constrain individual labels.

* namespace: switch to Python HTTP resolver + agent plumbing (#1796)

* namespace: relax resolver_endpoint validation (path prefix, http without auth)

validateUrl gains two operator-friendly relaxations and a regression test:

- Allow a path prefix (e.g. https://gw.example.com:443/snrc) for a resolver
  behind a reverse-proxy sub-path; /resolve/<name> and /health are appended
  (HttpResolver already strips one trailing slash, so root and sub-path
  behave identically). Query/fragment/userinfo stay rejected.

- Off-loopback, reject only http WITH resolver_auth (the Authorization header
  would travel in cleartext). http without auth is now allowed (no secret to
  leak; resolver data is public — also lets dev setups reach a host resolver
  via http://host.docker.internal). https is always allowed, with or without
  auth. Plain http has no response integrity; intended for trusted/local
  networks only.

Exports validateUrl and adds validateUrlSpec (11 cases) to SMPNamesTests.

* namespace: NameRecord links as arrays (multi-link, cap 5)

* namespace: distinct RSLV error responses

RSLV collapsed every non-hit (no resolver, malformed name, not found,
backing-store failure) to ERR AUTH, so a client iterating its configured
servers could not tell "this router has no resolver, try the next" from
"name not registered, stop", and a transient backend error read as an
authoritative miss.

Names capability is runtime config, orthogonal to the linear SMP version
(a future v21 router without [NAMES] must still advertise v21), so it is
signalled by a command-time error like allowSMPProxy, not by the version
range:

  no resolver configured -> ERR CMD PROHIBITED  (client skips, tries next)
  backing-store failure   -> ERR INTERNAL        (transient: retry/surface)
  not found / malformed   -> ERR AUTH            (authoritative "no such name")

Update the protocol spec error table and add agent tests for the
no-resolver (CMD PROHIBITED) and backend-failure (INTERNAL) paths.

* refactor(names): server role + one error type

Addresses epoberezkin's review (PR #1784). Name resolution becomes a
server role like proxy; the agent owns resolution + server selection;
one error type flows through the whole stack.

- ServerRoles gains `names`; UserServers gains `nameSrvs` (opt-in list);
  resolveSimplexName drops the explicit server arg and picks a
  names-capable server via getNextServer.
- RSLV carries SimplexNameDomain (was RslvRequest): no JSON on the wire,
  contract dropped, name validated at parse (invalid -> CMD SYNTAX).
- Version check moves from the encoder to Client.hs (no ERR to server).
- ErrorType.NAME {nameErr :: NameErrorType} (+ AgentErrorType.NAME),
  wire- and JSON-encoded; resolver errors surface with diagnostics.
  Success response renamed NAME -> RNAME to free the collision.
- NameOwner -> EthAddress (record selector); NameRecord derives FromJSON
  and gains field-ordered Encoding; per-field caps removed.
- Remove newEnvWithNames / runSMPServerBlockingWithNames test seams;
  stub resolver folded into ServerConfig.namesResolverCall_.

* test(server): update stats backup line count

NameResolverStatsData adds 6 lines to the server stats backup (the
"rslvStats:" header plus the reqs/succ/notFound/resolverErrs/disabled
fields), so testRestoreMessages' expected stats-backup line count is
95 -> 101.

* feat(names): public-namespace resolution via RSLV/RNAME

SNRC names resolver role: RSLV command -> HTTP resolver -> RNAME record.
Agent owns server selection (ServerRoles.names); NAME error family; async,
concurrency-bounded resolution; length-prefixed extensible wire; spec.

* remove comments

Co-authored-by: Evgeny <evgeny@poberezkin.com>

* simplify

* move tests name

* simplify: text addresses, Tail JSON, drop admitRslv

* fix

* remove spaghetti

* reduce diff

* async again, refactor

* different threads limit for name resolutions

* remove comment

* FromField instance for SimplexNameInfo

* remove comments

* unStrJSON

* add sameConnShortLink

* remove scheme prefix

* remove unused import

* remove connecttarget tests

* remove comment

* comment

---------

Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
This commit is contained in:
sh
2026-06-30 22:54:55 +01:00
committed by GitHub
co-authored by Evgeny Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
parent be58967a86
commit 209f7826cb
31 changed files with 2152 additions and 153 deletions
+77 -40
View File
@@ -65,7 +65,7 @@ import Data.Constraint (Dict (..))
import Data.Dynamic (toDyn)
import Data.Either (fromRight, partitionEithers)
import Data.Foldable (foldrM)
import Data.Functor (($>))
import Data.Functor (($>), (<&>))
import Data.IORef
import Data.Int (Int64)
import qualified Data.IntMap.Strict as IM
@@ -103,11 +103,13 @@ import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Protocol
import Simplex.Messaging.SimplexName (SimplexNameDomain)
import Simplex.Messaging.Server.Control
import Simplex.Messaging.Server.Env.STM as Env
import Simplex.Messaging.Server.Expiration
import Simplex.Messaging.Server.MsgStore
import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgStore, JournalQueue (..), getJournalQueueMessages)
import Simplex.Messaging.Server.Names (NamesEnv, closeNamesEnv, resolveName)
import Simplex.Messaging.Server.MsgStore.STM
import Simplex.Messaging.Server.MsgStore.Types
import Simplex.Messaging.Server.NtfStore
@@ -245,7 +247,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
saveServerStats
closeServer :: M s ()
closeServer = asks (smpAgent . proxyAgent) >>= liftIO . closeSMPClientAgent
closeServer = do
asks (smpAgent . proxyAgent) >>= liftIO . closeSMPClientAgent
asks namesEnv >>= liftIO . mapM_ closeNamesEnv
serverThread ::
forall sub. String ->
@@ -517,7 +521,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
initialDelay <- (startAt -) . fromIntegral . (`div` 1000000_000000) . diffTimeToPicoseconds . utctDayTime <$> liftIO getCurrentTime
liftIO $ putStrLn $ "server stats log enabled: " <> statsFilePath
liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0)
ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedAllB, qDeletedNew, qDeletedSecured, qSub, qSubAllB, qSubAuth, qSubDuplicate, qSubProhibited, qSubEnd, qSubEndB, ntfCreated, ntfDeleted, ntfDeletedB, ntfSub, ntfSubB, ntfSubAuth, ntfSubDuplicate, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgRecvGet, msgGet, msgGetNoMsg, msgGetAuth, msgGetDuplicate, msgGetProhibited, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, ntfCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv, rcvServices, ntfServices}
ss@ServerStats {fromTime, qCreated, qSecured, qDeletedAll, qDeletedAllB, qDeletedNew, qDeletedSecured, qSub, qSubAllB, qSubAuth, qSubDuplicate, qSubProhibited, qSubEnd, qSubEndB, ntfCreated, ntfDeleted, ntfDeletedB, ntfSub, ntfSubB, ntfSubAuth, ntfSubDuplicate, msgSent, msgSentAuth, msgSentQuota, msgSentLarge, msgRecv, msgRecvGet, msgGet, msgGetNoMsg, msgGetAuth, msgGetDuplicate, msgGetProhibited, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount, ntfCount, pRelays, pRelaysOwn, pMsgFwds, pMsgFwdsOwn, pMsgFwdsRecv, rcvServices, ntfServices, rslvStats}
<- asks serverStats
st <- asks msgStore
EntityCounts {queueCount, notifierCount, rcvServiceCount, ntfServiceCount, rcvServiceQueuesCount, ntfServiceQueuesCount} <-
@@ -580,6 +584,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
qCount' <- readIORef qCount
msgCount' <- readIORef msgCount
ntfCount' <- readIORef ntfCount
rslvStats' <- getResetNameResolverStatsData rslvStats
T.hPutStrLn h $
T.intercalate
","
@@ -653,6 +658,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
]
<> showServiceStats rcvServices'
<> showServiceStats ntfServices'
<> showNameResolverStats rslvStats'
)
liftIO $ threadDelay' interval
where
@@ -660,6 +666,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
map tshow [_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther]
showServiceStats ServiceStatsData {_srvAssocNew, _srvAssocDuplicate, _srvAssocUpdated, _srvAssocRemoved, _srvSubCount, _srvSubDuplicate, _srvSubQueues, _srvSubEnd} =
map tshow [_srvAssocNew, _srvAssocDuplicate, _srvAssocUpdated, _srvAssocRemoved, _srvSubCount, _srvSubDuplicate, _srvSubQueues, _srvSubEnd]
showNameResolverStats NameResolverStatsData {_rslvReqs, _rslvSucc, _rslvNotFound, _rslvResolverErrs, _rslvDisabled} =
map tshow [_rslvReqs, _rslvSucc, _rslvNotFound, _rslvResolverErrs, _rslvDisabled]
prometheusMetricsThread_ :: ServerConfig s -> [M s ()]
prometheusMetricsThread_ ServerConfig {prometheusInterval = Just interval, prometheusMetricsFile} =
@@ -1266,6 +1274,7 @@ verifyQueueTransmission service thAuth (tAuth, authorized, (corrId, entId, comma
vc SNotifierService NSUBS {} = verifyServiceCmd
vc SProxiedClient _ = VRVerified Nothing
vc SProxyService (RFWD _) = VRVerified Nothing
vc SResolver (RSLV _) = VRVerified Nothing
checkRole = case (service, partyClientRole p) of
(Just THClientService {serviceRole}, Just role) -> serviceRole == role
_ -> True
@@ -1463,19 +1472,40 @@ client
Nothing -> inc False pRequests >> inc False pErrorsConnect $> Just (ERR $ PROXY NO_SESSION)
where
forkProxiedCmd :: M s BrokerMsg -> M s (Maybe BrokerMsg)
forkProxiedCmd cmdAction = do
bracket_ wait signal . forkClient clnt (B.unpack $ "client $" <> encode sessionId <> " proxy") $ do
-- commands MUST be processed under a reasonable timeout or the client would halt
cmdAction >>= \t -> atomically $ writeTBQueue sndQ ([(corrId, EntityId sessId, t)], [])
pure Nothing
where
wait = do
ServerConfig {serverClientConcurrency} <- asks config
atomically $ do
used <- readTVar procThreads
when (used >= serverClientConcurrency) retry
writeTVar procThreads $! used + 1
signal = atomically $ modifyTVar' procThreads (\t -> t - 1)
forkProxiedCmd = forkCmd serverClientConcurrency corrId (EntityId sessId)
-- Run a slow command on a thread
forkCmd :: (ServerConfig s -> Int) -> CorrId -> EntityId -> M s BrokerMsg -> M s (Maybe a)
forkCmd concurrency corrId entId cmdAction = do
bracket_ wait signal . forkClient clnt (B.unpack $ "client $" <> encode sessionId <> " cmd") $
-- commands MUST be processed under a reasonable timeout or the client would halt
cmdAction >>= \t -> atomically $ writeTBQueue sndQ ([(corrId, entId, t)], [])
pure Nothing
where
wait = do
limit <- asks (concurrency . config)
atomically $ do
used <- readTVar procThreads
when (used >= limit) retry
writeTVar procThreads $! used + 1
signal = atomically $ modifyTVar' procThreads (\t -> t - 1)
rslvNamesEnv :: M s (Maybe NamesEnv)
rslvNamesEnv = do
st <- asks (rslvStats . serverStats)
incStat (rslvReqs st)
asks namesEnv >>= \case
Nothing -> incStat (rslvDisabled st) $> Nothing
Just nenv -> pure (Just nenv)
-- Runs on a forked thread so RSLV does not block other commands;
-- concurrency is limited by serverResolverConcurrency in forkCmd.
resolveNameMsg :: NamesEnv -> SimplexNameDomain -> M s BrokerMsg
resolveNameMsg nenv d = do
st <- asks (rslvStats . serverStats)
(selector, msg) <-
liftIO (resolveName nenv d) <&> \case
Right rec -> (rslvSucc, RNAME rec)
Left e@NOT_FOUND -> (rslvNotFound, ERR $ NAME e)
Left e -> (rslvResolverErrs, ERR $ NAME e)
incStat (selector st) $> msg
transportErr :: TransportError -> ErrorType
transportErr = PROXY . BROKER . TRANSPORT
mkIncProxyStats :: MonadIO m => ProxyStats -> ProxyStats -> OwnServer -> (ProxyStats -> IORef Int) -> m ()
@@ -1489,7 +1519,10 @@ client
SKEY k -> withQueue $ \q qr -> checkMode QMMessaging qr $ secureQueue_ q k
SEND flags msgBody -> response <$> withQueue_ False err (sendMessage flags msgBody)
Cmd SIdleClient PING -> pure $ response (corrId, NoEntity, PONG)
Cmd SProxyService (RFWD encBlock) -> response . (corrId,NoEntity,) <$> processForwardedCommand encBlock
Cmd SProxyService (RFWD encBlock) -> (response . (corrId, NoEntity,) =<<) <$> processForwardedCommand encBlock
Cmd SResolver (RSLV d) -> rslvNamesEnv >>= \case
Nothing -> pure $ response (corrId, NoEntity, ERR (NAME NO_RESOLVER))
Just nenv -> forkCmd serverResolverConcurrency corrId NoEntity (resolveNameMsg nenv d)
Cmd SSenderLink command -> case command of
LKEY k -> withQueue $ \q qr -> checkMode QMMessaging qr $ secureQueue_ q k $>> getQueueLink_ q qr
LGET -> withQueue $ \q qr -> checkContact qr $ getQueueLink_ q qr
@@ -2087,8 +2120,8 @@ client
encNMsgMeta = C.cbEncrypt rcvNtfDhSecret ntfNonce (smpEncode msgMeta) 128
pure $ MsgNtf {ntfMsgId = msgId, ntfTs = msgTs, ntfNonce, ntfEncMeta = fromRight "" encNMsgMeta}
processForwardedCommand :: EncFwdTransmission -> M s BrokerMsg
processForwardedCommand (EncFwdTransmission s) = fmap (either ERR RRES) . runExceptT $ do
processForwardedCommand :: EncFwdTransmission -> M s (Maybe BrokerMsg)
processForwardedCommand (EncFwdTransmission s) = fmap (either (Just . ERR) id) . runExceptT $ do
THAuthServer {serverPrivKey, sessSecret'} <- maybe (throwE $ transportErr TENoServerAuth) pure (thAuth thParams')
sessSecret <- maybe (throwE $ transportErr TENoServerAuth) pure sessSecret'
let proxyNonce = C.cbNonce $ bs corrId
@@ -2103,28 +2136,31 @@ client
t :| [] -> pure $ tDecodeServer clntTHParams t
_ -> throwE BLOCK
let clntThAuth = Just $ THAuthServer {serverPrivKey, peerClientService = Nothing, sessSecret' = Just clientSecret}
-- process forwarded command
r <-
lift (rejectOrVerify clntThAuth t') >>= \case
Left r -> pure r
-- rejectOrVerify filters allowed commands, no need to repeat it here.
-- INTERNAL is used because processCommand never returns Nothing for sender commands (could be extracted for better types).
-- `fst` removes empty message that is only returned for `SUB` command
Right t''@(_, (corrId', entId', _)) -> maybe (corrId', entId', ERR INTERNAL) fst <$> lift (processCommand Nothing fwdVersion (Right (M.empty, M.empty, M.empty)) t'')
-- encode response
r' <- case batchTransmissions clntTHParams [Right (Nothing, encodeTransmission clntTHParams r)] of
[] -> throwE INTERNAL -- at least 1 item is guaranteed from NonEmpty/Right
TBError _ _ : _ -> throwE BLOCK
TBTransmission b' _ : _ -> pure b'
TBTransmissions b' _ _ : _ -> pure b'
-- encrypt to client
r2 <- liftEitherWith (const BLOCK) $ EncResponse <$> C.cbEncrypt clientSecret (C.reverseNonce clientNonce) r' paddedProxiedTLength
-- encrypt to proxy
let fr = FwdResponse {fwdCorrId, fwdResponse = r2}
r3 = EncFwdResponse $ C.cbEncryptNoPad sessSecret (C.reverseNonce proxyNonce) (smpEncode fr)
encodeResp r = do
r' <- case batchTransmissions clntTHParams [Right (Nothing, encodeTransmission clntTHParams r)] of
[] -> throwE INTERNAL -- at least 1 item is guaranteed from NonEmpty/Right
TBError _ _ : _ -> throwE BLOCK
TBTransmission b' _ : _ -> pure b'
TBTransmissions b' _ _ : _ -> pure b'
r2 <- liftEitherWith (const BLOCK) $ EncResponse <$> C.cbEncrypt clientSecret (C.reverseNonce clientNonce) r' paddedProxiedTLength
let fr = FwdResponse {fwdCorrId, fwdResponse = r2}
pure $ RRES $ EncFwdResponse $ C.cbEncryptNoPad sessSecret (C.reverseNonce proxyNonce) (smpEncode fr)
-- the inner response, or Nothing if forked (RSLV).
r_ <- lift (rejectOrVerify clntThAuth t') >>= \case
-- rejectOrVerify filters allowed commands, no need to repeat it here.
Left r -> pure $ Just r
Right t''@(_, (corrId', entId', cmd')) -> case cmd' of
Cmd SResolver (RSLV d) -> lift $ rslvNamesEnv >>= \case
Nothing -> pure $ Just (corrId', entId', ERR (NAME NO_RESOLVER))
Just nenv -> forkCmd serverResolverConcurrency corrId NoEntity $ do
msg <- resolveNameMsg nenv d
either ERR id <$> runExceptT (encodeResp (corrId', entId', msg))
-- INTERNAL because processCommand never returns Nothing for sender commands;
-- `fst` drops the empty message only returned for SUB.
_ -> Just . maybe (corrId', entId', ERR INTERNAL) fst <$> lift (processCommand Nothing fwdVersion (Right (M.empty, M.empty, M.empty)) t'')
stats <- asks serverStats
incStat $ pMsgFwdsRecv stats
pure r3
traverse encodeResp r_
where
rejectOrVerify :: Maybe (THandleAuth 'TServer) -> SignedTransmissionOrError ErrorType Cmd -> M s (VerifiedTransmissionOrError s)
rejectOrVerify clntThAuth = \case
@@ -2138,6 +2174,7 @@ client
Cmd SSender (SKEY _) -> True
Cmd SSenderLink (LKEY _) -> True
Cmd SSenderLink LGET -> True
Cmd SResolver (RSLV _) -> True
_ -> False
verified = \case
VRVerified q -> Right (q, t'')
@@ -2472,4 +2509,4 @@ restoreServerStats msgStats_ ntfStats = asks (serverStatsBackupFile . config) >>
logNote $ "error restoring server stats: " <> T.pack e
liftIO exitFailure
compareCounts name statsCnt storeCnt =
when (statsCnt /= storeCnt) $ logWarn $ name <> " count differs: stats: " <> tshow statsCnt <> ", store: " <> tshow storeCnt
when (statsCnt /= storeCnt) $ logWarn $ name <> " count differs: stats: " <> tshow statsCnt <> ", store: " <> tshow storeCnt