mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-07-30 16:12:13 +00:00
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
co-authored by
Evgeny Poberezkin
Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
Evgeny Poberezkin
Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
parent
be58967a86
commit
209f7826cb
@@ -67,6 +67,7 @@ module Simplex.Messaging.Server.Env.STM
|
||||
defaultNtfExpiration,
|
||||
defaultInactiveClientExpiration,
|
||||
defaultProxyClientConcurrency,
|
||||
defaultNameResolverConcurrency,
|
||||
defaultMaxJournalMsgCount,
|
||||
defaultMaxJournalStateLines,
|
||||
defaultIdleQueueInterval,
|
||||
@@ -115,6 +116,7 @@ import Simplex.Messaging.Server.Information
|
||||
import Simplex.Messaging.Server.MsgStore.Journal
|
||||
import Simplex.Messaging.Server.MsgStore.STM
|
||||
import Simplex.Messaging.Server.MsgStore.Types
|
||||
import Simplex.Messaging.Server.Names (NamesConfig (..), NamesEnv, newNamesEnv, pingEndpoint)
|
||||
import Simplex.Messaging.Server.NtfStore
|
||||
import Simplex.Messaging.Server.QueueStore
|
||||
import Simplex.Messaging.Server.QueueStore.Postgres.Config
|
||||
@@ -128,7 +130,7 @@ import Simplex.Messaging.TMap (TMap)
|
||||
import qualified Simplex.Messaging.TMap as TM
|
||||
import Simplex.Messaging.Transport (ASrvTransport, SMPVersion, THandleParams, TransportPeer (..), VersionRangeSMP)
|
||||
import Simplex.Messaging.Transport.Server
|
||||
import Simplex.Messaging.Util (ifM, whenM, ($>>=))
|
||||
import Simplex.Messaging.Util (ifM, tshow, whenM, ($>>=))
|
||||
import System.Directory (doesFileExist)
|
||||
import System.Exit (exitFailure)
|
||||
import System.IO (IOMode (..))
|
||||
@@ -197,6 +199,13 @@ data ServerConfig s = ServerConfig
|
||||
smpAgentCfg :: SMPClientAgentConfig,
|
||||
allowSMPProxy :: Bool, -- auth is the same with `newQueueBasicAuth`
|
||||
serverClientConcurrency :: Int,
|
||||
-- | max concurrent name resolutions per connection, enforced in forkCmd.
|
||||
-- Much higher than serverClientConcurrency: forwarded RSLVs from many clients
|
||||
-- aggregate over a single proxy->relay connection (only servers send proxied
|
||||
-- requests), so bounding them by the per-client limit would throttle unduly.
|
||||
serverResolverConcurrency :: Int,
|
||||
-- | public-namespace resolver config; Nothing disables the names role
|
||||
namesConfig :: Maybe NamesConfig,
|
||||
-- | server public information
|
||||
information :: Maybe ServerPublicInfo,
|
||||
startOptions :: StartOptions
|
||||
@@ -243,6 +252,9 @@ defaultInactiveClientExpiration =
|
||||
defaultProxyClientConcurrency :: Int
|
||||
defaultProxyClientConcurrency = 32
|
||||
|
||||
defaultNameResolverConcurrency :: Int
|
||||
defaultNameResolverConcurrency = 1000
|
||||
|
||||
journalMsgStoreDepth :: Int
|
||||
journalMsgStoreDepth = 5
|
||||
|
||||
@@ -272,7 +284,8 @@ data Env s = Env
|
||||
serverStats :: ServerStats,
|
||||
sockets :: TVar [(ServiceName, SocketState)],
|
||||
clientSeq :: TVar ClientId,
|
||||
proxyAgent :: ProxyAgent -- senders served on this proxy
|
||||
proxyAgent :: ProxyAgent, -- senders served on this proxy
|
||||
namesEnv :: Maybe NamesEnv -- public-namespace resolver, present when [NAMES] enable: on
|
||||
}
|
||||
|
||||
msgStore :: Env s -> s
|
||||
@@ -558,7 +571,7 @@ newProhibitedSub = do
|
||||
return Sub {subThread = ProhibitSub, delivered}
|
||||
|
||||
newEnv :: ServerConfig s -> IO (Env s)
|
||||
newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smpAgentCfg, information, messageExpiration, idleQueueInterval, msgQueueQuota, maxJournalMsgCount, maxJournalStateLines} = do
|
||||
newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smpAgentCfg, information, messageExpiration, idleQueueInterval, msgQueueQuota, maxJournalMsgCount, maxJournalStateLines, namesConfig} = do
|
||||
serverActive <- newTVarIO True
|
||||
server <- newServer
|
||||
msgStore_ <- case serverStoreCfg of
|
||||
@@ -603,6 +616,16 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
|
||||
sockets <- newTVarIO []
|
||||
clientSeq <- newTVarIO 0
|
||||
proxyAgent <- newSMPProxyAgent smpAgentCfg random
|
||||
namesEnv <- forM namesConfig $ \nc -> do
|
||||
logInfo $ "[NAMES] resolver enabled, endpoint=" <> T.pack (resolverEndpoint nc)
|
||||
env <- newNamesEnv nc
|
||||
-- Probe the endpoint at startup. Don't exitFailure: a flapping network or a
|
||||
-- resolver host coming up minutes after smp-server should not block the
|
||||
-- server. Log so operators can spot it.
|
||||
pingEndpoint env >>= \case
|
||||
Right _ -> logInfo "[NAMES] endpoint probe ok"
|
||||
Left e -> logWarn $ "[NAMES] endpoint probe failed (server will still start, RSLV will return ERR (NAME ...) until reachable): " <> tshow e
|
||||
pure env
|
||||
pure
|
||||
Env
|
||||
{ serverActive,
|
||||
@@ -618,7 +641,8 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp
|
||||
serverStats,
|
||||
sockets,
|
||||
clientSeq,
|
||||
proxyAgent
|
||||
proxyAgent,
|
||||
namesEnv
|
||||
}
|
||||
where
|
||||
loadStoreLog :: StoreQueueClass q => (RecipientId -> QueueRec -> IO q) -> FilePath -> STMQueueStore q -> IO ()
|
||||
|
||||
@@ -34,6 +34,7 @@ module Simplex.Messaging.Server.Main
|
||||
simplexmqSource,
|
||||
serverPublicInfo,
|
||||
validCountryValue,
|
||||
validateUrl,
|
||||
printSourceCode,
|
||||
cliCommandP,
|
||||
strParse,
|
||||
@@ -50,7 +51,7 @@ import Data.Char (isAlpha, isAscii, toUpper)
|
||||
import Data.Either (fromRight)
|
||||
import Data.Functor (($>))
|
||||
import Data.Ini (Ini, lookupValue, readIniFile)
|
||||
import Data.List (find, isPrefixOf)
|
||||
import Data.List (dropWhileEnd, find, isPrefixOf)
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||
import Data.Text (Text)
|
||||
@@ -66,6 +67,7 @@ import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClie
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (parseAll)
|
||||
import Network.URI (URI (..), URIAuth (..), parseAbsoluteURI)
|
||||
import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (ProtoServerWithAuth), pattern SMPServer)
|
||||
import Simplex.Messaging.Server (AttachHTTP, exportMessages, importMessages, printMessageStats, runSMPServer)
|
||||
import Simplex.Messaging.Server.CLI
|
||||
@@ -76,6 +78,7 @@ import Simplex.Messaging.Server.Main.Init
|
||||
import Simplex.Messaging.Server.Web (EmbeddedWebParams (..), WebHttpsParams (..))
|
||||
import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgStore (..), QStoreCfg (..), stmQueueStore)
|
||||
import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), SQSType (..), SMSType (..), newMsgStore)
|
||||
import Simplex.Messaging.Server.Names (NamesConfig (..), RpcAuth (..))
|
||||
import Simplex.Messaging.Server.QueueStore.Postgres.Config
|
||||
import Simplex.Messaging.Server.StoreLog.ReadWrite (readQueueStore)
|
||||
import Simplex.Messaging.Transport (supportedProxyClientSMPRelayVRange, alpnSupportedSMPHandshakes, supportedServerSMPRelayVRange)
|
||||
@@ -605,6 +608,8 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
|
||||
},
|
||||
allowSMPProxy = True,
|
||||
serverClientConcurrency = readIniDefault defaultProxyClientConcurrency "PROXY" "client_concurrency" ini,
|
||||
serverResolverConcurrency = readIniDefault defaultNameResolverConcurrency "NAMES" "resolver_concurrency" ini,
|
||||
namesConfig = readNamesConfig ini,
|
||||
information = serverPublicInfo ini,
|
||||
startOptions
|
||||
}
|
||||
@@ -796,6 +801,64 @@ validCountryValue field s
|
||||
| length s == 2 && all (\c -> isAscii c && isAlpha c) s = Right $ T.pack $ map toUpper s
|
||||
| otherwise = Left $ "Use ISO3166 2-letter code for " <> field
|
||||
|
||||
readNamesConfig :: Ini -> Maybe NamesConfig
|
||||
readNamesConfig ini
|
||||
| not enabled = Nothing
|
||||
| otherwise =
|
||||
let resolverAuth_ = either (error . ("[NAMES] resolver_auth: " <>)) Just . parseRpcAuth =<< eitherToMaybe (lookupValue "NAMES" "resolver_auth" ini)
|
||||
endpoint = requiredText "resolver_endpoint"
|
||||
in Just
|
||||
NamesConfig
|
||||
{ resolverEndpoint = either (error . ("[NAMES] resolver_endpoint: " <>)) id (validateUrl endpoint resolverAuth_),
|
||||
resolverAuth = resolverAuth_,
|
||||
resolverTimeoutMs = boundedIniInt 3000 100 60000 "resolver_timeout_ms",
|
||||
resolverMaxResponseBytes = boundedIniInt 16000 1024 16000 "resolver_max_response_bytes"
|
||||
}
|
||||
where
|
||||
enabled = fromMaybe False (iniOnOff "NAMES" "enable" ini)
|
||||
requiredText key =
|
||||
either (error . (("[NAMES] " <> T.unpack key <> " is required: ") <>)) id $
|
||||
lookupValue "NAMES" key ini
|
||||
boundedIniInt def floor_ ceiling_ key = case lookupValue "NAMES" key ini of
|
||||
Left _ -> def
|
||||
Right raw -> case readMaybe (T.unpack (T.strip raw)) of
|
||||
Nothing ->
|
||||
error $ "[NAMES] " <> T.unpack key <> ": not an integer (got " <> show raw <> ")"
|
||||
Just n
|
||||
| n >= floor_ && n <= ceiling_ -> n
|
||||
| otherwise ->
|
||||
error $ "[NAMES] " <> T.unpack key <> " must be in [" <> show floor_ <> ".." <> show ceiling_ <> "] (got " <> show n <> ")"
|
||||
|
||||
-- | Validate the resolver_endpoint URL: it must be an absolute http(s) URL with a host.
|
||||
-- http + resolver_auth to a non-loopback host is rejected.
|
||||
validateUrl :: Text -> Maybe RpcAuth -> Either String String
|
||||
validateUrl url auth_ = do
|
||||
let s = T.unpack url
|
||||
uri <- maybe (Left "not an absolute URI") Right $ parseAbsoluteURI s
|
||||
let scheme = uriScheme uri
|
||||
unless (scheme == "http:" || scheme == "https:") $ Left "scheme must be http or https"
|
||||
ua <- maybe (Left "missing host") Right (uriAuthority uri)
|
||||
let host = uriRegName ua
|
||||
when (null host) $ Left "empty host"
|
||||
unless (null (uriUserInfo ua)) $ Left "userinfo (user:pass@) not allowed; put credentials in resolver_auth"
|
||||
when (scheme == "http:" && isJust auth_ && not (isLoopback host)) $
|
||||
Left "http with resolver_auth on a non-loopback host not allowed (the Authorization header would travel in cleartext); use https, or drop resolver_auth"
|
||||
Right (dropWhileEnd (== '/') s)
|
||||
where
|
||||
isLoopback h = h == "localhost" || h == "127.0.0.1" || h == "[::1]" || h == "0.0.0.0"
|
||||
|
||||
-- | Parse an rpc_auth INI value. Scheme keyword is case-insensitive so
|
||||
-- "Bearer <token>" / "BEARER <token>" (Caddy / RFC 7235 convention) work
|
||||
-- as well as the lowercase form.
|
||||
parseRpcAuth :: Text -> Either String RpcAuth
|
||||
parseRpcAuth t = case T.words t of
|
||||
[scheme, tok] | T.toLower scheme == "bearer" -> Right $ AuthBearer tok
|
||||
[scheme, up] | T.toLower scheme == "basic" -> case T.breakOn ":" up of
|
||||
(u, rest)
|
||||
| not (T.null u) && ":" `T.isPrefixOf` rest -> Right $ AuthBasic u (T.drop 1 rest)
|
||||
_ -> Left "basic auth expects user:password"
|
||||
_ -> Left "expected `bearer <token>` or `basic <user>:<pass>`"
|
||||
|
||||
printSourceCode :: Maybe Text -> IO ()
|
||||
printSourceCode = \case
|
||||
Just sourceCode -> T.putStrLn $ "Server source code: " <> sourceCode
|
||||
|
||||
@@ -154,6 +154,22 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
|
||||
\# socks_mode = onion\n\n\
|
||||
\# Limit number of threads a client can spawn to process proxy commands in parrallel.\n"
|
||||
<> ("# client_concurrency = " <> tshow defaultProxyClientConcurrency)
|
||||
<> "\n\n\
|
||||
\[NAMES]\n\
|
||||
\# Public-namespace resolution via the snrc-resolve.py REST resolver.\n\
|
||||
\# Operator runs the resolver alongside smp-server (default port 8000)\n\
|
||||
\# with its own Ethereum JSON-RPC endpoint configured in resolver.toml.\n\
|
||||
\enable: off\n\
|
||||
\# Same-host:\n\
|
||||
\# resolver_endpoint: http://127.0.0.1:8000\n\
|
||||
\# Resolver behind TLS reverse proxy:\n\
|
||||
\# resolver_endpoint: https://names.simplex.chat:443\n\
|
||||
\# resolver_auth: basic <username>:<password>\n\
|
||||
\# resolver_timeout_ms: 3000\n\
|
||||
\# resolver_max_response_bytes: 16000\n\
|
||||
\# Max concurrent name resolutions per connection (forwarded RSLVs from many\n\
|
||||
\# clients share one proxy connection, so this is much higher than PROXY client_concurrency).\n"
|
||||
<> ("# resolver_concurrency = " <> tshow defaultNameResolverConcurrency)
|
||||
<> "\n\n\
|
||||
\[INACTIVE_CLIENTS]\n\
|
||||
\# TTL and interval to check inactive clients\n\
|
||||
|
||||
@@ -0,0 +1,84 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE StrictData #-}
|
||||
|
||||
module Simplex.Messaging.Server.Names
|
||||
( NamesConfig (..),
|
||||
RpcAuth (..),
|
||||
NamesEnv (..),
|
||||
newNamesEnv,
|
||||
closeNamesEnv,
|
||||
pingEndpoint,
|
||||
resolveName,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Control.Exception as E
|
||||
import Control.Logger.Simple (logError)
|
||||
import Data.Bifunctor (first)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import qualified Data.Text as T
|
||||
import Simplex.Messaging.Protocol (NameErrorType (..), NameRecord)
|
||||
import Simplex.Messaging.Server.Names.HttpResolver
|
||||
( ResolverEnv,
|
||||
ResolverError (..),
|
||||
RpcAuth (..),
|
||||
closeResolverEnv,
|
||||
healthHttp,
|
||||
newResolverEnv,
|
||||
resolveHttp,
|
||||
)
|
||||
import Simplex.Messaging.SimplexName (SimplexNameDomain, fullDomainName)
|
||||
import System.Timeout (timeout)
|
||||
|
||||
data NamesConfig = NamesConfig
|
||||
{ resolverEndpoint :: String,
|
||||
resolverAuth :: Maybe RpcAuth,
|
||||
resolverTimeoutMs :: Int,
|
||||
resolverMaxResponseBytes :: Int
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data NamesEnv = NamesEnv
|
||||
{ config :: NamesConfig,
|
||||
resolverEnv :: ResolverEnv
|
||||
}
|
||||
|
||||
newNamesEnv :: NamesConfig -> IO NamesEnv
|
||||
newNamesEnv config = do
|
||||
resolverEnv <- newResolverEnv (resolverEndpoint config) (resolverAuth config) (resolverTimeoutMs config) (resolverMaxResponseBytes config)
|
||||
pure NamesEnv {config, resolverEnv}
|
||||
|
||||
closeNamesEnv :: NamesEnv -> IO ()
|
||||
closeNamesEnv NamesEnv {resolverEnv} = closeResolverEnv resolverEnv
|
||||
|
||||
pingEndpoint :: NamesEnv -> IO (Either ResolverError ())
|
||||
pingEndpoint NamesEnv {resolverEnv, config} =
|
||||
fromMaybe (Left ResolverTimeout) <$> timeout (resolverTimeoutMs config * 1000) (healthHttp resolverEnv)
|
||||
|
||||
resolveName :: NamesEnv -> SimplexNameDomain -> IO (Either NameErrorType NameRecord)
|
||||
resolveName env d = do
|
||||
r <- E.try (timeout (resolverTimeoutMs (config env) * 1000) (fetch env d))
|
||||
case r of
|
||||
Right result -> pure (fromMaybe (Left (RESOLVER "timeout")) result)
|
||||
Left e
|
||||
| Just (_ :: E.SomeAsyncException) <- E.fromException e -> E.throwIO e
|
||||
| otherwise -> do
|
||||
logError $ "[NAMES] resolver fetch raised " <> T.pack (E.displayException e)
|
||||
pure (Left (RESOLVER "resolver error"))
|
||||
|
||||
fetch :: NamesEnv -> SimplexNameDomain -> IO (Either NameErrorType NameRecord)
|
||||
fetch NamesEnv {resolverEnv} d =
|
||||
first mapResolverError <$> resolveHttp resolverEnv (fullDomainName d)
|
||||
|
||||
mapResolverError :: ResolverError -> NameErrorType
|
||||
mapResolverError = \case
|
||||
HttpStatusErr 404 -> NOT_FOUND
|
||||
HttpStatusErr 400 -> NOT_FOUND
|
||||
HttpStatusErr code -> RESOLVER ("HTTP " <> T.pack (show code))
|
||||
HttpFailure _ -> RESOLVER "transport failure"
|
||||
BodyTooLarge -> RESOLVER "response too large"
|
||||
InvalidJson _ -> RESOLVER "invalid response"
|
||||
ResolverTimeout -> RESOLVER "timeout"
|
||||
@@ -0,0 +1,144 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE StrictData #-}
|
||||
|
||||
-- | HTTP transport for the public-namespace resolver.
|
||||
--
|
||||
-- The Python REST resolver (see scripts/resolver/snrc-resolve.py) exposes
|
||||
--
|
||||
-- GET /resolve/<name> -> 200 with a NameRecord JSON document
|
||||
-- 404 / 400 for unknown names / TLDs
|
||||
-- 502 for upstream RPC failures
|
||||
-- GET /health -> 200 when the resolver process is ready
|
||||
--
|
||||
-- Boundary properties:
|
||||
-- * Response body read with `brReadSome maxResponseBytes` — adversarial
|
||||
-- endpoints cannot exhaust memory with multi-GB bodies.
|
||||
-- * `redirectCount = 0` — a compromised resolver cannot bounce credentials
|
||||
-- to a private-IP target (SSRF amplification on top of the URL validation
|
||||
-- performed at config load in Server.Main.validateUrl).
|
||||
-- * Authorization header attached only when configured.
|
||||
module Simplex.Messaging.Server.Names.HttpResolver
|
||||
( RpcAuth (..),
|
||||
ResolverEnv,
|
||||
ResolverError (..),
|
||||
newResolverEnv,
|
||||
closeResolverEnv,
|
||||
resolveHttp,
|
||||
healthHttp,
|
||||
)
|
||||
where
|
||||
|
||||
import qualified Control.Exception as E
|
||||
import qualified Data.Aeson as J
|
||||
import Data.Bifunctor (first)
|
||||
import qualified Data.ByteArray.Encoding as BAE
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Network.HTTP.Client
|
||||
( HttpException,
|
||||
Manager,
|
||||
ManagerSettings (..),
|
||||
brReadSome,
|
||||
parseRequest,
|
||||
redirectCount,
|
||||
requestHeaders,
|
||||
responseBody,
|
||||
responseStatus,
|
||||
responseTimeoutMicro,
|
||||
withResponse,
|
||||
)
|
||||
import qualified Network.HTTP.Client as HC
|
||||
import Network.HTTP.Client.TLS (tlsManagerSettings)
|
||||
import qualified Network.HTTP.Types as HT
|
||||
import Network.HTTP.Types.URI (urlEncode)
|
||||
import Simplex.Messaging.Names.Record (NameRecord)
|
||||
|
||||
data RpcAuth = AuthBearer Text | AuthBasic Text Text
|
||||
|
||||
-- | Redacts the bearer token / basic-auth password so an accidental
|
||||
-- `show` / `tshow` on NamesConfig never lands secrets in logs.
|
||||
instance Show RpcAuth where
|
||||
show (AuthBearer _) = "AuthBearer <redacted>"
|
||||
show (AuthBasic u _) = "AuthBasic " <> show u <> " <redacted>"
|
||||
|
||||
data ResolverEnv = ResolverEnv
|
||||
{ manager :: Manager,
|
||||
baseUrl :: String,
|
||||
authHdr :: [HT.Header],
|
||||
timeoutMicro :: Int,
|
||||
maxResponseBytes :: Int
|
||||
}
|
||||
|
||||
data ResolverError
|
||||
= HttpFailure HttpException
|
||||
| HttpStatusErr Int
|
||||
| BodyTooLarge
|
||||
| InvalidJson String
|
||||
| ResolverTimeout
|
||||
deriving (Show)
|
||||
|
||||
newResolverEnv :: String -> Maybe RpcAuth -> Int -> Int -> IO ResolverEnv
|
||||
newResolverEnv baseUrl auth_ timeoutMs maxResponseBytes = do
|
||||
manager <- HC.newManager tlsManagerSettings {managerConnCount = 10}
|
||||
pure
|
||||
ResolverEnv
|
||||
{ manager,
|
||||
baseUrl,
|
||||
authHdr = maybe [] (pure . authHeader) auth_,
|
||||
timeoutMicro = timeoutMs * 1000,
|
||||
maxResponseBytes
|
||||
}
|
||||
|
||||
-- | http-client's `closeManager` is a deprecated no-op since 0.5; the
|
||||
-- manager is released by the GC finalizer on its internal state. Hook kept
|
||||
-- as a future-cleanup seam.
|
||||
closeResolverEnv :: ResolverEnv -> IO ()
|
||||
closeResolverEnv _ = pure ()
|
||||
|
||||
authHeader :: RpcAuth -> HT.Header
|
||||
authHeader = \case
|
||||
AuthBearer tok -> ("Authorization", "Bearer " <> encodeUtf8 tok)
|
||||
AuthBasic u p ->
|
||||
let encoded = BAE.convertToBase BAE.Base64 (encodeUtf8 u <> ":" <> encodeUtf8 p) :: ByteString
|
||||
in ("Authorization", "Basic " <> encoded)
|
||||
|
||||
-- | GET <baseUrl>/resolve/<percent-encoded name>, decoding the 200 body
|
||||
-- directly into a NameRecord in one pass (no intermediate Aeson Value). The
|
||||
-- name is percent-encoded (every non-unreserved byte per RFC 3986): the
|
||||
-- resolver expects raw labels, so slashes/punctuation must not alter the path.
|
||||
resolveHttp :: ResolverEnv -> Text -> IO (Either ResolverError NameRecord)
|
||||
resolveHttp env name =
|
||||
(>>= first InvalidJson . J.eitherDecodeStrict . BL.toStrict)
|
||||
<$> httpGet env ("/resolve/" <> B.unpack (urlEncode True (encodeUtf8 name)))
|
||||
|
||||
-- | GET <baseUrl>/health; success = reachable with status < 400. The body is
|
||||
-- size-capped but NOT decoded — the probe only checks reachability.
|
||||
healthHttp :: ResolverEnv -> IO (Either ResolverError ())
|
||||
healthHttp env = (() <$) <$> httpGet env "/health"
|
||||
|
||||
-- | GET <baseUrl><path>, returning the response body bytes on status < 400
|
||||
-- within the size cap. Redirects are disabled and Authorization is attached
|
||||
-- only when configured.
|
||||
httpGet :: ResolverEnv -> String -> IO (Either ResolverError BL.ByteString)
|
||||
httpGet ResolverEnv {manager, baseUrl, authHdr, timeoutMicro, maxResponseBytes} path = do
|
||||
req0 <- parseRequest (baseUrl <> path)
|
||||
let req =
|
||||
req0
|
||||
{ redirectCount = 0,
|
||||
requestHeaders = ("Accept", "application/json") : authHdr,
|
||||
HC.responseTimeout = responseTimeoutMicro timeoutMicro
|
||||
}
|
||||
result <- E.try $ withResponse req manager $ \res -> do
|
||||
let status = HT.statusCode (responseStatus res)
|
||||
if status >= 400
|
||||
then pure (Left (HttpStatusErr status))
|
||||
else do
|
||||
bs <- brReadSome (responseBody res) (maxResponseBytes + 1)
|
||||
pure $ if BL.length bs > fromIntegral maxResponseBytes then Left BodyTooLarge else Right bs
|
||||
pure (either (Left . HttpFailure) id result)
|
||||
@@ -59,7 +59,7 @@ data RTSubscriberMetrics = RTSubscriberMetrics
|
||||
{-# FOURMOLU_DISABLE\n#-}
|
||||
prometheusMetrics :: ServerMetrics -> RealTimeMetrics -> UTCTime -> Text
|
||||
prometheusMetrics sm rtm ts =
|
||||
time <> queues <> subscriptions <> messages <> ntfMessages <> ntfs <> relays <> services <> info
|
||||
time <> queues <> subscriptions <> messages <> ntfMessages <> ntfs <> relays <> services <> names <> info
|
||||
where
|
||||
ServerMetrics {statsData, activeQueueCounts = ps, activeNtfCounts = psNtf, entityCounts, rtsOptions} = sm
|
||||
RealTimeMetrics
|
||||
@@ -128,7 +128,8 @@ prometheusMetrics sm rtm ts =
|
||||
_rcvServicesSubDuplicate,
|
||||
_qCount,
|
||||
_msgCount,
|
||||
_ntfCount
|
||||
_ntfCount,
|
||||
_rslvStats
|
||||
} = statsData
|
||||
time =
|
||||
"# Recorded at: " <> T.pack (iso8601Show ts) <> "\n\
|
||||
@@ -459,6 +460,31 @@ prometheusMetrics sm rtm ts =
|
||||
\# TYPE simplex_smp_" <> pfx <> "_services_sub_fewer_total gauge\n\
|
||||
\simplex_smp_" <> pfx <> "_services_sub_fewer_total " <> mshow (_srvSubFewerTotal ss) <> "\n# " <> pfx <> ".srvSubFewerTotal\n\
|
||||
\\n"
|
||||
names =
|
||||
let NameResolverStatsData {_rslvReqs, _rslvSucc, _rslvNotFound, _rslvResolverErrs, _rslvDisabled} = _rslvStats
|
||||
in "# Names\n\
|
||||
\# -----\n\
|
||||
\\n\
|
||||
\# HELP simplex_smp_names_reqs Total RSLV requests forwarded to this server.\n\
|
||||
\# TYPE simplex_smp_names_reqs counter\n\
|
||||
\simplex_smp_names_reqs " <> mshow _rslvReqs <> "\n# rslvReqs\n\
|
||||
\\n\
|
||||
\# HELP simplex_smp_names_success NameRecord successfully resolved and returned.\n\
|
||||
\# TYPE simplex_smp_names_success counter\n\
|
||||
\simplex_smp_names_success " <> mshow _rslvSucc <> "\n# rslvSucc\n\
|
||||
\\n\
|
||||
\# HELP simplex_smp_names_not_found Name not registered (resolver returned 404 / 400).\n\
|
||||
\# TYPE simplex_smp_names_not_found counter\n\
|
||||
\simplex_smp_names_not_found " <> mshow _rslvNotFound <> "\n# rslvNotFound\n\
|
||||
\\n\
|
||||
\# HELP simplex_smp_names_resolver_errs Resolver backend errors (HTTP 5xx, transport, decode, or timeout).\n\
|
||||
\# TYPE simplex_smp_names_resolver_errs counter\n\
|
||||
\simplex_smp_names_resolver_errs " <> mshow _rslvResolverErrs <> "\n# rslvResolverErrs\n\
|
||||
\\n\
|
||||
\# HELP simplex_smp_names_disabled RSLV requests rejected because no resolver is configured (names role off).\n\
|
||||
\# TYPE simplex_smp_names_disabled counter\n\
|
||||
\simplex_smp_names_disabled " <> mshow _rslvDisabled <> "\n# rslvDisabled\n\
|
||||
\\n"
|
||||
info =
|
||||
"# Info\n\
|
||||
\# ----\n\
|
||||
|
||||
@@ -39,6 +39,13 @@ module Simplex.Messaging.Server.Stats
|
||||
setServiceStats,
|
||||
emptyTimeBuckets,
|
||||
updateTimeBuckets,
|
||||
NameResolverStats (..),
|
||||
NameResolverStatsData (..),
|
||||
newNameResolverStats,
|
||||
newNameResolverStatsData,
|
||||
getNameResolverStatsData,
|
||||
getResetNameResolverStatsData,
|
||||
setNameResolverStats,
|
||||
) where
|
||||
|
||||
import Control.Applicative (optional, (<|>))
|
||||
@@ -123,7 +130,8 @@ data ServerStats = ServerStats
|
||||
rcvServicesSubDuplicate :: IORef Int,
|
||||
qCount :: IORef Int,
|
||||
msgCount :: IORef Int,
|
||||
ntfCount :: IORef Int
|
||||
ntfCount :: IORef Int,
|
||||
rslvStats :: NameResolverStats
|
||||
}
|
||||
|
||||
data ServerStatsData = ServerStatsData
|
||||
@@ -184,7 +192,8 @@ data ServerStatsData = ServerStatsData
|
||||
_rcvServicesSubDuplicate :: Int,
|
||||
_qCount :: Int,
|
||||
_msgCount :: Int,
|
||||
_ntfCount :: Int
|
||||
_ntfCount :: Int,
|
||||
_rslvStats :: NameResolverStatsData
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
@@ -248,6 +257,7 @@ newServerStats ts = do
|
||||
qCount <- newIORef 0
|
||||
msgCount <- newIORef 0
|
||||
ntfCount <- newIORef 0
|
||||
rslvStats <- newNameResolverStats
|
||||
pure
|
||||
ServerStats
|
||||
{ fromTime,
|
||||
@@ -307,7 +317,8 @@ newServerStats ts = do
|
||||
rcvServicesSubDuplicate,
|
||||
qCount,
|
||||
msgCount,
|
||||
ntfCount
|
||||
ntfCount,
|
||||
rslvStats
|
||||
}
|
||||
|
||||
getServerStatsData :: ServerStats -> IO ServerStatsData
|
||||
@@ -370,6 +381,7 @@ getServerStatsData s = do
|
||||
_qCount <- readIORef $ qCount s
|
||||
_msgCount <- readIORef $ msgCount s
|
||||
_ntfCount <- readIORef $ ntfCount s
|
||||
_rslvStats <- getNameResolverStatsData $ rslvStats s
|
||||
pure
|
||||
ServerStatsData
|
||||
{ _fromTime,
|
||||
@@ -429,7 +441,8 @@ getServerStatsData s = do
|
||||
_rcvServicesSubDuplicate,
|
||||
_qCount,
|
||||
_msgCount,
|
||||
_ntfCount
|
||||
_ntfCount,
|
||||
_rslvStats
|
||||
}
|
||||
|
||||
-- this function is not thread safe, it is used on server start only
|
||||
@@ -493,6 +506,7 @@ setServerStats s d = do
|
||||
writeIORef (qCount s) $! _qCount d
|
||||
writeIORef (msgCount s) $! _msgCount d
|
||||
writeIORef (ntfCount s) $! _ntfCount d
|
||||
setNameResolverStats (rslvStats s) $! _rslvStats d
|
||||
|
||||
instance StrEncoding ServerStatsData where
|
||||
strEncode d =
|
||||
@@ -557,7 +571,9 @@ instance StrEncoding ServerStatsData where
|
||||
"rcvServices:",
|
||||
strEncode (_rcvServices d),
|
||||
"ntfServices:",
|
||||
strEncode (_ntfServices d)
|
||||
strEncode (_ntfServices d),
|
||||
"rslvStats:",
|
||||
strEncode (_rslvStats d)
|
||||
]
|
||||
strP = do
|
||||
_fromTime <- "fromTime=" *> strP <* A.endOfLine
|
||||
@@ -628,6 +644,10 @@ instance StrEncoding ServerStatsData where
|
||||
_pMsgFwdsRecv <- opt "pMsgFwdsRecv="
|
||||
_rcvServices <- serviceStatsP "rcvServices:"
|
||||
_ntfServices <- serviceStatsP "ntfServices:"
|
||||
_rslvStats <-
|
||||
optional ("rslvStats:" <* A.endOfLine) >>= \case
|
||||
Just _ -> strP <* optional A.endOfLine
|
||||
_ -> pure newNameResolverStatsData
|
||||
pure
|
||||
ServerStatsData
|
||||
{ _fromTime,
|
||||
@@ -687,7 +707,8 @@ instance StrEncoding ServerStatsData where
|
||||
_rcvServicesSubDuplicate = 0,
|
||||
_qCount,
|
||||
_msgCount = 0,
|
||||
_ntfCount = 0
|
||||
_ntfCount = 0,
|
||||
_rslvStats
|
||||
}
|
||||
where
|
||||
opt s = A.string s *> strP <* A.endOfLine <|> pure 0
|
||||
@@ -862,6 +883,89 @@ instance StrEncoding ProxyStatsData where
|
||||
_pErrorsOther <- "errorsOther=" *> strP
|
||||
pure ProxyStatsData {_pRequests, _pSuccesses, _pErrorsConnect, _pErrorsCompat, _pErrorsOther}
|
||||
|
||||
data NameResolverStats = NameResolverStats
|
||||
{ rslvReqs :: IORef Int,
|
||||
rslvSucc :: IORef Int,
|
||||
rslvNotFound :: IORef Int,
|
||||
rslvResolverErrs :: IORef Int,
|
||||
rslvDisabled :: IORef Int
|
||||
}
|
||||
|
||||
newNameResolverStats :: IO NameResolverStats
|
||||
newNameResolverStats = do
|
||||
rslvReqs <- newIORef 0
|
||||
rslvSucc <- newIORef 0
|
||||
rslvNotFound <- newIORef 0
|
||||
rslvResolverErrs <- newIORef 0
|
||||
rslvDisabled <- newIORef 0
|
||||
pure NameResolverStats {rslvReqs, rslvSucc, rslvNotFound, rslvResolverErrs, rslvDisabled}
|
||||
|
||||
data NameResolverStatsData = NameResolverStatsData
|
||||
{ _rslvReqs :: Int,
|
||||
_rslvSucc :: Int,
|
||||
_rslvNotFound :: Int,
|
||||
_rslvResolverErrs :: Int,
|
||||
_rslvDisabled :: Int
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
newNameResolverStatsData :: NameResolverStatsData
|
||||
newNameResolverStatsData =
|
||||
NameResolverStatsData
|
||||
{ _rslvReqs = 0,
|
||||
_rslvSucc = 0,
|
||||
_rslvNotFound = 0,
|
||||
_rslvResolverErrs = 0,
|
||||
_rslvDisabled = 0
|
||||
}
|
||||
|
||||
getNameResolverStatsData :: NameResolverStats -> IO NameResolverStatsData
|
||||
getNameResolverStatsData s = do
|
||||
_rslvReqs <- readIORef $ rslvReqs s
|
||||
_rslvSucc <- readIORef $ rslvSucc s
|
||||
_rslvNotFound <- readIORef $ rslvNotFound s
|
||||
_rslvResolverErrs <- readIORef $ rslvResolverErrs s
|
||||
_rslvDisabled <- readIORef $ rslvDisabled s
|
||||
pure NameResolverStatsData {_rslvReqs, _rslvSucc, _rslvNotFound, _rslvResolverErrs, _rslvDisabled}
|
||||
|
||||
getResetNameResolverStatsData :: NameResolverStats -> IO NameResolverStatsData
|
||||
getResetNameResolverStatsData s = do
|
||||
_rslvReqs <- atomicSwapIORef (rslvReqs s) 0
|
||||
_rslvSucc <- atomicSwapIORef (rslvSucc s) 0
|
||||
_rslvNotFound <- atomicSwapIORef (rslvNotFound s) 0
|
||||
_rslvResolverErrs <- atomicSwapIORef (rslvResolverErrs s) 0
|
||||
_rslvDisabled <- atomicSwapIORef (rslvDisabled s) 0
|
||||
pure NameResolverStatsData {_rslvReqs, _rslvSucc, _rslvNotFound, _rslvResolverErrs, _rslvDisabled}
|
||||
|
||||
-- not thread safe; used on server start only
|
||||
setNameResolverStats :: NameResolverStats -> NameResolverStatsData -> IO ()
|
||||
setNameResolverStats s d = do
|
||||
writeIORef (rslvReqs s) $! _rslvReqs d
|
||||
writeIORef (rslvSucc s) $! _rslvSucc d
|
||||
writeIORef (rslvNotFound s) $! _rslvNotFound d
|
||||
writeIORef (rslvResolverErrs s) $! _rslvResolverErrs d
|
||||
writeIORef (rslvDisabled s) $! _rslvDisabled d
|
||||
|
||||
instance StrEncoding NameResolverStatsData where
|
||||
strEncode NameResolverStatsData {_rslvReqs, _rslvSucc, _rslvNotFound, _rslvResolverErrs, _rslvDisabled} =
|
||||
"reqs="
|
||||
<> strEncode _rslvReqs
|
||||
<> "\nsucc="
|
||||
<> strEncode _rslvSucc
|
||||
<> "\nnotFound="
|
||||
<> strEncode _rslvNotFound
|
||||
<> "\nresolverErrs="
|
||||
<> strEncode _rslvResolverErrs
|
||||
<> "\ndisabled="
|
||||
<> strEncode _rslvDisabled
|
||||
strP = do
|
||||
_rslvReqs <- "reqs=" *> strP <* A.endOfLine
|
||||
_rslvSucc <- "succ=" *> strP <* A.endOfLine
|
||||
_rslvNotFound <- "notFound=" *> strP <* A.endOfLine
|
||||
_rslvResolverErrs <- "resolverErrs=" *> strP <* A.endOfLine
|
||||
_rslvDisabled <- "disabled=" *> strP
|
||||
pure NameResolverStatsData {_rslvReqs, _rslvSucc, _rslvNotFound, _rslvResolverErrs, _rslvDisabled}
|
||||
|
||||
data ServiceStats = ServiceStats
|
||||
{ srvAssocNew :: IORef Int,
|
||||
srvAssocDuplicate :: IORef Int,
|
||||
|
||||
Reference in New Issue
Block a user