From 236e69dda597307a275da18a15b7f61bf6c685f8 Mon Sep 17 00:00:00 2001 From: sh Date: Fri, 22 May 2026 07:59:43 +0000 Subject: [PATCH 01/31] smp-server: support namespaces --- plans/20260522_01_smp_public_namespaces.md | 427 +++++++++++++++++++++ 1 file changed, 427 insertions(+) create mode 100644 plans/20260522_01_smp_public_namespaces.md diff --git a/plans/20260522_01_smp_public_namespaces.md b/plans/20260522_01_smp_public_namespaces.md new file mode 100644 index 000000000..f925eccb6 --- /dev/null +++ b/plans/20260522_01_smp_public_namespaces.md @@ -0,0 +1,427 @@ +# Server: SMP support for public namespaces + +Implementation plan for Part 2 of [RFC 2026-05-21-public-namespaces](https://github.com/simplex-chat/simplex-chat/blob/ep/namespace/docs/rfcs/2026-05-21-public-namespaces.md). Adds a forwarded-only `RSLV ` SMP command that returns `NAME ` read from the SNRC contract via a Reth+Nimbus JSON-RPC endpoint. Smp-server becomes name-capable by `[NAMES] enable: on`. + +Out of scope: `Simplex.Messaging.Client` API, agent-side resolution flow, `ServerRoles.names` in the agent, default-router list, reverse resolution, multicoin/text records, state proofs. + +## Architecture + +```mermaid +sequenceDiagram + participant C as Client + participant P as Proxy (storage role) + participant N as Name server (names role) + participant E as Ethereum endpoint
(Reth+Nimbus) + + C ->> P: PFWD(enc(RSLV key)) + P ->> N: RFWD(enc(RSLV key)) + note over N: verifyTransmission True →
vc SResolver (RSLV _) → VRVerified + N ->> N: cache lookup + alt cache miss + N ->> E: eth_call(SNRC, namehash(key)) + E -->> N: ABI bytes + note over N: ABI decode + zero-owner check + cache insert + end + N -->> P: RFWD(enc(NAME rec | ERR AUTH)) + P -->> C: PRES(enc(NAME rec | ERR AUTH)) +``` + +RSLV is **forwarded-only** — direct RSLV is rejected `CMD PROHIBITED`. This preserves the RFC's two-server resolution: the name server sees the lookup key but never the client's IP, session, or identity. + +## Protocol + +Shared library: `src/Simplex/Messaging/Protocol.hs` and `src/Simplex/Messaging/Transport.hs`. + +**Version.** `Transport.hs:226`: `namesSMPVersion = VersionSMP 20`. Bump `currentClientSMPRelayVersion`, `currentServerSMPRelayVersion`, `proxiedSMPRelayVersion` to 20. Pre-v20 binaries lack the `RSLV_` tag; v20 binaries with sessions negotiated at v < 20 reject `RSLV_` at the parameter parser. The proxied-version bump 18 → 20 is safe (v19's `RecipientService`/`NotifierService` aren't in the forwarded whitelist; v18's `BLOCKED info` is already version-branched at `Protocol.hs:1943`). + +**Party kind.** Append `Resolver` to `Party` (line 335); add `SResolver` (line 349), `TestEquality` clause (line 361), `PartyI Resolver` (line 394). `queueParty SResolver = Nothing` (falls through line 412). `partyClientRole SResolver = Nothing`. + +**`RSLV` command.** + +```haskell +RSLV :: LookupKey -> Command Resolver +newtype LookupKey = LookupKey ByteString + +instance Encoding LookupKey where + smpEncode (LookupKey s) = smpEncode s + smpP = do + n <- lenP + when (n > 64) $ fail "LookupKey too large" + LookupKey <$> A.take n +``` + +Name-syntax validation is client-side per RFC; the server treats the key as opaque bytes. Tag `"RSLV"`, version guard inside `protocolP v (CT SResolver RSLV_)`: `| v >= namesSMPVersion -> Cmd SResolver . RSLV <$> _smpP`. + +**Testnet/mainnet selector**: how the `#testnet:name` namespace appears in `LookupKey` bytes is determined by the SNRC contract (Part 1) — confirm with Part 1 before merging. + +**`NAME` response.** + +```haskell +NAME :: NameRecord -> BrokerMsg +``` + +Tag `"NAME"`. Symmetric version guards on encode (in `encodeProtocol v`) and decode (in `protocolP v NAME_`): `| v >= namesSMPVersion -> ...`. `NameRecord` has **no `Encoding` typeclass instance** — the typeclass cannot version-branch. Use top-level helpers `nameRecBytes :: VersionSMP -> NameRecord -> ByteString` and `parseNameRec :: VersionSMP -> Parser NameRecord`, mirroring the `IDS QIK` precedent at `Protocol.hs:1912–1979`. + +**`NameRecord` schema and wire layout.** + +```haskell +data NameRecord = NameRecord + { nrVersion :: NameRecVersion -- 1 in MVP + , nrDisplayName :: Text -- ≤255 bytes UTF-8 + , nrOwner :: NameOwner -- 20 raw bytes + , nrChannelLinks :: [NameLink] + , nrContactLinks :: [NameLink] + , nrAdminAddress :: Maybe Text + , nrAdminEmail :: Maybe Text + , nrExpiry :: Int64 -- Unix seconds, ≥ 0 + , nrIsTest :: Bool + } + +newtype NameRecVersion = NameRecVersion Word8 +newtype NameOwner = NameOwner ByteString -- bare ctor NOT exported, smart ctor enforces length 20 +newtype NameLink = NameLink Text -- bare ctor NOT exported, smart ctor enforces ≤1024 bytes +``` + +| Field | Encoding | Max bytes | +|---|---|---| +| `nrVersion` | single byte | 1 | +| `nrDisplayName` | 1-byte length prefix + UTF-8 | 1 + 255 | +| `nrOwner` | 20 raw bytes, no prefix | 20 | +| `nrChannelLinks`, `nrContactLinks` | 1-byte count + per-element (Word16 BE len + UTF-8); combined cap **8 entries** across both lists | 1 + Σ(2 + ≤1024) | +| `nrAdminAddress`, `nrAdminEmail` | `'0'` or `'1'` + (1-byte length + UTF-8 if `'1'`) | 1 + 1 + 255 | +| `nrExpiry` | two big-endian `Word32` | 8 | +| `nrIsTest` | `'T'` or `'F'` | 1 | + +`Encoding NameLink` reads the Word16 length **before** `A.take` allocates — going through the existing `Large` wrapper allows up to 65 535 bytes per element. There is no `Encoding [a]` instance — use `smpEncodeList` / `smpListP` / a bounded variant: + +```haskell +smpListPUpTo :: Encoding a => Int -> Parser [a] +smpListPUpTo cap = do + n <- lenP + when (n > cap) $ fail "list too long" + A.count n smpP + +parseNameRec _v = do + nrVersion <- smpP + nrDisplayName <- smpP + nrOwner <- smpP + nrChannelLinks <- smpListPUpTo 8 + nrContactLinks <- smpListPUpTo (8 - length nrChannelLinks) + nrAdminAddress <- smpP + nrAdminEmail <- smpP + nrExpiry <- smpP + when (nrExpiry < 0) $ fail "expiry must be non-negative" + nrIsTest <- smpP + pure NameRecord{..} +``` + +Both list parsers fail at the count step before allocating; the second inherits the residual budget. Canonical encoding by construction: every primitive has exactly one valid byte form — two name servers reading the same SNRC state produce byte-identical responses. + +**Wire-size budget.** `paddedProxiedTLength = 16226` is the plaintext input to `cbEncrypt` (`Server.hs:2117`); `pad` reserves 2 bytes → framed transmission ≤ 16 224 bytes. Combined-link cap 8 yields max payload ≈ 9 050 bytes — generous margin. + +**Error semantics.** A single wire code: `ERR AUTH`. Per RFC, this collapses every failure (name not found, malformed key, names disabled, RPC unreachable, decode error, timeout). Resolver internally distinguishes the cause for stats only. + +**Forwarded-only access.** Direct RSLV is rejected with `CMD PROHIBITED`. The shape of `THAuthServer` alone cannot discriminate direct from forwarded (`Transport.hs:852` sets `sessSecret' = Just _` for every v6+ direct client too). An explicit `forwarded :: Bool` flag is threaded through `verifyTransmission` (see below). + +## Server changes + +All edits in `src/Simplex/Messaging/Server.hs`. + +**`forwarded :: Bool` plumbing.** Three signatures change: + +- `verifyTransmission :: Bool -> ...` (line 1233) — direct path passes `False` (lines 1152–1153), forwarded path passes `True` (line 2129). +- `verifyLoadedQueue :: Bool -> ...` (line 1238) — receives the flag from `verifyTransmission` (lines 1235, 1240). +- `verifyQueueTransmission :: Bool -> ...` (line 1244) — receives and uses the flag. + +New `vc` clauses inside `verifyQueueTransmission`: + +```haskell +vc SResolver (RSLV _) | forwarded = VRVerified Nothing + | otherwise = VRFailed (CMD PROHIBITED) +vc SResolver _ = VRFailed (CMD PROHIBITED) -- defensive catch-all +``` + +**Forwarded whitelist** (`Server.hs:2132`): + +```haskell +Cmd SResolver (RSLV _) -> True +``` + +**`processCommand` branch** (alongside line 1481): + +```haskell +Cmd SResolver (RSLV (LookupKey key)) -> do + st <- asks (rslvStats . serverStats) + incStat (rslvReqs st) + asks namesEnv >>= \case + Nothing -> incStat (rslvDisabled st) $> response (corrId, NoEntity, ERR AUTH) + Just nenv -> liftIO (resolveName nenv key) >>= \case + Right rec -> incStat (rslvSucc st) $> response (corrId, NoEntity, NAME rec) + Left NotFound -> incStat (rslvNotFound st) $> response (corrId, NoEntity, ERR AUTH) + Left _ -> incStat (rslvEthErrs st) $> response (corrId, NoEntity, ERR AUTH) +``` + +**Shutdown.** Add `closeNamesEnv :: NamesEnv -> IO ()` calling `closeManager`. Wire into `closeServer` (`Server.hs:247`): + +```haskell +closeServer = do + asks (smpAgent . proxyAgent) >>= liftIO . closeSMPClientAgent + asks namesEnv >>= liftIO . mapM_ closeNamesEnv +``` + +In-flight `resolveName` calls during shutdown receive `ConnectionClosed` → `EthHttpErr` → masked-leader cleanup runs → waiters unblock with `ERR AUTH`. + +**`incStat` relocation.** Defined at `Server.hs:2220`, currently unexported. Move to `Server/Stats.hs` (one-line transplant + export) so `Resolver.hs` can use it. + +**Co-located proxy refused.** `newEnv` aborts startup if both `allowSMPProxy = True` and `namesConfig = Just _`, unless `allow_dangerous_colocation = on`. RSLV is the first slow forwarded command; on a proxy host it can serialise other forwarded commands on the same proxy-relay session up to `rpcTimeoutMs` per cache miss. `forkForwardedCmd` async dispatch is the longer-term fix, tracked as a follow-up. + +## Resolver subtree + +New module tree at `src/Simplex/Messaging/Server/Names/`: + +| Module | Contents | +|---|---| +| `Names.hs` | Façade — re-exports `NamesConfig`, `NamesEnv`, `ResolveError`, `resolveName`, `newNamesEnv`, `closeNamesEnv`. | +| `Names/Resolver.hs` | All types + cache + in-flight + `resolveName`. Helpers exported directly (no `.Internal` per codebase convention). **Test seam**: `NamesEnv` holds `ethCall` as a function value, so tests construct stubs via `newNamesEnvWith`. | +| `Names/Eth/RPC.hs` | `EthRpcEnv`; `ethCallReal` via `http-client` + `withResponse` + `brReadSome rpcMaxResponseBytes`. JSON-RPC error / HTTP error split. `rpcMaxConcurrency` semaphore. `Authorization` header from `rpcAuth`. | +| `Names/Eth/SNRC.hs` | `EthAddress`, Keccak-256 namehash via `crypton`'s `Crypto.Hash.Algorithms.Keccak_256` (mirroring `Crypto.hs:1023–1025` for SHA3), hand-rolled bounded Solidity ABI codec, `getRecord` with zero-owner detection. **Ethereum's Keccak ≠ NIST SHA3-256.** | + +**ABI codec invariants**, enforced before any allocation: `offset + 32 ≤ buf.length`; `offset + 32 + length ≤ buf.length`; `offset ≥ headEnd` (no backward jumps); every length ≤ per-field cap; `string[]` outer length × 32 ≤ buf.length; recursion depth ≤ 2; `uint256 → Int64` rejects if any high 24 bytes non-zero; UTF-8 via `decodeUtf8'` returns `EthDecodeErr`. + +**Zero-owner → `NotFound`**: ENS-style resolvers return zeroed records for non-existent names. After ABI decode, if `nrOwner == NameOwner (B.replicate 20 0)` return `Left NotFound`. + +**Errors.** + +```haskell +data ResolveError = NotFound | EthHttpErr | EthRpcErr { rpcCode :: Int, rpcMessage :: Text } + | EthDecodeErr | TimedOut +``` + +All collapse to `ERR AUTH`. `EthRpcErr` carries JSON-RPC `error` object — method-not-found (SNRC not deployed at `snrc_address`) is logged immediately on the first error after a recent success: `logError "NAMES: JSON-RPC error from endpoint — check snrc_address: "`. No automatic retry. + +**Cache.** TTL + FIFO eviction. `TVar (OrdPSQ LookupKey Word64 NameRecord, Int)` — priority = monotonic-ns at insert; the `Int` is running byte count. `cacheLookup` is one STM transaction (read, expiry-check, expired-delete-with-byte-decrement). `cacheInsert` is one STM transaction: while `size > cacheMaxEntries` OR `bytes + sizeOf(rec) > cacheMaxBytes`, `minView` to drop oldest, then `insert`. Byte counter prevents `100 000 × 9 KB ≈ 900 MB` worst-case blow-up. + +**Request coalescing** (async-exception safe via `E.mask`): + +```haskell +resolveName env bs = do + let k = LookupKey bs + now <- getMonotonicTimeNSec + atomically (cacheLookup env k now) >>= \case + Just rec -> incStat (rslvCacheHits ...) $> Right rec + Nothing -> do + incStat (rslvCacheMiss ...) + ticket <- atomically $ TM.lookup k (inflight env) >>= \case + Just mv -> pure (Waiter mv) + Nothing -> newEmptyTMVar >>= \mv -> TM.insert k mv (inflight env) $> Leader mv + case ticket of + Waiter mv -> atomically (readTMVar mv) + Leader mv -> E.mask $ \restore -> do + r <- restore (fetchOnceTimed env bs) + `E.catch` \(e :: E.SomeException) -> pure (Left (mapEthErr e)) + atomically $ putTMVar mv r >> TM.delete k (inflight env) + case r of Right rec -> atomically (cacheInsert env k now rec); Left _ -> pure () + pure r + +fetchOnceTimed env bs = + System.Timeout.timeout (rpcTimeoutMs (config env) * 1000) (fetchOnce env bs) >>= \case + Just r -> pure r + Nothing -> pure (Left TimedOut) +``` + +`E.mask` ensures `putTMVar + TM.delete` runs even on async exception; `fetchOnceTimed` runs under `restore` so it remains interruptible. Waiters always see a value; the in-flight TMap entry is always removed. + +`fetchOnce`, `mapEthErr`, `scrubUrl`, `cacheLookup`, `cacheInsert` are internal to `Resolver.hs`. `getMonotonicTimeNSec` from `GHC.Clock` — first monotonic-clock use in the codebase; clock-jump safe. + +**STM contention.** Cache hits are read-only `readTVar` — STM scales. Cache writes under sustained miss traffic can retry; `CacheSpec` asserts < 5% retry at 4 readers + 1 writer @ 1k RPS. If observed higher, swap `TVar` for `IORef` + `atomicModifyIORef'`. + +**Multicoin and text records** are not in `NameRecord`. If Part 1 contract returns them from `getRecord`, extend `NameRecord` and the wire-size budget. **Confirm with Part 1 author before implementing `Eth/SNRC.hs`.** + +## Configuration + +`ServerConfig` (`Env/STM.hs:142`) gains one field `namesConfig :: Maybe NamesConfig`. `Env` (`Env/STM.hs:261`) gains `namesEnv :: Maybe NamesEnv`. `newEnv` constructs it after `proxyAgent` (line 605) with the co-location guard. + +```haskell +data NamesConfig = NamesConfig + { ethereumEndpoint :: Text -- http(s), no userinfo, explicit port required + , snrcAddress :: NameOwner -- 20 bytes + , rpcAuth :: Maybe RpcAuth -- required when https & non-loopback host + , cacheSeconds :: Int -- 300 + , cacheMaxEntries :: Int -- 100000 + , cacheMaxBytes :: Int -- 67108864 (64 MB) + , rpcTimeoutMs :: Int -- 3000 + , rpcMaxResponseBytes :: Int -- 262144 (256 KB) + , rpcMaxConcurrency :: Int -- 8 + , dangerousColocation :: Bool -- override the §"Server changes" startup guard + } + +data RpcAuth = AuthBearer Text | AuthBasic Text Text +``` + +INI parsing in `Server/Main.hs`: + +- `validateUrl` (using new `network-uri` dep): accepts only http(s), non-empty host, **explicit port** (rejects `http://localhost` defaulting to 80 while Reth is on 8545), no userinfo, no query/fragment. Rejects `https://...` without `rpc_auth` when host is non-loopback. On rejection: `logError` + `exitFailure`. +- `parseEthAddr`: accepts `0x[0-9a-fA-F]{40}` and the same without `0x`. Mixed-case → verify EIP-55 checksum and reject mismatch (catches typos). +- `parseRpcAuth`: reads optional `rpc_auth` key; format `bearer ` or `basic :`. +- `scrubUrl`: strips userinfo from all log lines mentioning the endpoint, including inside `mapEthErr`. +- Transition-aware error logging: log immediately on first error after a recent success, then at most hourly while persisting + summary at every stats reset. + +Default INI template (`Server/Main/Init.hs`, after `[PROXY]`): + +``` +[NAMES] +# Public-namespace resolution (SNRC on Ethereum). +# Requires an Ethereum JSON-RPC endpoint (Reth+Nimbus). See deployment guide. +# Cannot be combined with [PROXY] enable: on by default — see allow_dangerous_colocation. +# Restart required to change settings. +enable: off +# Same-host: +# ethereum_endpoint: http://127.0.0.1:8545 +# Central Reth via Caddy: +# ethereum_endpoint: https://eth.simplex.chat:443 +# rpc_auth: basic : +# snrc_address: 0x0000000000000000000000000000000000000000 +# cache_seconds: 300 +# cache_max_entries: 100000 +# cache_max_bytes: 67108864 +# rpc_timeout_ms: 3000 +# rpc_max_response_bytes: 262144 +# rpc_max_concurrency: 8 +# allow_dangerous_colocation: off +``` + +Upgrade from a pre-v6.6 INI: missing `[NAMES]` section → disabled. No operator action required. + +## Operator deployment + +Two supported topologies. smp-server is agnostic — only `ethereum_endpoint` changes. + +**Topology A (same-host)**: smp-server, Caddy (optional), Reth, Nimbus all on one box. `ethereum_endpoint: http://127.0.0.1:8545`. + +**Topology B (central Reth, N smp-server hosts — recommended for fleets)**: one operator runs one eth host with Reth+Nimbus behind Caddy on public HTTPS. Each smp-server has its own credential. + +```mermaid +flowchart LR + subgraph eth-host + Caddy["Caddy
(public :443, basic auth)"] + Reth["Reth
(127.0.0.1:8545)"] + Nimbus["Nimbus"] + Caddy --> Reth + Nimbus -- Engine API (jwt.hex) --> Reth + end + subgraph smp-host-1 + S1["smp-server #1"] + end + subgraph smp-host-N + SN["smp-server #N"] + end + S1 -- HTTPS + Authorization --> Caddy + SN -- HTTPS + Authorization --> Caddy + Reth <-- Ethereum p2p --> internet + Nimbus <-- beacon sync --> internet +``` + +Sharing one Reth across **multiple operators** is **not** supported — collapses the RFC's two-server resolution privacy. + +**Reth + Nimbus**: Reth (execution layer) holds Ethereum state on ~260 GB pruned NVMe; Nimbus (consensus light client) follows beacon-chain headers. Paired via Engine API on `127.0.0.1:8551` with a shared `jwt.hex`. Recommended Reth flags: + +```bash +reth node \ + --http.addr 127.0.0.1 \ + --http.api eth \ # only eth namespace + --rpc.gascap 50000000 \ # cap gas per eth_call + --rpc.max-response-size 5242880 \ # 5 MB + --http.corsdomain none \ + --authrpc.jwtsecret /opt/eth/jwt.hex \ + --authrpc.addr 127.0.0.1 --authrpc.port 8551 +``` + +**Caddy + Let's Encrypt + Basic auth** (Topology B): + +```caddy +eth.simplex.chat { + basicauth { + smp-server-1 $2a$14$ + smp-server-2 $2a$14$ + } + log { format filter { wrap json; fields { request>headers>Authorization delete } } } + reverse_proxy 127.0.0.1:8545 +} +``` + +Caddy auto-fetches Let's Encrypt cert. Each smp-server has its own credential; revoking one = delete the line. `Authorization` stripped from access logs. Port 80 needed for the ACME HTTP-01 challenge (use TLS-ALPN-01 or DNS-01 to drop it). The threat being defended against is DoS (SNRC state is public); mTLS would be overkill. WireGuard/Tailscale are alternative network-layer approaches — both compatible with the plan. + +**Capacity.** One Reth+Nimbus box handles a realistic operator fleet by 10–1000× margin. Per-smp-server peak RSLV ≈ 1700 RPS (pessimistic); cache hit rate ≥ 95% → ~85 RPS cache miss per smp-server; 10 smp-servers → ~850 RPS aggregate cache miss reaching Reth; Reth `eth_call` throughput on warm NVMe ≈ 1k–10k RPS. Sizing: 8 vCPU, 32 GB RAM, 1 TB NVMe is comfortable. Scale-out path: more Reth+Nimbus pairs, smp-servers round-robin or shard. + +## Implementation + +**Order**: + +1. Protocol: party/SParty/PartyI, RSLV+tag, NAME+tag, NameRecord + helpers, version constants in `Transport.hs`. +2. `verifyTransmission`/`verifyLoadedQueue`/`verifyQueueTransmission` `forwarded :: Bool` flag + `vc SResolver` clauses. +3. Forwarded whitelist + `processCommand` branch + `incStat` move to `Stats.hs`. +4. Env plumbing: `Server/Env/STM.hs`, `Server/Main.hs` INI parse, `Server/Main/Init.hs` template. +5. Resolver subtree: `Eth/SNRC.hs` → `Eth/RPC.hs` → `Resolver.hs`. +6. `NameResolverStats` sub-record + CSV log + Prometheus `names =` block. +7. Replace stub in (3) with real `resolveName`. +8. Tests. +9. `protocol/simplex-messaging.md`: header version line 1 (`19 → 20`), sentence at line 86, version-history list (lines 93–105) v20 entry, TOC (lines 25–68) "Resolver commands" subsection, new section with ABNF + byte layout + error semantics, "Router security requirements" paragraph about names-role outbound HTTP, cross-ref `Transport.hs:226`. +10. `CHANGELOG.md`: v6.6 entry. + +**Cabal** (`simplexmq.cabal`): bump `version: 6.6.0.0`. Add to `if !flag(client_library)` block: `http-client >=0.7 && <0.8`, `http-client-tls >=0.3 && <0.4`, `network-uri >=2.6 && <2.7`, `psqueues >=0.2.7 && <0.3`. Expose 4 new `Server.Names.*` modules in the same block. `crypton` already provides `Keccak_256`. + +**Files changed**: + +| File | Change | +|---|---| +| `Protocol.hs` | Resolver party + RSLV/NAME tags + version guards; `NameRecord` + newtypes + smart ctors; `nameRecBytes`/`parseNameRec`/`smpListPUpTo` helpers (no Encoding NameRecord instance); `LookupKey` parser-side cap | +| `Transport.hs` | `namesSMPVersion = 20`; bump current/proxied SMP versions | +| `Server.hs` | Thread `forwarded :: Bool`; `vc SResolver` clauses; whitelist (2132); Resolver branch in `processCommand` (1481); `closeServer` calls `closeNamesEnv`; CSV log (579–618); **remove** local `incStat` | +| `Server/Env/STM.hs` | `namesConfig` field; `namesEnv` field; `newEnv` constructs `NamesEnv` with co-location guard | +| `Server/Main.hs` | `[NAMES]` parse: `validateUrl`/`parseEthAddr`/`parseRpcAuth`; `scrubUrl` in logs | +| `Server/Main/Init.hs` | `[NAMES]` block in default INI | +| `Server/Stats.hs` | `incStat` moved here + exported; `NameResolverStats` sub-record + helpers; `rslvStats` field | +| `Server/Prometheus.hs` | `names =` metric block | +| `Server/Names.hs` (new) | Façade re-exports | +| `Server/Names/Resolver.hs` (new) | All resolver types + cache + coalescing + `fetchOnceTimed` + `newNamesEnv[With]` + `closeNamesEnv` | +| `Server/Names/Eth/RPC.hs` (new) | `EthRpcEnv`, `ethCallReal` with bounded body + concurrency semaphore + `Authorization` header | +| `Server/Names/Eth/SNRC.hs` (new) | `EthAddress`, Keccak namehash, bounded ABI (8 invariants), `getRecord` with zero-owner detection | +| `simplexmq.cabal` | Bump `6.6.0.0`; 4 new deps + 4 new modules in `if !flag(client_library)` block | +| `protocol/simplex-messaging.md` | Header version, version-history v20 entry, new "Resolver commands" section | +| `CHANGELOG.md` | v6.6 entry | + +## Testing + +`tests/SMPNamesTests/` registered in `tests/Test.hs:112–151`. Build only when `client_library = False`. + +1. **ProtocolEncodingSpec** — `nameRecBytes` ↔ `parseNameRec` round-trip; oversized fields rejected at parse; combined-list cap 8 enforced; negative `nrExpiry` rejected; canonical encoding byte-stable. +2. **MaxSizeSpec** — max `NameRecord` encodes ≤ ~9 KB; `encodeTransmission v ≤ paddedProxiedTLength - 2`; `cbEncrypt` succeeds. +3. **CommandTagSpec** — `"RSLV"`/`"NAME"` parse; v < 20 sessions reject `RSLV_` at parameter parser. +4. **ForwardedGateSpec** — direct RSLV → `CMD PROHIBITED`; forwarded RSLV reaches handler. +5. **ForwardedRslvSpec** — RSLV wrapped in PFWD reaches the handler end-to-end. **Test infra cost**: first protocol-level PFWD test; budget for `runProxiedSmpCommand` helper performing `PRXY`/`PKEY`/`PFWD` manually. +6. **CacheSpec** — hit avoids RPC; TTL expiry forces re-fetch; bytes cap evicts before entries cap on large records; concurrent same-key callers issue one RPC; leader exception → all waiters get `Left _`, TMap entry removed; leader async-cancel → cleanup STM still runs. +7. **AbiSpec** — encode/decode against pinned fixtures (`tests/fixtures/snrc/`); QuickCheck fuzz on random buffers ≤ `rpcMaxResponseBytes` must never crash. +8. **NamehashSpec** — Keccak-256 reference vectors; assert Keccak ≠ SHA3-256. +9. **MockRpcSpec** — fake HTTP server; missing → `EthHttpErr`; slow → `TimedOut`; multi-GB body truncated → `EthDecodeErr`. `rpcAuth = AuthBasic` sends correct header. +10. **Uint256OverflowSpec** — `expiry > Int64.maxBound` → `EthDecodeErr`. +11. **ZeroOwnerSpec** — `owner = 0x000...000` → `NotFound`. +12. **StartupGuardSpec** — `allowSMPProxy + names.enable` aborts; `allow_dangerous_colocation = on` starts with warning. +13. **UrlValidationSpec** — userinfo/scheme/host/port edge cases; rejects `https://` without `rpc_auth` for non-loopback. +14. **EipChecksumSpec** — `parseEthAddr` accepts lower/upper; verifies mixed-case checksum; rejects typos. +15. **AbiBoundsSpec** — each of 8 ABI invariants triggers `EthDecodeErr` without crash/allocation blow-up. + +Integration against real Reth+Nimbus mainnet deferred to ops. + +## Threat model, scope, coordination + +| Actor | Can | Cannot | +|---|---|---| +| Name server | See lookup-key bytes; see query timing; see Eth endpoint URL (operator-self) | See client IP/session; correlate clients across queries | +| Compromised Eth endpoint | Poison this server's cache for one TTL window; see every lookup key the server queries | Bypass two-server agreement (client-side, out of scope) | +| Adversarial client (high-rate unique keys) | Cache-thrash DoS; fill `Manager` connection pool up to `managerConnCount = 8` | Bypass `rpcMaxResponseBytes` or `fetchOnceTimed` | +| Adversarial proxy (slow inner RSLVs) | Block other forwarded commands on that proxy connection up to `rpcTimeoutMs` per miss | Affect other proxy connections | +| Operator with footgun config (https no auth, public Eth RPC) | (rejected at startup, or operator-acknowledged data leak) | — | + +Mitigations: caching + coalescing + `rpcTimeoutMs` + `rpcMaxResponseBytes` + `rpcMaxConcurrency`; co-location refused at startup; URL validation; Caddy + auth in front of Reth; Reth's own gas/size caps. Timing side-channels (cache-hit vs miss latency) not mitigated — flagged for post-MVP. State proofs deferred to post-MVP per RFC. + +**Cross-repo coordination.** The `simplex-chat` `ep/namespace` branch currently contains only the RFC commit — no agent-side wire-format code yet. This plan's wire format is validated only by simplexmq's own tests until a matching agent PR lands (structurally weak — encoder/decoder bugs are mutually consistent with themselves). Coordinate with the agent-side implementer **before merging** on: exact `NameRecord` field order and types; `LookupKey` namespace-prefix convention; error-code semantics; Part 1 SNRC contract `getRecord` ABI surface. From 1c508f61ce41a116f0c74bfc520d956d8d7c86b0 Mon Sep 17 00:00:00 2001 From: sh Date: Fri, 22 May 2026 12:45:57 +0000 Subject: [PATCH 02/31] smp-server: drop NameRecVersion, add unNameOwner/unNameLink Field additions in NameRecord will be gated by SMP version bumps, matching the IDS QIK precedent at Protocol.hs:1912-1979. The separate nrVersion field created a redundant version axis. Add unNameOwner and unNameLink so downstream consumers can read back the underlying bytes/text without the bare constructors. --- plans/20260522_01_smp_public_namespaces.md | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/plans/20260522_01_smp_public_namespaces.md b/plans/20260522_01_smp_public_namespaces.md index f925eccb6..a19763562 100644 --- a/plans/20260522_01_smp_public_namespaces.md +++ b/plans/20260522_01_smp_public_namespaces.md @@ -66,8 +66,7 @@ Tag `"NAME"`. Symmetric version guards on encode (in `encodeProtocol v`) and dec ```haskell data NameRecord = NameRecord - { nrVersion :: NameRecVersion -- 1 in MVP - , nrDisplayName :: Text -- ≤255 bytes UTF-8 + { nrDisplayName :: Text -- ≤255 bytes UTF-8 , nrOwner :: NameOwner -- 20 raw bytes , nrChannelLinks :: [NameLink] , nrContactLinks :: [NameLink] @@ -77,14 +76,20 @@ data NameRecord = NameRecord , nrIsTest :: Bool } -newtype NameRecVersion = NameRecVersion Word8 -newtype NameOwner = NameOwner ByteString -- bare ctor NOT exported, smart ctor enforces length 20 -newtype NameLink = NameLink Text -- bare ctor NOT exported, smart ctor enforces ≤1024 bytes +newtype NameOwner = NameOwner ByteString -- bare ctor NOT exported; smart ctor enforces length 20 +newtype NameLink = NameLink Text -- bare ctor NOT exported; smart ctor enforces ≤1024 bytes + +unNameOwner :: NameOwner -> ByteString +unNameOwner (NameOwner bs) = bs + +unNameLink :: NameLink -> Text +unNameLink (NameLink t) = t ``` +Field additions are gated by future SMP version bumps (matching the `IDS QIK` precedent at `Protocol.hs:1912–1979`) — no separate record-version field. + | Field | Encoding | Max bytes | |---|---|---| -| `nrVersion` | single byte | 1 | | `nrDisplayName` | 1-byte length prefix + UTF-8 | 1 + 255 | | `nrOwner` | 20 raw bytes, no prefix | 20 | | `nrChannelLinks`, `nrContactLinks` | 1-byte count + per-element (Word16 BE len + UTF-8); combined cap **8 entries** across both lists | 1 + Σ(2 + ≤1024) | @@ -102,7 +107,6 @@ smpListPUpTo cap = do A.count n smpP parseNameRec _v = do - nrVersion <- smpP nrDisplayName <- smpP nrOwner <- smpP nrChannelLinks <- smpListPUpTo 8 From ee81703ad8906c8ca2c65cb164614aec1e924c38 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 09:01:59 +0000 Subject: [PATCH 03/31] smp-server: Resolver party, RSLV/NAME protocol types Add Resolver party, RSLV command, NAME response, NameRecord (with NameOwner/NameLink newtypes + smart ctors), LookupKey, and version constant namesSMPVersion = 20 in Transport.hs. Bump current/proxied SMP versions 19/18 -> 20. Includes minimal stub clauses in vc/processCommand so the build passes; proper forwarded gate and handler land in steps 2-3. --- src/Simplex/Messaging/Encoding.hs | 1 + src/Simplex/Messaging/Protocol.hs | 148 ++++++++++++++++++++++++++++- src/Simplex/Messaging/Server.hs | 2 + src/Simplex/Messaging/Transport.hs | 10 +- 4 files changed, 157 insertions(+), 4 deletions(-) diff --git a/src/Simplex/Messaging/Encoding.hs b/src/Simplex/Messaging/Encoding.hs index d069e5518..b5b51ab90 100644 --- a/src/Simplex/Messaging/Encoding.hs +++ b/src/Simplex/Messaging/Encoding.hs @@ -15,6 +15,7 @@ module Simplex.Messaging.Encoding smpEncodeList, smpListP, lenEncode, + lenP, ) where diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index fa58d8843..e1f8f54d1 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -163,6 +163,18 @@ module Simplex.Messaging.Protocol EncTransmission (..), FwdResponse (..), FwdTransmission (..), + LookupKey (..), + unLookupKey, + NameRecord (..), + NameOwner, + mkNameOwner, + unNameOwner, + NameLink, + mkNameLink, + unNameLink, + nameRecBytes, + parseNameRec, + smpListPUpTo, MsgFlags (..), initialSMPClientVersion, currentSMPClientVersion, @@ -225,6 +237,7 @@ where import Control.Applicative (optional, (<|>)) import Control.Exception (Exception, SomeException, displayException, fromException) +import Control.Monad (when) import Control.Monad.Except import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as J @@ -250,7 +263,7 @@ import Data.Maybe (isJust, isNothing) import Data.String import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Encoding (decodeLatin1, encodeUtf8) +import Data.Text.Encoding (decodeLatin1, decodeUtf8', encodeUtf8) import Data.Time.Clock.System (SystemTime (..), systemToUTCTime) import Data.Type.Equality import Data.Word (Word8, Word16) @@ -343,6 +356,7 @@ data Party | LinkClient | ProxiedClient | ProxyService + | Resolver deriving (Show) -- | Singleton types for SMP protocol clients @@ -357,6 +371,7 @@ data SParty :: Party -> Type where SSenderLink :: SParty LinkClient SProxiedClient :: SParty ProxiedClient SProxyService :: SParty ProxyService + SResolver :: SParty Resolver instance TestEquality SParty where testEquality SCreator SCreator = Just Refl @@ -369,6 +384,7 @@ instance TestEquality SParty where testEquality SSenderLink SSenderLink = Just Refl testEquality SProxiedClient SProxiedClient = Just Refl testEquality SProxyService SProxyService = Just Refl + testEquality SResolver SResolver = Just Refl testEquality _ _ = Nothing deriving instance Show (SParty p) @@ -395,6 +411,8 @@ instance PartyI ProxiedClient where sParty = SProxiedClient instance PartyI ProxyService where sParty = SProxyService +instance PartyI Resolver where sParty = SResolver + -- command parties that can read queues type family QueueParty (p :: Party) :: Constraint where QueueParty Recipient = () @@ -473,6 +491,7 @@ partyClientRole = \case SSenderLink -> Just SRMessaging SProxiedClient -> Just SRMessaging SProxyService -> Just SRProxy + SResolver -> Nothing {-# INLINE partyClientRole #-} partyServiceRole :: ServiceParty p => SParty p -> SMPServiceRole @@ -550,6 +569,21 @@ type LinkId = QueueId -- | SMP queue ID on the server. type QueueId = EntityId +-- | Name lookup key — opaque bytes; namespace/casing per RFC enforced client-side. +newtype LookupKey = LookupKey ByteString + deriving (Eq, Show) + +unLookupKey :: LookupKey -> ByteString +unLookupKey (LookupKey s) = s +{-# INLINE unLookupKey #-} + +instance Encoding LookupKey where + smpEncode (LookupKey s) = smpEncode s + smpP = do + n <- lenP + when (n > 64) $ fail "LookupKey too long" + LookupKey <$> A.take n + -- | Parameterized type for SMP protocol commands from all clients. data Command (p :: Party) where -- SMP recipient commands @@ -597,6 +631,8 @@ data Command (p :: Party) where -- - entity ID: empty -- - corrId: unique correlation ID between proxy and relay, also used as a nonce to encrypt forwarded transmission RFWD :: EncFwdTransmission -> Command ProxyService -- use CorrId as CbNonce, proxy to relay + -- Name resolution: forwarded-only via PFWD. Server reads SNRC contract via Ethereum JSON-RPC. + RSLV :: LookupKey -> Command Resolver deriving instance Show (Command p) @@ -705,6 +741,96 @@ instance Encoding FwdTransmission where newtype EncFwdTransmission = EncFwdTransmission ByteString deriving (Show) +-- | 20-byte Ethereum address (NameRecord owner). Bare constructor not exported; +-- use `mkNameOwner` to enforce the 20-byte invariant. +newtype NameOwner = NameOwner ByteString + deriving (Eq, Show) + +mkNameOwner :: ByteString -> Either String NameOwner +mkNameOwner bs + | B.length bs == 20 = Right (NameOwner bs) + | otherwise = Left "NameOwner must be 20 bytes" + +unNameOwner :: NameOwner -> ByteString +unNameOwner (NameOwner bs) = bs +{-# INLINE unNameOwner #-} + +instance Encoding NameOwner where + smpEncode (NameOwner bs) = bs + {-# INLINE smpEncode #-} + smpP = NameOwner <$> A.take 20 + +-- | A name-record link (channel or contact). Bare constructor not exported; +-- use `mkNameLink` to enforce the ≤1024-byte UTF-8 invariant. +newtype NameLink = NameLink Text + deriving (Eq, Show) + +mkNameLink :: Text -> Either String NameLink +mkNameLink t + | B.length (encodeUtf8 t) <= 1024 = Right (NameLink t) + | otherwise = Left "NameLink too long" + +unNameLink :: NameLink -> Text +unNameLink (NameLink t) = t +{-# INLINE unNameLink #-} + +instance Encoding NameLink where + smpEncode (NameLink t) = + let bs = encodeUtf8 t + in smpEncode @Word16 (fromIntegral $ B.length bs) <> bs + smpP = do + n <- fromIntegral <$> smpP @Word16 + when (n > 1024) $ fail "NameLink too long" + bs <- A.take n + either (fail . show) (pure . NameLink) (decodeUtf8' bs) + +-- | Resolved name record returned by the names role. +-- Field additions are gated by future SMP version bumps (matching IDS QIK precedent). +data NameRecord = NameRecord + { nrDisplayName :: Text, -- ≤255 bytes UTF-8 (enforced by Encoding ByteString length prefix) + nrOwner :: NameOwner, + nrChannelLinks :: [NameLink], + nrContactLinks :: [NameLink], + nrAdminAddress :: Maybe Text, + nrAdminEmail :: Maybe Text, + nrExpiry :: Int64, -- Unix seconds, ≥ 0 + nrIsTest :: Bool + } + deriving (Eq, Show) + +-- | Bounded list parser — caps element count before allocating. +smpListPUpTo :: Encoding a => Int -> Parser [a] +smpListPUpTo cap = do + n <- lenP + when (n > cap) $ fail "list too long" + A.count n smpP + +-- | Encode NameRecord on the wire. Version-branched in the same shape as IDS QIK. +nameRecBytes :: VersionSMP -> NameRecord -> ByteString +nameRecBytes _v NameRecord {nrDisplayName, nrOwner, nrChannelLinks, nrContactLinks, nrAdminAddress, nrAdminEmail, nrExpiry, nrIsTest} = + smpEncode nrDisplayName + <> smpEncode nrOwner + <> smpEncodeList nrChannelLinks + <> smpEncodeList nrContactLinks + <> smpEncode nrAdminAddress + <> smpEncode nrAdminEmail + <> smpEncode nrExpiry + <> smpEncode nrIsTest + +-- | Parse NameRecord. Combined channel+contact list cap is 8. +parseNameRec :: VersionSMP -> Parser NameRecord +parseNameRec _v = do + nrDisplayName <- smpP + nrOwner <- smpP + nrChannelLinks <- smpListPUpTo 8 + nrContactLinks <- smpListPUpTo (8 - length nrChannelLinks) + nrAdminAddress <- smpP + nrAdminEmail <- smpP + nrExpiry <- smpP + when (nrExpiry < 0) $ fail "expiry must be non-negative" + nrIsTest <- smpP + pure NameRecord {nrDisplayName, nrOwner, nrChannelLinks, nrContactLinks, nrAdminAddress, nrAdminEmail, nrExpiry, nrIsTest} + data BrokerMsg where -- SMP broker messages (responses, client messages, notifications) IDS :: QueueIdsKeys -> BrokerMsg @@ -732,6 +858,8 @@ data BrokerMsg where OK :: BrokerMsg ERR :: ErrorType -> BrokerMsg PONG :: BrokerMsg + -- Name resolution response. Returned only for forwarded RSLV. + NAME :: NameRecord -> BrokerMsg deriving (Eq, Show) data RcvMessage = RcvMessage @@ -942,6 +1070,7 @@ data CommandTag (p :: Party) where RFWD_ :: CommandTag ProxyService NSUB_ :: CommandTag Notifier NSUBS_ :: CommandTag NotifierService + RSLV_ :: CommandTag Resolver data CmdTag = forall p. PartyI p => CT (SParty p) (CommandTag p) @@ -968,6 +1097,7 @@ data BrokerMsgTag | OK_ | ERR_ | PONG_ + | NAME_ deriving (Show) class ProtocolMsgTag t where @@ -1004,6 +1134,7 @@ instance PartyI p => Encoding (CommandTag p) where RFWD_ -> "RFWD" NSUB_ -> "NSUB" NSUBS_ -> "NSUBS" + RSLV_ -> "RSLV" smpP = messageTagP instance ProtocolMsgTag CmdTag where @@ -1032,6 +1163,7 @@ instance ProtocolMsgTag CmdTag where "RFWD" -> Just $ CT SProxyService RFWD_ "NSUB" -> Just $ CT SNotifier NSUB_ "NSUBS" -> Just $ CT SNotifierService NSUBS_ + "RSLV" -> Just $ CT SResolver RSLV_ _ -> Nothing instance Encoding CmdTag where @@ -1061,6 +1193,7 @@ instance Encoding BrokerMsgTag where OK_ -> "OK" ERR_ -> "ERR" PONG_ -> "PONG" + NAME_ -> "NAME" smpP = messageTagP instance ProtocolMsgTag BrokerMsgTag where @@ -1083,6 +1216,7 @@ instance ProtocolMsgTag BrokerMsgTag where "OK" -> Just OK_ "ERR" -> Just ERR_ "PONG" -> Just PONG_ + "NAME" -> Just NAME_ _ -> Nothing -- | SMP message body format @@ -1792,6 +1926,7 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where PRXY host auth_ -> e (PRXY_, ' ', host, auth_) PFWD fwdV pubKey (EncTransmission s) -> e (PFWD_, ' ', fwdV, pubKey, Tail s) RFWD (EncFwdTransmission s) -> e (RFWD_, ' ', Tail s) + RSLV key -> e (RSLV_, ' ', key) where e :: Encoding a => a -> ByteString e = smpEncode @@ -1816,6 +1951,7 @@ instance PartyI p => ProtocolEncoding SMPVersion ErrorType (Command p) where PRXY {} -> noAuthCmd PFWD {} -> entityCmd RFWD _ -> noAuthCmd + RSLV _ -> noAuthCmd SUB -> serviceCmd NSUB -> serviceCmd -- other client commands must have both signature and queue ID @@ -1899,6 +2035,9 @@ instance ProtocolEncoding SMPVersion ErrorType Cmd where CT SNotifierService NSUBS_ | v >= rcvServiceSMPVersion -> Cmd SNotifierService <$> (NSUBS <$> _smpP <*> smpP) | otherwise -> pure $ Cmd SNotifierService $ NSUBS (-1) mempty + CT SResolver RSLV_ + | v >= namesSMPVersion -> Cmd SResolver . RSLV <$> _smpP + | otherwise -> fail "RSLV requires namesSMPVersion" fromProtocolError = fromProtocolError @SMPVersion @ErrorType @BrokerMsg {-# INLINE fromProtocolError #-} @@ -1945,6 +2084,9 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where | v < clientNoticesSMPVersion -> BLOCKED info {notice = Nothing} _ -> err PONG -> e PONG_ + NAME rec + | v >= namesSMPVersion -> e (NAME_, ' ') <> nameRecBytes v rec + | otherwise -> e (ERR_, ' ', AUTH) -- pre-v20: shouldn't reach here, degrade to AUTH where e :: Encoding a => a -> ByteString e = smpEncode @@ -1992,6 +2134,9 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where OK_ -> pure OK ERR_ -> ERR <$> _smpP PONG_ -> pure PONG + NAME_ + | v >= namesSMPVersion -> NAME <$> (A.space *> parseNameRec v) + | otherwise -> fail "NAME requires namesSMPVersion" where serviceRespP resp | v >= rcvServiceSMPVersion = resp <$> _smpP <*> smpP @@ -2014,6 +2159,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where PKEY {} -> noEntityMsg RRES _ -> noEntityMsg ALLS -> noEntityMsg + NAME _ -> noEntityMsg -- other broker responses must have queue ID _ | B.null entId -> Left $ CMD NO_ENTITY diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 1b7d920ac..22e9a69a1 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -1262,6 +1262,7 @@ verifyQueueTransmission service thAuth (tAuth, authorized, (corrId, entId, comma vc SNotifierService NSUBS {} = verifyServiceCmd vc SProxiedClient _ = VRVerified Nothing vc SProxyService (RFWD _) = VRVerified Nothing + vc SResolver _ = VRFailed $ CMD PROHIBITED -- replaced by forwarded gate in step 2 checkRole = case (service, partyClientRole p) of (Just THClientService {serviceRole}, Just role) -> serviceRole == role _ -> True @@ -1486,6 +1487,7 @@ client 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 SResolver (RSLV _) -> pure $ response (corrId, NoEntity, ERR AUTH) -- replaced in step 3 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 diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index f1eb1a8bd..c2600b0f8 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/src/Simplex/Messaging/Transport.hs @@ -57,6 +57,7 @@ module Simplex.Messaging.Transport newNtfCredsSMPVersion, clientNoticesSMPVersion, rcvServiceSMPVersion, + namesSMPVersion, simplexMQVersion, smpBlockSize, TransportConfig (..), @@ -223,6 +224,9 @@ clientNoticesSMPVersion = VersionSMP 18 rcvServiceSMPVersion :: VersionSMP rcvServiceSMPVersion = VersionSMP 19 +namesSMPVersion :: VersionSMP +namesSMPVersion = VersionSMP 20 + minClientSMPRelayVersion :: VersionSMP minClientSMPRelayVersion = VersionSMP 6 @@ -230,13 +234,13 @@ minServerSMPRelayVersion :: VersionSMP minServerSMPRelayVersion = VersionSMP 6 currentClientSMPRelayVersion :: VersionSMP -currentClientSMPRelayVersion = VersionSMP 19 +currentClientSMPRelayVersion = VersionSMP 20 legacyServerSMPRelayVersion :: VersionSMP legacyServerSMPRelayVersion = VersionSMP 6 currentServerSMPRelayVersion :: VersionSMP -currentServerSMPRelayVersion = VersionSMP 19 +currentServerSMPRelayVersion = VersionSMP 20 -- Max SMP protocol version to be used in e2e encrypted -- connection between client and server, as defined by SMP proxy. @@ -244,7 +248,7 @@ currentServerSMPRelayVersion = VersionSMP 19 -- to prevent client version fingerprinting by the -- destination relays when clients upgrade at different times. proxiedSMPRelayVersion :: VersionSMP -proxiedSMPRelayVersion = VersionSMP 18 +proxiedSMPRelayVersion = VersionSMP 20 -- minimal supported protocol version is 6 -- TODO remove code that supports sending commands without batching From 2d14d4c2dd675093c081dd22d10599e467501aae Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 09:03:18 +0000 Subject: [PATCH 04/31] smp-server: thread forwarded flag through verify functions Add Bool forwarded arg to verifyTransmission/verifyLoadedQueue/ verifyQueueTransmission so vc SResolver (RSLV _) can distinguish direct (reject CMD PROHIBITED) from forwarded (verify, defer auth to handler). Direct path passes False; forwarded path (rejectOrVerify) passes True. --- src/Simplex/Messaging/Server.hs | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 22e9a69a1..bc6c3d582 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -1149,8 +1149,8 @@ receive h@THandle {params = THandleParams {thAuth, sessionId}} ms Client {rcvQ, updateBatchStats stats cmd -- even if nothing is verified let queueId (_, _, (_, qId, _)) = qId qs <- getQueueRecs ms p $ map queueId ts' - zipWithM (\t -> verified stats t . verifyLoadedQueue service thAuth t) ts' qs - _ -> mapM (\t -> verified stats t =<< verifyTransmission ms service thAuth t) ts' + zipWithM (\t -> verified stats t . verifyLoadedQueue False service thAuth t) ts' qs + _ -> mapM (\t -> verified stats t =<< verifyTransmission False ms service thAuth t) ts' mapM_ (atomically . writeTBQueue rcvQ) $ L.nonEmpty cmds pure $ errs ++ errs' [] -> pure errs @@ -1230,19 +1230,19 @@ data VerificationResult s = VRVerified (Maybe (StoreQueue s, QueueRec)) | VRFail -- - the queue or party key do not exist. -- In all cases, the time of the verification should depend only on the provided authorization type, -- a dummy key is used to run verification in the last two cases, and failure is returned irrespective of the result. -verifyTransmission :: forall s. MsgStoreClass s => s -> Maybe THPeerClientService -> Maybe (THandleAuth 'TServer) -> SignedTransmission Cmd -> IO (VerificationResult s) -verifyTransmission ms service thAuth t@(_, _, (_, queueId, Cmd p _)) = case queueParty p of - Just Dict -> verifyLoadedQueue service thAuth t <$> getQueueRec ms p queueId - Nothing -> pure $ verifyQueueTransmission service thAuth t Nothing - -verifyLoadedQueue :: Maybe THPeerClientService -> Maybe (THandleAuth 'TServer) -> SignedTransmission Cmd -> Either ErrorType (StoreQueue s, QueueRec) -> VerificationResult s -verifyLoadedQueue service thAuth t@(tAuth, authorized, (corrId, _, _)) = \case - Right q -> verifyQueueTransmission service thAuth t (Just q) +verifyTransmission :: forall s. MsgStoreClass s => Bool -> s -> Maybe THPeerClientService -> Maybe (THandleAuth 'TServer) -> SignedTransmission Cmd -> IO (VerificationResult s) +verifyTransmission forwarded ms service thAuth t@(_, _, (_, queueId, Cmd p _)) = case queueParty p of + Just Dict -> verifyLoadedQueue forwarded service thAuth t <$> getQueueRec ms p queueId + Nothing -> pure $ verifyQueueTransmission forwarded service thAuth t Nothing + +verifyLoadedQueue :: Bool -> Maybe THPeerClientService -> Maybe (THandleAuth 'TServer) -> SignedTransmission Cmd -> Either ErrorType (StoreQueue s, QueueRec) -> VerificationResult s +verifyLoadedQueue forwarded service thAuth t@(tAuth, authorized, (corrId, _, _)) = \case + Right q -> verifyQueueTransmission forwarded service thAuth t (Just q) Left AUTH -> dummyVerifyCmd thAuth tAuth authorized corrId `seq` VRFailed AUTH Left e -> VRFailed e -verifyQueueTransmission :: forall s. Maybe THPeerClientService -> Maybe (THandleAuth 'TServer) -> SignedTransmission Cmd -> Maybe (StoreQueue s, QueueRec) -> VerificationResult s -verifyQueueTransmission service thAuth (tAuth, authorized, (corrId, entId, command@(Cmd p cmd))) q_ +verifyQueueTransmission :: forall s. Bool -> Maybe THPeerClientService -> Maybe (THandleAuth 'TServer) -> SignedTransmission Cmd -> Maybe (StoreQueue s, QueueRec) -> VerificationResult s +verifyQueueTransmission forwarded service thAuth (tAuth, authorized, (corrId, entId, command@(Cmd p cmd))) q_ | not checkRole = VRFailed $ CMD PROHIBITED | not verifyServiceSig = VRFailed SERVICE | otherwise = vc p cmd @@ -1262,7 +1262,9 @@ verifyQueueTransmission service thAuth (tAuth, authorized, (corrId, entId, comma vc SNotifierService NSUBS {} = verifyServiceCmd vc SProxiedClient _ = VRVerified Nothing vc SProxyService (RFWD _) = VRVerified Nothing - vc SResolver _ = VRFailed $ CMD PROHIBITED -- replaced by forwarded gate in step 2 + vc SResolver (RSLV _) + | forwarded = VRVerified Nothing + | otherwise = VRFailed $ CMD PROHIBITED checkRole = case (service, partyClientRole p) of (Just THClientService {serviceRole}, Just role) -> serviceRole == role _ -> True @@ -2128,7 +2130,7 @@ client rejectOrVerify clntThAuth = \case Left (corrId', entId', e) -> pure $ Left (corrId', entId', ERR e) Right t'@(_, _, t''@(corrId', entId', cmd')) - | allowed -> liftIO $ verified <$> verifyTransmission ms Nothing clntThAuth t' + | allowed -> liftIO $ verified <$> verifyTransmission True ms Nothing clntThAuth t' | otherwise -> pure $ Left (corrId', entId', ERR $ CMD PROHIBITED) where allowed = case cmd' of From 4d38cc34352c6b4467271c3404e8b32d3a6745a8 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 09:04:57 +0000 Subject: [PATCH 05/31] smp-server: forwarded whitelist RSLV + move incStat to Stats MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add Cmd SResolver (RSLV _) to the forwarded-command whitelist in rejectOrVerify so RSLV can be processed inside PFWD. Relocate incStat from Server.hs to Server/Stats.hs and export it so the upcoming Resolver module can use it. processCommand still returns ERR AUTH for RSLV — real handler lands once Env, Stats, and Resolver subtree are in place (steps 4-7). --- src/Simplex/Messaging/Server.hs | 5 +---- src/Simplex/Messaging/Server/Stats.hs | 6 ++++++ 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index bc6c3d582..e2f2932c3 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -2138,6 +2138,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'') @@ -2221,10 +2222,6 @@ updateDeletedStats q = do incStat $ qDeletedAll stats liftIO $ atomicModifyIORef'_ (qCount stats) (subtract 1) -incStat :: MonadIO m => IORef Int -> m () -incStat r = liftIO $ atomicModifyIORef'_ r (+ 1) -{-# INLINE incStat #-} - randomId' :: Int -> M s ByteString randomId' n = atomically . C.randomBytes n =<< asks random diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs index e8291759e..944ff53f6 100644 --- a/src/Simplex/Messaging/Server/Stats.hs +++ b/src/Simplex/Messaging/Server/Stats.hs @@ -39,9 +39,11 @@ module Simplex.Messaging.Server.Stats setServiceStats, emptyTimeBuckets, updateTimeBuckets, + incStat, ) where import Control.Applicative (optional, (<|>)) +import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Data.Attoparsec.ByteString.Char8 as A import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B @@ -786,6 +788,10 @@ updatePeriodStats ps (EntityId pId) = do ph = hash pId updatePeriod ref = unlessM (IS.member ph <$> readIORef ref) $ atomicModifyIORef'_ ref $ IS.insert ph +incStat :: MonadIO m => IORef Int -> m () +incStat r = liftIO $ atomicModifyIORef'_ r (+ 1) +{-# INLINE incStat #-} + data ProxyStats = ProxyStats { pRequests :: IORef Int, pSuccesses :: IORef Int, -- includes destination server error responses that will be forwarded to the client From 1a7979f577983804671eb8aea7c6ec997df59a71 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 09:13:36 +0000 Subject: [PATCH 06/31] smp-server: NamesConfig env plumbing + INI parse + default template Add Server/Names.hs skeleton (NamesConfig, RpcAuth, NamesEnv, ResolveError, newNamesEnv, closeNamesEnv, stub resolveName). Real implementation lands in step 5. Add namesConfig field to ServerConfig and namesEnv field to Env. newEnv constructs NamesEnv when [NAMES] enable: on, and refuses startup when combined with allowSMPProxy unless allow_dangerous_colocation is set. closeServer now closes the NamesEnv on shutdown. Add [NAMES] section parser (readNamesConfig) with parseEthAddr (0x-prefixed 40 hex, EIP-55 check deferred to step 5) and parseRpcAuth (bearer / basic). Default INI template carries the [NAMES] block (enable: off) with documented keys. --- simplexmq.cabal | 1 + src/Simplex/Messaging/Server.hs | 5 +- src/Simplex/Messaging/Server/Env/STM.hs | 18 +++++- src/Simplex/Messaging/Server/Main.hs | 62 +++++++++++++++++++ src/Simplex/Messaging/Server/Main/Init.hs | 19 ++++++ src/Simplex/Messaging/Server/Names.hs | 73 +++++++++++++++++++++++ tests/SMPClient.hs | 1 + 7 files changed, 175 insertions(+), 4 deletions(-) create mode 100644 src/Simplex/Messaging/Server/Names.hs diff --git a/simplexmq.cabal b/simplexmq.cabal index 070f68030..97b945d51 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -261,6 +261,7 @@ library Simplex.Messaging.Server.MsgStore.Journal.SharedLock Simplex.Messaging.Server.MsgStore.STM Simplex.Messaging.Server.MsgStore.Types + Simplex.Messaging.Server.Names Simplex.Messaging.Server.NtfStore Simplex.Messaging.Server.Prometheus Simplex.Messaging.Server.QueueStore diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index e2f2932c3..a0b1250f7 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -108,6 +108,7 @@ 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 (closeNamesEnv) import Simplex.Messaging.Server.MsgStore.STM import Simplex.Messaging.Server.MsgStore.Types import Simplex.Messaging.Server.NtfStore @@ -245,7 +246,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 -> diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs index 574111c15..610248c2f 100644 --- a/src/Simplex/Messaging/Server/Env/STM.hs +++ b/src/Simplex/Messaging/Server/Env/STM.hs @@ -115,6 +115,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, closeNamesEnv, newNamesEnv) import Simplex.Messaging.Server.NtfStore import Simplex.Messaging.Server.QueueStore import Simplex.Messaging.Server.QueueStore.Postgres.Config @@ -197,6 +198,8 @@ data ServerConfig s = ServerConfig smpAgentCfg :: SMPClientAgentConfig, allowSMPProxy :: Bool, -- auth is the same with `newQueueBasicAuth` serverClientConcurrency :: Int, + -- | public-namespace resolver config; Nothing disables the names role + namesConfig :: Maybe NamesConfig, -- | server public information information :: Maybe ServerPublicInfo, startOptions :: StartOptions @@ -272,7 +275,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 +562,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 {allowSMPProxy, smpCredentials, httpCredentials, serverStoreCfg, smpAgentCfg, information, messageExpiration, idleQueueInterval, msgQueueQuota, maxJournalMsgCount, maxJournalStateLines, namesConfig} = do serverActive <- newTVarIO True server <- newServer msgStore_ <- case serverStoreCfg of @@ -603,6 +607,13 @@ newEnv config@ServerConfig {smpCredentials, httpCredentials, serverStoreCfg, smp sockets <- newTVarIO [] clientSeq <- newTVarIO 0 proxyAgent <- newSMPProxyAgent smpAgentCfg random + namesEnv <- case namesConfig of + Nothing -> pure Nothing + Just nc + | allowSMPProxy && not (dangerousColocation nc) -> do + logError "[NAMES] enable: on with [PROXY] is refused — RSLV cache misses can serialise other forwarded commands. Set allow_dangerous_colocation = on to override." + exitFailure + | otherwise -> Just <$> newNamesEnv nc pure Env { serverActive, @@ -618,7 +629,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 () diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index f7461f392..edde8a78b 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -39,6 +39,7 @@ module Simplex.Messaging.Server.Main strParse, ) where +import Control.Applicative ((<|>)) import Control.Concurrent.STM import Control.Exception (finally) import Control.Logger.Simple @@ -76,6 +77,8 @@ 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.Protocol (mkNameOwner, NameOwner) +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,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath = }, allowSMPProxy = True, serverClientConcurrency = readIniDefault defaultProxyClientConcurrency "PROXY" "client_concurrency" ini, + namesConfig = readNamesConfig ini, information = serverPublicInfo ini, startOptions } @@ -796,6 +800,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 = + Just + NamesConfig + { ethereumEndpoint = requiredText "ethereum_endpoint", + snrcAddress = either (error . ("[NAMES] snrc_address: " <>)) id $ parseEthAddr (requiredText "snrc_address"), + rpcAuth = either (error . ("[NAMES] rpc_auth: " <>)) Just . parseRpcAuth =<< eitherToMaybe (lookupValue "NAMES" "rpc_auth" ini), + cacheSeconds = readIniDefault 300 "NAMES" "cache_seconds" ini, + cacheMaxEntries = readIniDefault 100000 "NAMES" "cache_max_entries" ini, + cacheMaxBytes = readIniDefault 67108864 "NAMES" "cache_max_bytes" ini, + rpcTimeoutMs = readIniDefault 3000 "NAMES" "rpc_timeout_ms" ini, + rpcMaxResponseBytes = readIniDefault 262144 "NAMES" "rpc_max_response_bytes" ini, + rpcMaxConcurrency = readIniDefault 8 "NAMES" "rpc_max_concurrency" ini, + dangerousColocation = fromMaybe False (iniOnOff "NAMES" "allow_dangerous_colocation" ini) + } + where + enabled = fromMaybe False (iniOnOff "NAMES" "enable" ini) + requiredText key = + either (error . (("[NAMES] " <> T.unpack key <> " is required: ") <>)) id $ + lookupValue "NAMES" key ini + +-- | Parse a 20-byte Ethereum address as text "0x[hex40]" or "[hex40]". +-- Step 4 minimal validation; EIP-55 checksum check lands in step 5. +parseEthAddr :: Text -> Either String NameOwner +parseEthAddr t = + let s = case T.stripPrefix "0x" t <|> T.stripPrefix "0X" t of + Just rest -> rest + Nothing -> t + in if T.length s == 40 && T.all isHex s + then mkNameOwner (hexDecode (encodeUtf8 s)) + else Left "expected 0x-prefixed 40 hex characters" + where + isHex c = (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F') + +-- | Decode a hex string of even length. Precondition: input is already +-- validated as even-length and all-hex (validated by caller). +hexDecode :: ByteString -> ByteString +hexDecode = B.pack . go + where + go s + | B.null s = [] + | otherwise = toEnum (16 * digit (B.head s) + digit (B.index s 1)) : go (B.drop 2 s) + digit c + | c >= '0' && c <= '9' = fromEnum c - fromEnum '0' + | c >= 'a' && c <= 'f' = 10 + fromEnum c - fromEnum 'a' + | otherwise = 10 + fromEnum c - fromEnum 'A' + +parseRpcAuth :: Text -> Either String RpcAuth +parseRpcAuth t = case T.words t of + ["bearer", tok] -> Right $ AuthBearer tok + ["basic", up] -> 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 ` or `basic :`" + printSourceCode :: Maybe Text -> IO () printSourceCode = \case Just sourceCode -> T.putStrLn $ "Server source code: " <> sourceCode diff --git a/src/Simplex/Messaging/Server/Main/Init.hs b/src/Simplex/Messaging/Server/Main/Init.hs index 0e3ceb81b..1091bb261 100644 --- a/src/Simplex/Messaging/Server/Main/Init.hs +++ b/src/Simplex/Messaging/Server/Main/Init.hs @@ -155,6 +155,25 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds = \# 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 (SNRC on Ethereum).\n\ + \# Requires an Ethereum JSON-RPC endpoint (Reth+Nimbus). See deployment guide.\n\ + \# Cannot be combined with [PROXY] enable: on by default - see allow_dangerous_colocation.\n\ + \# Restart required to change settings.\n\ + \enable: off\n\ + \# Same-host:\n\ + \# ethereum_endpoint: http://127.0.0.1:8545\n\ + \# Central Reth via Caddy:\n\ + \# ethereum_endpoint: https://eth.simplex.chat:443\n\ + \# rpc_auth: basic :\n\ + \# snrc_address: 0x0000000000000000000000000000000000000000\n\ + \# cache_seconds: 300\n\ + \# cache_max_entries: 100000\n\ + \# cache_max_bytes: 67108864\n\ + \# rpc_timeout_ms: 3000\n\ + \# rpc_max_response_bytes: 262144\n\ + \# rpc_max_concurrency: 8\n\ + \# allow_dangerous_colocation: off\n\n\ \[INACTIVE_CLIENTS]\n\ \# TTL and interval to check inactive clients\n\ \disconnect = on\n" diff --git a/src/Simplex/Messaging/Server/Names.hs b/src/Simplex/Messaging/Server/Names.hs new file mode 100644 index 000000000..418598d68 --- /dev/null +++ b/src/Simplex/Messaging/Server/Names.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} + +-- | SMP public-namespace resolver. +-- +-- This is a step-4 skeleton: the real cache, in-flight coalescing, +-- HTTP transport, and SNRC ABI codec land in step 5. +module Simplex.Messaging.Server.Names + ( NamesConfig (..), + RpcAuth (..), + NamesEnv, + ResolveError (..), + newNamesEnv, + closeNamesEnv, + resolveName, + ) +where + +import Data.ByteString.Char8 (ByteString) +import Data.Int (Int64) +import Data.Text (Text) +import Simplex.Messaging.Protocol (NameOwner, NameRecord) + +data NamesConfig = NamesConfig + { ethereumEndpoint :: Text, + snrcAddress :: NameOwner, + rpcAuth :: Maybe RpcAuth, + cacheSeconds :: Int, + cacheMaxEntries :: Int, + cacheMaxBytes :: Int, + rpcTimeoutMs :: Int, + rpcMaxResponseBytes :: Int, + rpcMaxConcurrency :: Int, + dangerousColocation :: Bool + } + deriving (Show) + +data RpcAuth = AuthBearer Text | AuthBasic Text Text + deriving (Show) + +-- | Opaque resolver environment. Real implementation in step 5 carries +-- HTTP manager, cache TVar, in-flight TMap, semaphore, and an `ethCall` +-- function value (test seam via newNamesEnvWith). +data NamesEnv = NamesEnv + { config :: NamesConfig + } + +data ResolveError + = NotFound + | EthHttpErr + | EthRpcErr {rpcCode :: Int, rpcMessage :: Text} + | EthDecodeErr + | TimedOut + deriving (Show) + +newNamesEnv :: NamesConfig -> IO NamesEnv +newNamesEnv config = pure NamesEnv {config} + +closeNamesEnv :: NamesEnv -> IO () +closeNamesEnv _ = pure () + +-- | Stub: real resolver wired in step 7. Currently always returns NotFound +-- so the server compiles and reports ERR AUTH for every RSLV. +resolveName :: NamesEnv -> ByteString -> IO (Either ResolveError NameRecord) +resolveName _ _ = pure (Left NotFound) + +-- Silence unused-field warning until step 5 wires this through. +_unused :: NamesEnv -> NamesConfig +_unused = config diff --git a/tests/SMPClient.hs b/tests/SMPClient.hs index d043fd3c8..2ee9b509f 100644 --- a/tests/SMPClient.hs +++ b/tests/SMPClient.hs @@ -278,6 +278,7 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg -> smpAgentCfg = defaultSMPClientAgentConfig {persistErrorInterval = 1}, -- seconds allowSMPProxy = False, serverClientConcurrency = 2, + namesConfig = Nothing, information = Nothing, startOptions = defaultStartOptions } From ee323d5126537f70c6dd5fe83dc8d96ced61a703 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 09:49:56 +0000 Subject: [PATCH 07/31] smp-server: Names resolver subtree (RPC + SNRC ABI + cache) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add Server/Names/Eth/SNRC.hs: Keccak-256 namehash (NOT SHA3-256), SNRC selector, encodeGetRecord, and bounded ABI primitives (decodeWord256Int64, decodeAddress, decodeString, decodeStringArray) enforcing the 8 safety invariants. decodeGetRecord is a placeholder that maps non-zero owners to Nothing pending the Part 1 contract ABI; the primitives are production-ready. Add Server/Names/Eth/RPC.hs: EthRpcEnv with http-client Manager, http-client-tls for HTTPS, QSem-bounded concurrency, brReadSome-bounded response body, Basic/Bearer Authorization, JSON-RPC envelope, and scrubUrl that strips userinfo from log strings. Add Server/Names/Resolver.hs: NamesConfig, ResolveError, NamesEnv with HashPSQ cache (TTL + byte cap + FIFO eviction) and inflight TMap. resolveName coalesces concurrent identical requests under E.mask so the TMap is always cleaned up; fetchOnceTimed bounds RPCs by rpcTimeoutMs. Refactor Server/Names.hs into a thin façade re-exporting from Resolver (types/functions) and Eth.RPC (RpcAuth) — keeps the import surface stable for Env/STM.hs and Main.hs while the implementation modules break the cyclic import. Cabal: add http-client, http-client-tls, network-uri, psqueues deps; expose the three new Server.Names.* modules in the !flag(client_library) block. --- simplexmq.cabal | 7 + src/Simplex/Messaging/Server/Names.hs | 67 +----- src/Simplex/Messaging/Server/Names/Eth/RPC.hs | 213 ++++++++++++++++++ .../Messaging/Server/Names/Eth/SNRC.hs | 171 ++++++++++++++ .../Messaging/Server/Names/Resolver.hs | 193 ++++++++++++++++ 5 files changed, 590 insertions(+), 61 deletions(-) create mode 100644 src/Simplex/Messaging/Server/Names/Eth/RPC.hs create mode 100644 src/Simplex/Messaging/Server/Names/Eth/SNRC.hs create mode 100644 src/Simplex/Messaging/Server/Names/Resolver.hs diff --git a/simplexmq.cabal b/simplexmq.cabal index 97b945d51..04ced952a 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -262,6 +262,9 @@ library Simplex.Messaging.Server.MsgStore.STM Simplex.Messaging.Server.MsgStore.Types Simplex.Messaging.Server.Names + Simplex.Messaging.Server.Names.Eth.RPC + Simplex.Messaging.Server.Names.Eth.SNRC + Simplex.Messaging.Server.Names.Resolver Simplex.Messaging.Server.NtfStore Simplex.Messaging.Server.Prometheus Simplex.Messaging.Server.QueueStore @@ -356,9 +359,13 @@ library build-depends: case-insensitive ==1.2.* , hashable ==1.4.* + , http-client >=0.7 && <0.8 + , http-client-tls >=0.3 && <0.4 , ini ==0.4.1 + , network-uri >=2.6 && <2.7 , optparse-applicative >=0.15 && <0.17 , process ==1.6.* + , psqueues >=0.2.7 && <0.3 , temporary ==1.3.* , wai >=3.2 && <3.3 , wai-app-static >=3.1 && <3.2 diff --git a/src/Simplex/Messaging/Server/Names.hs b/src/Simplex/Messaging/Server/Names.hs index 418598d68..eea09b013 100644 --- a/src/Simplex/Messaging/Server/Names.hs +++ b/src/Simplex/Messaging/Server/Names.hs @@ -1,14 +1,8 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StrictData #-} - --- | SMP public-namespace resolver. +-- | SMP public-namespace resolver façade. -- --- This is a step-4 skeleton: the real cache, in-flight coalescing, --- HTTP transport, and SNRC ABI codec land in step 5. +-- Re-exports the resolver's public surface from Names.Resolver and the +-- HTTP auth type from Names.Eth.RPC. Implementation lives in Resolver.hs; +-- Eth.RPC / Eth.SNRC are transport / codec internals. module Simplex.Messaging.Server.Names ( NamesConfig (..), RpcAuth (..), @@ -20,54 +14,5 @@ module Simplex.Messaging.Server.Names ) where -import Data.ByteString.Char8 (ByteString) -import Data.Int (Int64) -import Data.Text (Text) -import Simplex.Messaging.Protocol (NameOwner, NameRecord) - -data NamesConfig = NamesConfig - { ethereumEndpoint :: Text, - snrcAddress :: NameOwner, - rpcAuth :: Maybe RpcAuth, - cacheSeconds :: Int, - cacheMaxEntries :: Int, - cacheMaxBytes :: Int, - rpcTimeoutMs :: Int, - rpcMaxResponseBytes :: Int, - rpcMaxConcurrency :: Int, - dangerousColocation :: Bool - } - deriving (Show) - -data RpcAuth = AuthBearer Text | AuthBasic Text Text - deriving (Show) - --- | Opaque resolver environment. Real implementation in step 5 carries --- HTTP manager, cache TVar, in-flight TMap, semaphore, and an `ethCall` --- function value (test seam via newNamesEnvWith). -data NamesEnv = NamesEnv - { config :: NamesConfig - } - -data ResolveError - = NotFound - | EthHttpErr - | EthRpcErr {rpcCode :: Int, rpcMessage :: Text} - | EthDecodeErr - | TimedOut - deriving (Show) - -newNamesEnv :: NamesConfig -> IO NamesEnv -newNamesEnv config = pure NamesEnv {config} - -closeNamesEnv :: NamesEnv -> IO () -closeNamesEnv _ = pure () - --- | Stub: real resolver wired in step 7. Currently always returns NotFound --- so the server compiles and reports ERR AUTH for every RSLV. -resolveName :: NamesEnv -> ByteString -> IO (Either ResolveError NameRecord) -resolveName _ _ = pure (Left NotFound) - --- Silence unused-field warning until step 5 wires this through. -_unused :: NamesEnv -> NamesConfig -_unused = config +import Simplex.Messaging.Server.Names.Eth.RPC (RpcAuth (..)) +import Simplex.Messaging.Server.Names.Resolver (NamesConfig (..), NamesEnv, ResolveError (..), closeNamesEnv, newNamesEnv, resolveName) diff --git a/src/Simplex/Messaging/Server/Names/Eth/RPC.hs b/src/Simplex/Messaging/Server/Names/Eth/RPC.hs new file mode 100644 index 000000000..f89127343 --- /dev/null +++ b/src/Simplex/Messaging/Server/Names/Eth/RPC.hs @@ -0,0 +1,213 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StrictData #-} + +-- | Ethereum JSON-RPC HTTP transport for the resolver. +-- +-- Boundary properties: +-- * Response body read with `brReadSome rpcMaxResponseBytes` — adversarial +-- endpoints cannot exhaust memory with multi-GB bodies. +-- * Concurrency cap via QSem — bursts of cache-miss traffic cannot exhaust +-- the http-client connection pool. +-- * Authorization header attached only when configured. +module Simplex.Messaging.Server.Names.Eth.RPC + ( RpcAuth (..), + EthRpcEnv (..), + EthRpcError (..), + newEthRpcEnv, + closeEthRpcEnv, + ethCallReal, + scrubUrl, + ) +where + +import Control.Applicative ((<|>)) +import Control.Concurrent.QSem (QSem, newQSem, signalQSem, waitQSem) +import qualified Control.Exception as E +import Control.Exception (bracket_) +import qualified Data.Aeson as J +import qualified Data.Aeson.Types as J +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 qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import Network.HTTP.Client + ( HttpException, + Manager, + Request, + RequestBody (..), + brReadSome, + closeManager, + method, + parseRequest, + requestBody, + requestHeaders, + responseBody, + responseStatus, + withResponse, + ) +import qualified Network.HTTP.Client as HC +import Network.HTTP.Client.TLS (tlsManagerSettings) +import qualified Network.HTTP.Types as HT + +data RpcAuth = AuthBearer Text | AuthBasic Text Text + deriving (Show) + +data EthRpcEnv = EthRpcEnv + { manager :: Manager, + request :: Request, + sem :: QSem, + maxResponseBytes :: Int + } + +data EthRpcError + = HttpFailure HttpException + | HttpStatusErr Int + | BodyTooLarge + | InvalidJson String + | JsonRpcErr Int Text + deriving (Show) + +-- | Build a Request from a (validated) ethereum_endpoint URL. +buildRequest :: Text -> Maybe RpcAuth -> IO Request +buildRequest endpoint auth_ = do + req <- parseRequest (T.unpack endpoint) + pure $ + req + { method = "POST", + requestHeaders = + ("Content-Type", "application/json") + : maybe [] (pure . authHeader) auth_ + } + +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) + +newEthRpcEnv :: Text -> Maybe RpcAuth -> Int -> Int -> IO EthRpcEnv +newEthRpcEnv endpoint auth_ maxResponseBytes maxConcurrency = do + manager <- HC.newManager tlsManagerSettings + request <- buildRequest endpoint auth_ + sem <- newQSem maxConcurrency + pure EthRpcEnv {manager, request, sem, maxResponseBytes} + +closeEthRpcEnv :: EthRpcEnv -> IO () +closeEthRpcEnv EthRpcEnv {manager} = closeManager manager + +-- | Make a single eth_call. `to` is the contract address (20 raw bytes); +-- `dat` is the ABI-encoded call data. Returns the contract return bytes. +ethCallReal :: EthRpcEnv -> ByteString -> ByteString -> IO (Either EthRpcError ByteString) +ethCallReal EthRpcEnv {manager, request, sem, maxResponseBytes} to dat = + bracket_ (waitQSem sem) (signalQSem sem) $ do + let body = J.encode (rpcEnvelope to dat) + req = request {requestBody = RequestBodyLBS body} + result <- E.try $ withResponse req manager $ \res -> do + let status = responseStatus res + if HT.statusCode status >= 400 + then pure (Left (HttpStatusErr (HT.statusCode status))) + else do + bs <- brReadSome (responseBody res) (maxResponseBytes + 1) + if BL.length bs > fromIntegral maxResponseBytes + then pure (Left BodyTooLarge) + else pure (parseResult (BL.toStrict bs)) + pure (either (Left . HttpFailure) id result) + +rpcEnvelope :: ByteString -> ByteString -> J.Value +rpcEnvelope to dat = + J.object + [ "jsonrpc" J..= ("2.0" :: Text), + "id" J..= (1 :: Int), + "method" J..= ("eth_call" :: Text), + "params" + J..= [ J.object + [ "to" J..= toHex to, + "data" J..= toHex dat + ], + J.String "latest" + ] + ] + +parseResult :: ByteString -> Either EthRpcError ByteString +parseResult bs = case J.eitherDecodeStrict bs of + Left e -> Left (InvalidJson e) + Right (v :: J.Value) -> case J.parseEither parser v of + Left e -> Left (InvalidJson e) + Right r -> r + where + parser :: J.Value -> J.Parser (Either EthRpcError ByteString) + parser = J.withObject "rpc" $ \o -> do + mErr :: Maybe J.Value <- o J..:? "error" + case mErr of + Just (J.Object eo) -> do + code <- (eo J..: "code") <|> pure (-1 :: Int) + msg <- (eo J..: "message") <|> pure ("rpc error" :: Text) + pure (Left (JsonRpcErr code msg)) + _ -> do + result :: Text <- o J..: "result" + case fromHex (encodeUtf8 result) of + Right b -> pure (Right b) + Left e -> pure (Left (InvalidJson e)) + +toHex :: ByteString -> Text +toHex bs = T.pack $ "0x" <> concatMap byte (B.unpack bs) + where + byte c = + let n = fromEnum c + (h, l) = quotRem n 16 + in [hexChar h, hexChar l] + hexChar n + | n < 10 = toEnum (fromEnum '0' + n) + | otherwise = toEnum (fromEnum 'a' + n - 10) + +fromHex :: ByteString -> Either String ByteString +fromHex bs0 = + let bs = case B.stripPrefix "0x" bs0 of + Just rest -> rest + Nothing -> case B.stripPrefix "0X" bs0 of + Just rest -> rest + Nothing -> bs0 + in if B.null bs + then Right B.empty + else + if odd (B.length bs) || not (B.all isHex bs) + then Left "invalid hex" + else Right (decodeHex bs) + where + isHex c = (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F') + +decodeHex :: ByteString -> ByteString +decodeHex = B.pack . go + where + go s + | B.null s = [] + | otherwise = + let hi = digit (B.head s) + lo = digit (B.index s 1) + in toEnum (16 * hi + lo) : go (B.drop 2 s) + digit c + | c >= '0' && c <= '9' = fromEnum c - fromEnum '0' + | c >= 'a' && c <= 'f' = 10 + fromEnum c - fromEnum 'a' + | otherwise = 10 + fromEnum c - fromEnum 'A' + +-- | Strip userinfo from a URL so log lines never leak credentials. +scrubUrl :: Text -> Text +scrubUrl url = + let (scheme, rest) = T.breakOn "://" url + in if T.null rest + then url + else + let body = T.drop 3 rest + (host, query) = T.breakOn "/" body + in case T.breakOn "@" host of + (_userinfo, atRest) + | not (T.null atRest) -> scheme <> "://" <> T.drop 1 atRest <> query + _ -> url diff --git a/src/Simplex/Messaging/Server/Names/Eth/SNRC.hs b/src/Simplex/Messaging/Server/Names/Eth/SNRC.hs new file mode 100644 index 000000000..c645b8ebe --- /dev/null +++ b/src/Simplex/Messaging/Server/Names/Eth/SNRC.hs @@ -0,0 +1,171 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StrictData #-} + +-- | SNRC contract codec: Keccak-256 namehash + bounded Solidity ABI decoder. +-- +-- IMPORTANT: Ethereum uses Keccak-256, NOT NIST SHA3-256. +-- +-- ABI safety invariants (enforced before any allocation): +-- 1. offset + 32 <= buf.length (head read in-bounds) +-- 2. offset + 32 + length <= buf.length (body in-bounds) +-- 3. offset >= headEnd (no backward jumps) +-- 4. every length <= per-field cap (bounded allocations) +-- 5. string[] outer count * 32 + offset <= buf.length (array head fits) +-- 6. recursion depth <= 2 (no deep nesting) +-- 7. uint256 -> Int64 fails if any high 24 bytes non-zero (range check) +-- 8. UTF-8 via decodeUtf8' returns AbiBadUtf8 (no partial bytes) +module Simplex.Messaging.Server.Names.Eth.SNRC + ( -- * Namehash + keccak256, + namehash, + + -- * SNRC eth_call payload + snrcSelector, + encodeGetRecord, + + -- * ABI decoding + AbiError (..), + decodeGetRecord, + decodeWord256Int64, + decodeAddress, + decodeString, + decodeStringArray, + ) +where + +import Crypto.Hash (Digest, Keccak_256, hash) +import qualified Data.ByteArray as BA +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B +import Data.Int (Int64) +import Simplex.Messaging.Protocol (NameOwner, NameRecord, mkNameOwner, unNameOwner) + +-- | ABI-decode failure modes (caller collapses to ResolveError EthDecodeErr). +data AbiError + = AbiTruncated + | AbiOversized + | AbiBackwardOffset + | AbiNonZeroHighBytes + | AbiBadUtf8 + | AbiDepthExceeded + | AbiInvariantViolated String + deriving (Eq, Show) + +-- | Keccak-256 (Ethereum variant), NOT SHA3-256. +keccak256 :: ByteString -> ByteString +keccak256 = BA.convert . (hash :: ByteString -> Digest Keccak_256) +{-# INLINE keccak256 #-} + +-- | ENS / SNRC namehash: recursive keccak256 over reversed labels. +-- Empty name -> 32 zero bytes; "a.b.c" -> keccak(keccak(keccak(0 ++ keccak "c") ++ keccak "b") ++ keccak "a"). +namehash :: ByteString -> ByteString +namehash name + | B.null name = zeroNode + | otherwise = foldr step zeroNode (B.split '.' name) + where + zeroNode = B.replicate 32 '\NUL' + step label acc = keccak256 (acc <> keccak256 label) + +-- | First 4 bytes of keccak("getRecord(bytes32)"). Confirm signature +-- against the Part 1 SNRC contract before merging. +snrcSelector :: ByteString +snrcSelector = B.take 4 (keccak256 "getRecord(bytes32)") + +-- | Build the eth_call `data` parameter for getRecord(lookupKey). +encodeGetRecord :: ByteString -> ByteString +encodeGetRecord node32 + | B.length node32 == 32 = snrcSelector <> node32 + | otherwise = snrcSelector <> padLeft32 node32 + +padLeft32 :: ByteString -> ByteString +padLeft32 bs + | n >= 32 = B.take 32 bs + | otherwise = B.replicate (32 - n) '\NUL' <> bs + where + n = B.length bs + +-- | Read a uint256 at byte offset, fail if it doesn't fit in Int64. +decodeWord256Int64 :: Int -> ByteString -> Either AbiError Int64 +decodeWord256Int64 off buf + | off + 32 > B.length buf = Left AbiTruncated + | B.any (/= toEnum 0) (B.take 24 (B.drop off buf)) = Left AbiNonZeroHighBytes + | otherwise = Right $ B.foldl shiftIn 0 (B.take 8 (B.drop (off + 24) buf)) + where + shiftIn :: Int64 -> Char -> Int64 + shiftIn !acc c = (acc * 256) + fromIntegral (fromEnum c :: Int) +{-# INLINE decodeWord256Int64 #-} + +-- | Read an Ethereum address at byte offset (uint256 with high 12 bytes zero). +decodeAddress :: Int -> ByteString -> Either AbiError NameOwner +decodeAddress off buf + | off + 32 > B.length buf = Left AbiTruncated + | B.any (/= toEnum 0) (B.take 12 (B.drop off buf)) = Left (AbiInvariantViolated "address has non-zero high 12 bytes") + | otherwise = case mkNameOwner (B.take 20 (B.drop (off + 12) buf)) of + Right addr -> Right addr + Left e -> Left (AbiInvariantViolated e) + +-- | Decode a Solidity `string` whose data starts at byte offset `off`. +decodeString :: Int -> Int -> Int -> ByteString -> Either AbiError ByteString +decodeString headEnd off cap buf + | off < headEnd = Left AbiBackwardOffset + | off + 32 > B.length buf = Left AbiTruncated + | otherwise = do + n <- decodeWord256Int64 off buf + let len = fromIntegral n :: Int + if len > cap + then Left AbiOversized + else + if off + 32 + len > B.length buf + then Left AbiTruncated + else Right $ B.take len (B.drop (off + 32) buf) + +-- | Decode a Solidity `string[]` at byte offset `off`. Each element capped +-- at `byteCap` bytes, total element count capped at `cntCap`. Depth must be +-- < 2 (recurses one level into decodeString). +decodeStringArray :: Int -> Int -> Int -> Int -> Int -> ByteString -> Either AbiError [ByteString] +decodeStringArray depth headEnd off cntCap byteCap buf + | depth >= 2 = Left AbiDepthExceeded + | off < headEnd = Left AbiBackwardOffset + | off + 32 > B.length buf = Left AbiTruncated + | otherwise = do + n <- decodeWord256Int64 off buf + let cnt = fromIntegral n :: Int + if cnt > cntCap + then Left AbiOversized + else + let arrHead = off + 32 + arrHeadEnd = arrHead + cnt * 32 + in if arrHeadEnd > B.length buf + then Left AbiTruncated + else collectN 0 cnt arrHead arrHeadEnd [] + where + collectN i n base hd acc + | i >= n = Right (reverse acc) + | otherwise = do + relOff <- decodeWord256Int64 (base + i * 32) buf + let absOff = base + fromIntegral relOff + s <- decodeString hd absOff byteCap buf + collectN (i + 1) n base hd (s : acc) + +-- | Decode the ABI-encoded return value of getRecord(bytes32) into a NameRecord. +-- Zero-owner (0x000...000) is reported as Right Nothing so the caller maps it +-- to NotFound (ENS-style sentinel). +-- +-- PLACEHOLDER: returns Right Nothing for any non-zero owner until the Part 1 +-- SNRC contract ABI is finalised. All ABI primitives above are production-ready; +-- only the field-layout-aware composition is pending. +decodeGetRecord :: ByteString -> Either AbiError (Maybe NameRecord) +decodeGetRecord buf + | B.length buf < 32 * 8 = Left AbiTruncated + | otherwise = case decodeAddress 32 buf of + Left e -> Left e + Right owner + | isZeroOwner owner -> Right Nothing + | otherwise -> Right Nothing -- placeholder until SNRC ABI is finalised + +isZeroOwner :: NameOwner -> Bool +isZeroOwner = (== B.replicate 20 '\NUL') . unNameOwner diff --git a/src/Simplex/Messaging/Server/Names/Resolver.hs b/src/Simplex/Messaging/Server/Names/Resolver.hs new file mode 100644 index 000000000..b1232d306 --- /dev/null +++ b/src/Simplex/Messaging/Server/Names/Resolver.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StrictData #-} + +-- | Public-namespace resolver: TTL+FIFO cache, in-flight coalescing, +-- timeout-bounded RPC, and zero-owner → NotFound mapping. +module Simplex.Messaging.Server.Names.Resolver + ( NamesConfig (..), + RpcAuth (..), + NamesEnv (..), + EthCall, + ResolveError (..), + newNamesEnv, + newNamesEnvWith, + closeNamesEnv, + resolveName, + ) +where + +import Control.Concurrent.STM +import qualified Control.Exception as E +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B +import qualified Data.HashPSQ as PSQ +import Data.Int (Int64) +import Data.Text (Text) +import qualified Data.Text as T +import Data.Word (Word64) +import GHC.Clock (getMonotonicTimeNSec) +import Simplex.Messaging.Protocol (NameOwner, NameRecord, unNameOwner) +import Simplex.Messaging.Server.Names.Eth.RPC (EthRpcEnv, EthRpcError (..), RpcAuth (..), closeEthRpcEnv, ethCallReal, newEthRpcEnv) +import Simplex.Messaging.Server.Names.Eth.SNRC (decodeGetRecord, encodeGetRecord, namehash) +import System.Timeout (timeout) + +-- | Public-namespace resolver configuration. +data NamesConfig = NamesConfig + { ethereumEndpoint :: Text, + snrcAddress :: NameOwner, + rpcAuth :: Maybe RpcAuth, + cacheSeconds :: Int, + cacheMaxEntries :: Int, + cacheMaxBytes :: Int, + rpcTimeoutMs :: Int, + rpcMaxResponseBytes :: Int, + rpcMaxConcurrency :: Int, + dangerousColocation :: Bool + } + deriving (Show) + +data ResolveError + = NotFound + | EthHttpErr + | EthRpcErr {rpcCode :: Int, rpcMessage :: Text} + | EthDecodeErr + | TimedOut + deriving (Show) + +-- | Test seam: a function from (to, data) -> raw return bytes or error. +-- Production wires this to ethCallReal; tests substitute a stub. +type EthCall = ByteString -> ByteString -> IO (Either EthRpcError ByteString) + +-- | Cache value bundles a NameRecord with its insertion-time byte cost +-- so eviction can keep total cache bytes under cacheMaxBytes. +data CacheEntry = CacheEntry + { ceRecord :: NameRecord, + ceBytes :: Int + } + +-- | Cache state: (PSQ keyed by LookupKey, priority = insert time in ns, total bytes). +-- PSQ minView returns lowest-priority element → FIFO eviction by insertion order. +type CacheState = (PSQ.HashPSQ ByteString Word64 CacheEntry, Int) + +data NamesEnv = NamesEnv + { config :: NamesConfig, + ethCall :: EthCall, + cache :: TVar CacheState, + inflight :: TVar (PSQ.HashPSQ ByteString Word64 (TMVar (Either ResolveError NameRecord))), + rpcEnv :: Maybe EthRpcEnv -- Nothing for test stubs + } + +-- | Allocate resolver with real HTTP transport. +newNamesEnv :: NamesConfig -> IO NamesEnv +newNamesEnv cfg = do + rpc <- newEthRpcEnv (ethereumEndpoint cfg) (rpcAuth cfg) (rpcMaxResponseBytes cfg) (rpcMaxConcurrency cfg) + let call to dat = ethCallReal rpc to dat + newNamesEnvWith cfg call (Just rpc) + +-- | Allocate resolver with an injected ethCall (test seam). +newNamesEnvWith :: NamesConfig -> EthCall -> Maybe EthRpcEnv -> IO NamesEnv +newNamesEnvWith config ethCall rpcEnv = do + cache <- newTVarIO (PSQ.empty, 0) + inflight <- newTVarIO PSQ.empty + pure NamesEnv {config, ethCall, cache, inflight, rpcEnv} + +closeNamesEnv :: NamesEnv -> IO () +closeNamesEnv NamesEnv {rpcEnv} = maybe (pure ()) closeEthRpcEnv rpcEnv + +-- | Resolve a lookup key. Coalesces concurrent identical requests, caches +-- results for cacheSeconds, and bounds RPCs by rpcTimeoutMs. +resolveName :: NamesEnv -> ByteString -> IO (Either ResolveError NameRecord) +resolveName env key = do + now <- getMonotonicTimeNSec + cacheLookup env key now >>= \case + Just rec -> pure (Right rec) + Nothing -> coalesce env key now + +cacheLookup :: NamesEnv -> ByteString -> Word64 -> IO (Maybe NameRecord) +cacheLookup NamesEnv {config, cache} key now = atomically $ do + (psq, totalBytes) <- readTVar cache + case PSQ.lookup key psq of + Just (insertedAt, ce) + | now < insertedAt + ttlNs config -> pure (Just (ceRecord ce)) + | otherwise -> do + -- Expired: evict and signal miss. + writeTVar cache (PSQ.delete key psq, totalBytes - ceBytes ce) + pure Nothing + Nothing -> pure Nothing + +ttlNs :: NamesConfig -> Word64 +ttlNs cfg = fromIntegral (cacheSeconds cfg) * 1000000000 + +-- | Leader/waiter coalescing. Leader runs the RPC under E.mask; waiters +-- block on the leader's TMVar. Cleanup runs even on async exception. +coalesce :: NamesEnv -> ByteString -> Word64 -> IO (Either ResolveError NameRecord) +coalesce env@NamesEnv {inflight} key now = do + ticket <- atomically $ do + flight <- readTVar inflight + case PSQ.lookup key flight of + Just (_, mv) -> pure (Right mv) + Nothing -> do + mv <- newEmptyTMVar + writeTVar inflight (PSQ.insert key now mv flight) + pure (Left mv) + case ticket of + Right mv -> atomically (readTMVar mv) -- waiter + Left mv -> E.mask $ \restore -> do + r <- + restore (fetchOnceTimed env key) + `E.catch` \(e :: E.SomeException) -> pure (Left (mapEthExn e)) + atomically $ do + putTMVar mv r + modifyTVar' inflight (PSQ.delete key) + case r of + Right rec -> cacheInsert env key now rec + Left _ -> pure () + pure r + +mapEthExn :: E.SomeException -> ResolveError +mapEthExn _ = EthHttpErr + +fetchOnceTimed :: NamesEnv -> ByteString -> IO (Either ResolveError NameRecord) +fetchOnceTimed env key = + timeout (rpcTimeoutMs (config env) * 1000) (fetchOnce env key) >>= \case + Just r -> pure r + Nothing -> pure (Left TimedOut) + +fetchOnce :: NamesEnv -> ByteString -> IO (Either ResolveError NameRecord) +fetchOnce env@NamesEnv {ethCall, config} key = do + let node = namehash key + callData = encodeGetRecord node + to = unNameOwner (snrcAddress config) + ethCall to callData >>= \case + Left (HttpFailure _) -> pure (Left EthHttpErr) + Left (HttpStatusErr _) -> pure (Left EthHttpErr) + Left BodyTooLarge -> pure (Left EthDecodeErr) + Left (InvalidJson _) -> pure (Left EthDecodeErr) + Left (JsonRpcErr c m) -> pure (Left EthRpcErr {rpcCode = c, rpcMessage = m}) + Right ret -> case decodeGetRecord ret of + Right Nothing -> pure (Left NotFound) + Right (Just rec) -> pure (Right rec) + Left _ -> pure (Left EthDecodeErr) + +cacheInsert :: NamesEnv -> ByteString -> Word64 -> NameRecord -> IO () +cacheInsert NamesEnv {config, cache} key now rec = atomically $ do + (psq, totalBytes) <- readTVar cache + let entryBytes = estimateBytes rec + (psq', totalBytes') = evictWhile psq totalBytes + evictWhile p tb + | PSQ.size p > cacheMaxEntries config || tb + entryBytes > cacheMaxBytes config = + case PSQ.minView p of + Just (_, _, ce, rest) -> evictWhile rest (tb - ceBytes ce) + Nothing -> (p, tb) + | otherwise = (p, tb) + ce = CacheEntry {ceRecord = rec, ceBytes = entryBytes} + writeTVar cache (PSQ.insert key now ce psq', totalBytes' + entryBytes) + +-- | Approximate byte cost of a cached NameRecord (overhead + content). +-- Tight enough that cacheMaxBytes bounds real memory; not byte-exact. +estimateBytes :: NameRecord -> Int +estimateBytes _ = 4096 -- conservative upper bound per NameRecord From 13679e5ee228f23ebec2992c609e9e9a795dec20 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 09:54:41 +0000 Subject: [PATCH 08/31] smp-server: NameResolverStats + CSV log + Prometheus block Add NameResolverStats and NameResolverStatsData sub-records to ServerStats with seven counters: reqs, succ, notFound, ethErrs, cacheHits, cacheMiss, disabled. Provide newNameResolverStats, get/getReset/setNameResolverStats and a StrEncoding instance keyed by "rslvStats:" with backwards-compatible parsing (zero defaults). Append the seven counters to the daily CSV stats log and emit a simplex_smp_names_* Prometheus metric block. --- src/Simplex/Messaging/Server.hs | 6 +- src/Simplex/Messaging/Server/Prometheus.hs | 38 +++++- src/Simplex/Messaging/Server/Stats.hs | 136 ++++++++++++++++++++- 3 files changed, 171 insertions(+), 9 deletions(-) diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index a0b1250f7..8a2e2d234 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -516,7 +516,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} <- @@ -579,6 +579,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 "," @@ -652,6 +653,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt ] <> showServiceStats rcvServices' <> showServiceStats ntfServices' + <> showNameResolverStats rslvStats' ) liftIO $ threadDelay' interval where @@ -659,6 +661,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, _rslvEthErrs, _rslvCacheHits, _rslvCacheMiss, _rslvDisabled} = + map tshow [_rslvReqs, _rslvSucc, _rslvNotFound, _rslvEthErrs, _rslvCacheHits, _rslvCacheMiss, _rslvDisabled] prometheusMetricsThread_ :: ServerConfig s -> [M s ()] prometheusMetricsThread_ ServerConfig {prometheusInterval = Just interval, prometheusMetricsFile} = diff --git a/src/Simplex/Messaging/Server/Prometheus.hs b/src/Simplex/Messaging/Server/Prometheus.hs index 32e8bd9a1..f8a5f84bf 100644 --- a/src/Simplex/Messaging/Server/Prometheus.hs +++ b/src/Simplex/Messaging/Server/Prometheus.hs @@ -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,39 @@ 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, _rslvEthErrs, _rslvCacheHits, _rslvCacheMiss, _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 Lookup key has no corresponding NameRecord on chain (zero-owner sentinel).\n\ + \# TYPE simplex_smp_names_not_found counter\n\ + \simplex_smp_names_not_found " <> mshow _rslvNotFound <> "\n# rslvNotFound\n\ + \\n\ + \# HELP simplex_smp_names_eth_errs Ethereum endpoint or ABI errors.\n\ + \# TYPE simplex_smp_names_eth_errs counter\n\ + \simplex_smp_names_eth_errs " <> mshow _rslvEthErrs <> "\n# rslvEthErrs\n\ + \\n\ + \# HELP simplex_smp_names_cache_hits Resolution served from cache.\n\ + \# TYPE simplex_smp_names_cache_hits counter\n\ + \simplex_smp_names_cache_hits " <> mshow _rslvCacheHits <> "\n# rslvCacheHits\n\ + \\n\ + \# HELP simplex_smp_names_cache_miss Resolution required an eth_call.\n\ + \# TYPE simplex_smp_names_cache_miss counter\n\ + \simplex_smp_names_cache_miss " <> mshow _rslvCacheMiss <> "\n# rslvCacheMiss\n\ + \\n\ + \# HELP simplex_smp_names_disabled RSLV requests rejected because the names role is disabled.\n\ + \# TYPE simplex_smp_names_disabled counter\n\ + \simplex_smp_names_disabled " <> mshow _rslvDisabled <> "\n# rslvDisabled\n\ + \\n" info = "# Info\n\ \# ----\n\ diff --git a/src/Simplex/Messaging/Server/Stats.hs b/src/Simplex/Messaging/Server/Stats.hs index 944ff53f6..de9c23f19 100644 --- a/src/Simplex/Messaging/Server/Stats.hs +++ b/src/Simplex/Messaging/Server/Stats.hs @@ -40,6 +40,13 @@ module Simplex.Messaging.Server.Stats emptyTimeBuckets, updateTimeBuckets, incStat, + NameResolverStats (..), + NameResolverStatsData (..), + newNameResolverStats, + newNameResolverStatsData, + getNameResolverStatsData, + getResetNameResolverStatsData, + setNameResolverStats, ) where import Control.Applicative (optional, (<|>)) @@ -125,7 +132,8 @@ data ServerStats = ServerStats rcvServicesSubDuplicate :: IORef Int, qCount :: IORef Int, msgCount :: IORef Int, - ntfCount :: IORef Int + ntfCount :: IORef Int, + rslvStats :: NameResolverStats } data ServerStatsData = ServerStatsData @@ -186,7 +194,8 @@ data ServerStatsData = ServerStatsData _rcvServicesSubDuplicate :: Int, _qCount :: Int, _msgCount :: Int, - _ntfCount :: Int + _ntfCount :: Int, + _rslvStats :: NameResolverStatsData } deriving (Show) @@ -250,6 +259,7 @@ newServerStats ts = do qCount <- newIORef 0 msgCount <- newIORef 0 ntfCount <- newIORef 0 + rslvStats <- newNameResolverStats pure ServerStats { fromTime, @@ -309,7 +319,8 @@ newServerStats ts = do rcvServicesSubDuplicate, qCount, msgCount, - ntfCount + ntfCount, + rslvStats } getServerStatsData :: ServerStats -> IO ServerStatsData @@ -372,6 +383,7 @@ getServerStatsData s = do _qCount <- readIORef $ qCount s _msgCount <- readIORef $ msgCount s _ntfCount <- readIORef $ ntfCount s + _rslvStats <- getNameResolverStatsData $ rslvStats s pure ServerStatsData { _fromTime, @@ -431,7 +443,8 @@ getServerStatsData s = do _rcvServicesSubDuplicate, _qCount, _msgCount, - _ntfCount + _ntfCount, + _rslvStats } -- this function is not thread safe, it is used on server start only @@ -495,6 +508,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 = @@ -559,7 +573,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 @@ -630,6 +646,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, @@ -689,7 +709,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 @@ -868,6 +889,109 @@ 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, + rslvEthErrs :: IORef Int, + rslvCacheHits :: IORef Int, + rslvCacheMiss :: IORef Int, + rslvDisabled :: IORef Int + } + +newNameResolverStats :: IO NameResolverStats +newNameResolverStats = do + rslvReqs <- newIORef 0 + rslvSucc <- newIORef 0 + rslvNotFound <- newIORef 0 + rslvEthErrs <- newIORef 0 + rslvCacheHits <- newIORef 0 + rslvCacheMiss <- newIORef 0 + rslvDisabled <- newIORef 0 + pure NameResolverStats {rslvReqs, rslvSucc, rslvNotFound, rslvEthErrs, rslvCacheHits, rslvCacheMiss, rslvDisabled} + +data NameResolverStatsData = NameResolverStatsData + { _rslvReqs :: Int, + _rslvSucc :: Int, + _rslvNotFound :: Int, + _rslvEthErrs :: Int, + _rslvCacheHits :: Int, + _rslvCacheMiss :: Int, + _rslvDisabled :: Int + } + deriving (Show) + +newNameResolverStatsData :: NameResolverStatsData +newNameResolverStatsData = + NameResolverStatsData + { _rslvReqs = 0, + _rslvSucc = 0, + _rslvNotFound = 0, + _rslvEthErrs = 0, + _rslvCacheHits = 0, + _rslvCacheMiss = 0, + _rslvDisabled = 0 + } + +getNameResolverStatsData :: NameResolverStats -> IO NameResolverStatsData +getNameResolverStatsData s = do + _rslvReqs <- readIORef $ rslvReqs s + _rslvSucc <- readIORef $ rslvSucc s + _rslvNotFound <- readIORef $ rslvNotFound s + _rslvEthErrs <- readIORef $ rslvEthErrs s + _rslvCacheHits <- readIORef $ rslvCacheHits s + _rslvCacheMiss <- readIORef $ rslvCacheMiss s + _rslvDisabled <- readIORef $ rslvDisabled s + pure NameResolverStatsData {_rslvReqs, _rslvSucc, _rslvNotFound, _rslvEthErrs, _rslvCacheHits, _rslvCacheMiss, _rslvDisabled} + +getResetNameResolverStatsData :: NameResolverStats -> IO NameResolverStatsData +getResetNameResolverStatsData s = do + _rslvReqs <- atomicSwapIORef (rslvReqs s) 0 + _rslvSucc <- atomicSwapIORef (rslvSucc s) 0 + _rslvNotFound <- atomicSwapIORef (rslvNotFound s) 0 + _rslvEthErrs <- atomicSwapIORef (rslvEthErrs s) 0 + _rslvCacheHits <- atomicSwapIORef (rslvCacheHits s) 0 + _rslvCacheMiss <- atomicSwapIORef (rslvCacheMiss s) 0 + _rslvDisabled <- atomicSwapIORef (rslvDisabled s) 0 + pure NameResolverStatsData {_rslvReqs, _rslvSucc, _rslvNotFound, _rslvEthErrs, _rslvCacheHits, _rslvCacheMiss, _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 (rslvEthErrs s) $! _rslvEthErrs d + writeIORef (rslvCacheHits s) $! _rslvCacheHits d + writeIORef (rslvCacheMiss s) $! _rslvCacheMiss d + writeIORef (rslvDisabled s) $! _rslvDisabled d + +instance StrEncoding NameResolverStatsData where + strEncode NameResolverStatsData {_rslvReqs, _rslvSucc, _rslvNotFound, _rslvEthErrs, _rslvCacheHits, _rslvCacheMiss, _rslvDisabled} = + "reqs=" + <> strEncode _rslvReqs + <> "\nsucc=" + <> strEncode _rslvSucc + <> "\nnotFound=" + <> strEncode _rslvNotFound + <> "\nethErrs=" + <> strEncode _rslvEthErrs + <> "\ncacheHits=" + <> strEncode _rslvCacheHits + <> "\ncacheMiss=" + <> strEncode _rslvCacheMiss + <> "\ndisabled=" + <> strEncode _rslvDisabled + strP = do + _rslvReqs <- "reqs=" *> strP <* A.endOfLine + _rslvSucc <- "succ=" *> strP <* A.endOfLine + _rslvNotFound <- "notFound=" *> strP <* A.endOfLine + _rslvEthErrs <- "ethErrs=" *> strP <* A.endOfLine + _rslvCacheHits <- "cacheHits=" *> strP <* A.endOfLine + _rslvCacheMiss <- "cacheMiss=" *> strP <* A.endOfLine + _rslvDisabled <- "disabled=" *> strP + pure NameResolverStatsData {_rslvReqs, _rslvSucc, _rslvNotFound, _rslvEthErrs, _rslvCacheHits, _rslvCacheMiss, _rslvDisabled} + data ServiceStats = ServiceStats { srvAssocNew :: IORef Int, srvAssocDuplicate :: IORef Int, From f8a60d9fcc938f4b0fd490119899e0f1f3367ad6 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 09:57:47 +0000 Subject: [PATCH 09/31] smp-server: wire real resolveName into processCommand Pass rslvCacheHits and rslvCacheMiss IORefs from ServerStats.rslvStats into NamesEnv at construction so the resolver's cache hit/miss counters share storage with the periodic stats exporter (no double bookkeeping). Replace the ERR-AUTH stub in processCommand with the real RSLV handler: increment rslvReqs, dispatch to resolveName when namesEnv is Just, map Right -> NAME / NotFound -> ERR AUTH / other Left -> ERR AUTH while bumping the respective counters. --- src/Simplex/Messaging/Server.hs | 13 ++++++-- src/Simplex/Messaging/Server/Env/STM.hs | 4 ++- .../Messaging/Server/Names/Resolver.hs | 31 ++++++++++++------- 3 files changed, 33 insertions(+), 15 deletions(-) diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 8a2e2d234..b7870f62a 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -108,7 +108,7 @@ 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 (closeNamesEnv) +import Simplex.Messaging.Server.Names (ResolveError (..), closeNamesEnv, resolveName) import Simplex.Messaging.Server.MsgStore.STM import Simplex.Messaging.Server.MsgStore.Types import Simplex.Messaging.Server.NtfStore @@ -1496,7 +1496,16 @@ client 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 SResolver (RSLV _) -> pure $ response (corrId, NoEntity, ERR AUTH) -- replaced in step 3 + Cmd SResolver (RSLV (LookupKey key)) -> do + st <- asks (rslvStats . serverStats) + incStat (rslvReqs st) + asks namesEnv >>= \case + Nothing -> incStat (rslvDisabled st) $> response (corrId, NoEntity, ERR AUTH) + Just nenv -> + liftIO (resolveName nenv key) >>= \case + Right rec -> incStat (rslvSucc st) $> response (corrId, NoEntity, NAME rec) + Left NotFound -> incStat (rslvNotFound st) $> response (corrId, NoEntity, ERR AUTH) + Left _ -> incStat (rslvEthErrs st) $> response (corrId, NoEntity, ERR AUTH) 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 diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs index 610248c2f..382c820c8 100644 --- a/src/Simplex/Messaging/Server/Env/STM.hs +++ b/src/Simplex/Messaging/Server/Env/STM.hs @@ -613,7 +613,9 @@ newEnv config@ServerConfig {allowSMPProxy, smpCredentials, httpCredentials, serv | allowSMPProxy && not (dangerousColocation nc) -> do logError "[NAMES] enable: on with [PROXY] is refused — RSLV cache misses can serialise other forwarded commands. Set allow_dangerous_colocation = on to override." exitFailure - | otherwise -> Just <$> newNamesEnv nc + | otherwise -> do + let rs = rslvStats serverStats + Just <$> newNamesEnv nc (rslvCacheHits rs) (rslvCacheMiss rs) pure Env { serverActive, diff --git a/src/Simplex/Messaging/Server/Names/Resolver.hs b/src/Simplex/Messaging/Server/Names/Resolver.hs index b1232d306..930286227 100644 --- a/src/Simplex/Messaging/Server/Names/Resolver.hs +++ b/src/Simplex/Messaging/Server/Names/Resolver.hs @@ -23,16 +23,15 @@ where import Control.Concurrent.STM import qualified Control.Exception as E import Data.ByteString.Char8 (ByteString) -import qualified Data.ByteString.Char8 as B import qualified Data.HashPSQ as PSQ -import Data.Int (Int64) +import Data.IORef (IORef) import Data.Text (Text) -import qualified Data.Text as T import Data.Word (Word64) import GHC.Clock (getMonotonicTimeNSec) import Simplex.Messaging.Protocol (NameOwner, NameRecord, unNameOwner) import Simplex.Messaging.Server.Names.Eth.RPC (EthRpcEnv, EthRpcError (..), RpcAuth (..), closeEthRpcEnv, ethCallReal, newEthRpcEnv) import Simplex.Messaging.Server.Names.Eth.SNRC (decodeGetRecord, encodeGetRecord, namehash) +import Simplex.Messaging.Util (atomicModifyIORef'_) import System.Timeout (timeout) -- | Public-namespace resolver configuration. @@ -78,22 +77,26 @@ data NamesEnv = NamesEnv ethCall :: EthCall, cache :: TVar CacheState, inflight :: TVar (PSQ.HashPSQ ByteString Word64 (TMVar (Either ResolveError NameRecord))), - rpcEnv :: Maybe EthRpcEnv -- Nothing for test stubs + rpcEnv :: Maybe EthRpcEnv, -- Nothing for test stubs + cacheHitsRef :: IORef Int, -- shared with ServerStats.rslvStats.rslvCacheHits + cacheMissRef :: IORef Int -- shared with ServerStats.rslvStats.rslvCacheMiss } -- | Allocate resolver with real HTTP transport. -newNamesEnv :: NamesConfig -> IO NamesEnv -newNamesEnv cfg = do +-- `cacheHitsRef` and `cacheMissRef` are shared with ServerStats.rslvStats so +-- the periodic CSV / Prometheus exporter sees per-request cache outcomes. +newNamesEnv :: NamesConfig -> IORef Int -> IORef Int -> IO NamesEnv +newNamesEnv cfg cacheHitsRef cacheMissRef = do rpc <- newEthRpcEnv (ethereumEndpoint cfg) (rpcAuth cfg) (rpcMaxResponseBytes cfg) (rpcMaxConcurrency cfg) let call to dat = ethCallReal rpc to dat - newNamesEnvWith cfg call (Just rpc) + newNamesEnvWith cfg call (Just rpc) cacheHitsRef cacheMissRef -- | Allocate resolver with an injected ethCall (test seam). -newNamesEnvWith :: NamesConfig -> EthCall -> Maybe EthRpcEnv -> IO NamesEnv -newNamesEnvWith config ethCall rpcEnv = do +newNamesEnvWith :: NamesConfig -> EthCall -> Maybe EthRpcEnv -> IORef Int -> IORef Int -> IO NamesEnv +newNamesEnvWith config ethCall rpcEnv cacheHitsRef cacheMissRef = do cache <- newTVarIO (PSQ.empty, 0) inflight <- newTVarIO PSQ.empty - pure NamesEnv {config, ethCall, cache, inflight, rpcEnv} + pure NamesEnv {config, ethCall, cache, inflight, rpcEnv, cacheHitsRef, cacheMissRef} closeNamesEnv :: NamesEnv -> IO () closeNamesEnv NamesEnv {rpcEnv} = maybe (pure ()) closeEthRpcEnv rpcEnv @@ -104,8 +107,12 @@ resolveName :: NamesEnv -> ByteString -> IO (Either ResolveError NameRecord) resolveName env key = do now <- getMonotonicTimeNSec cacheLookup env key now >>= \case - Just rec -> pure (Right rec) - Nothing -> coalesce env key now + Just rec -> do + atomicModifyIORef'_ (cacheHitsRef env) (+ 1) + pure (Right rec) + Nothing -> do + atomicModifyIORef'_ (cacheMissRef env) (+ 1) + coalesce env key now cacheLookup :: NamesEnv -> ByteString -> Word64 -> IO (Maybe NameRecord) cacheLookup NamesEnv {config, cache} key now = atomically $ do From 7299b73a124ed22e446c005cf25d25fa3c88fa21 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 10:40:03 +0000 Subject: [PATCH 10/31] smp-server: tests for Names resolver subtree (27 specs, all passing) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add tests/SMPNamesTests.hs covering the highest-risk surface: - NameRecord wire encoding round-trip, negative-expiry rejection, combined channel+contact list cap, max-payload size budget. - LookupKey 64-byte parser cap; mkNameOwner / mkNameLink length invariants; smart-constructor / accessor round-trip. - Keccak-256 reference vectors (empty, "abc"); assert Keccak ≠ SHA3-256; namehash of "" and "eth" matches ENS vectors; selector and encodeGetRecord byte layout. - ABI primitive bounds: each of decodeWord256Int64, decodeAddress, decodeString, decodeStringArray fails its relevant safety invariant without crashing. - decodeGetRecord: zero-owner returns Nothing, truncated buffer returns AbiTruncated. - Resolver: stub-backed resolveName routes zero-owner to NotFound, counts as a miss; concurrent identical lookups don't crash. Tests run via `cabal test --test-option=--match="Names resolver tests"` and complete in ~5ms. Defer to follow-up: ForwardedRslvSpec (PFWD round-trip), MockRpcSpec (fake HTTP server), AbiSpec fixture-based encoder, StartupGuardSpec, UrlValidationSpec, EipChecksumSpec — all of which need either a running server harness or pinned binary fixtures. Derive Eq for ResolveError so tests can `shouldBe` against constructors. --- simplexmq.cabal | 1 + .../Messaging/Server/Names/Resolver.hs | 2 +- tests/SMPNamesTests.hs | 266 ++++++++++++++++++ tests/Test.hs | 2 + 4 files changed, 270 insertions(+), 1 deletion(-) create mode 100644 tests/SMPNamesTests.hs diff --git a/simplexmq.cabal b/simplexmq.cabal index 04ced952a..15bad9c3e 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -516,6 +516,7 @@ test-suite simplexmq-test ServerTests SMPAgentClient SMPClient + SMPNamesTests SMPProxyTests Util XFTPAgent diff --git a/src/Simplex/Messaging/Server/Names/Resolver.hs b/src/Simplex/Messaging/Server/Names/Resolver.hs index 930286227..52be961f1 100644 --- a/src/Simplex/Messaging/Server/Names/Resolver.hs +++ b/src/Simplex/Messaging/Server/Names/Resolver.hs @@ -55,7 +55,7 @@ data ResolveError | EthRpcErr {rpcCode :: Int, rpcMessage :: Text} | EthDecodeErr | TimedOut - deriving (Show) + deriving (Eq, Show) -- | Test seam: a function from (to, data) -> raw return bytes or error. -- Production wires this to ethCallReal; tests substitute a stub. diff --git a/tests/SMPNamesTests.hs b/tests/SMPNamesTests.hs new file mode 100644 index 000000000..452474e23 --- /dev/null +++ b/tests/SMPNamesTests.hs @@ -0,0 +1,266 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module SMPNamesTests (smpNamesTests) where + +import Control.Concurrent.Async (replicateConcurrently) +import qualified Crypto.Hash as Crypton +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteArray as BA +import Data.Either (isLeft, isRight) +import Data.IORef (atomicModifyIORef', newIORef, readIORef) +import qualified Data.Text as T +import Simplex.Messaging.Encoding (smpEncode, smpP) +import Simplex.Messaging.Parsers (parseAll) +import Simplex.Messaging.Protocol + ( LookupKey (..), + NameRecord (..), + mkNameLink, + mkNameOwner, + nameRecBytes, + parseNameRec, + unNameLink, + unNameOwner, + ) +import Simplex.Messaging.Server.Names.Eth.SNRC + ( AbiError (..), + decodeAddress, + decodeGetRecord, + decodeString, + decodeStringArray, + decodeWord256Int64, + encodeGetRecord, + keccak256, + namehash, + snrcSelector, + ) +import Simplex.Messaging.Server.Names.Resolver + ( NamesConfig (..), + ResolveError (..), + newNamesEnvWith, + resolveName, + ) +import Simplex.Messaging.Transport (VersionSMP) +import Simplex.Messaging.Version.Internal (Version (..)) +import Test.Hspec + +-- Reference vectors: +-- keccak256("") = c5d2460186f7233c927e7db2dcc703c0e500b653ca8227b7bfad8045d85a470 +-- keccak256("abc") = 4e03657aea45a94fc7d47ba826c8d667c0d1e6e33a64a036ec44f58fa12d6c45 +-- sha3_256("abc") = 3a985da74fe225b2045c172d6bd390bd855f086e3e9d525b46bfe24511431532 +-- namehash("eth") = 93cdeb708b7545dc668eb9280176169d1c33cfd8ed6f04690a0bcc88a93fc4ae + +keccak256Empty :: ByteString +keccak256Empty = "\xc5\xd2\x46\x01\x86\xf7\x23\x3c\x92\x7e\x7d\xb2\xdc\xc7\x03\xc0\xe5\x00\xb6\x53\xca\x82\x27\x3b\x7b\xfa\xd8\x04\x5d\x85\xa4\x70" + +keccak256Abc :: ByteString +keccak256Abc = "\x4e\x03\x65\x7a\xea\x45\xa9\x4f\xc7\xd4\x7b\xa8\x26\xc8\xd6\x67\xc0\xd1\xe6\xe3\x3a\x64\xa0\x36\xec\x44\xf5\x8f\xa1\x2d\x6c\x45" + +sha3_256Abc :: ByteString +sha3_256Abc = "\x3a\x98\x5d\xa7\x4f\xe2\x25\xb2\x04\x5c\x17\x2d\x6b\xd3\x90\xbd\x85\x5f\x08\x6e\x3e\x9d\x52\x5b\x46\xbf\xe2\x45\x11\x43\x15\x32" + +namehashEth :: ByteString +namehashEth = "\x93\xcd\xeb\x70\x8b\x75\x45\xdc\x66\x8e\xb9\x28\x01\x76\x16\x9d\x1c\x33\xcf\xd8\xed\x6f\x04\x69\x0a\x0b\xcc\x88\xa9\x3f\xc4\xae" + +v20 :: VersionSMP +v20 = Version 20 + +twentyOnes :: ByteString +twentyOnes = B.replicate 20 '\x01' + +sampleRecord :: NameRecord +sampleRecord = case (mkNameOwner twentyOnes, mkNameLink "simplex:/contact/abc#xyz") of + (Right o, Right l) -> + NameRecord + { nrDisplayName = "Alice", + nrOwner = o, + nrChannelLinks = [], + nrContactLinks = [l], + nrAdminAddress = Just "simplex:/admin/...", + nrAdminEmail = Just "admin@example.org", + nrExpiry = 1735689600, + nrIsTest = False + } + _ -> error "sampleRecord smart ctors failed" + +smpNamesTests :: Spec +smpNamesTests = do + describe "NameRecord encoding (Protocol)" nameRecordEncodingSpec + describe "LookupKey + smart constructors" lookupKeyAndCtorsSpec + describe "Keccak-256 and namehash" namehashSpec + describe "ABI primitive bounds" abiBoundsSpec + describe "decodeGetRecord (zero-owner sentinel)" zeroOwnerSpec + describe "Resolver cache + coalescing" resolverCacheSpec + +nameRecordEncodingSpec :: Spec +nameRecordEncodingSpec = do + it "round-trips nameRecBytes / parseNameRec" $ do + let bytes = nameRecBytes v20 sampleRecord + parseAll (parseNameRec v20) bytes `shouldBe` Right sampleRecord + + it "rejects negative expiry" $ do + let badBytes = nameRecBytes v20 sampleRecord {nrExpiry = -1} + parseAll (parseNameRec v20) badBytes `shouldSatisfy` isLeft + + it "enforces combined channel+contact list cap of 8" $ do + let mkLink i = either error id (mkNameLink ("simplex:/contact/" <> T.pack (show (i :: Int)))) + nineLinks = map mkLink [0 .. 8] + overflow = sampleRecord {nrChannelLinks = nineLinks, nrContactLinks = []} + bytes = nameRecBytes v20 overflow + parseAll (parseNameRec v20) bytes `shouldSatisfy` isLeft + + it "encodes within the proxied transmission budget" $ do + let huge = either error id (mkNameLink (T.replicate 1024 "x")) + wide = + sampleRecord + { nrChannelLinks = replicate 4 huge, + nrContactLinks = replicate 4 huge, + nrDisplayName = T.replicate 255 "n", + nrAdminAddress = Just (T.replicate 255 "a"), + nrAdminEmail = Just (T.replicate 255 "e") + } + B.length (nameRecBytes v20 wide) < 16224 `shouldBe` True + +lookupKeyAndCtorsSpec :: Spec +lookupKeyAndCtorsSpec = do + it "LookupKey parser caps at 64 bytes" $ do + let okBytes = smpEncode (LookupKey (B.replicate 64 'a')) + bigBytes = smpEncode (LookupKey (B.replicate 65 'a')) + parseAll (smpP @LookupKey) okBytes `shouldSatisfy` isRight + parseAll (smpP @LookupKey) bigBytes `shouldSatisfy` isLeft + + it "mkNameOwner accepts exactly 20 bytes" $ do + mkNameOwner twentyOnes `shouldSatisfy` isRight + mkNameOwner (B.replicate 19 '\x01') `shouldSatisfy` isLeft + mkNameOwner (B.replicate 21 '\x01') `shouldSatisfy` isLeft + + it "mkNameLink rejects >1024 UTF-8 bytes" $ do + mkNameLink (T.replicate 1024 "x") `shouldSatisfy` isRight + mkNameLink (T.replicate 1025 "x") `shouldSatisfy` isLeft + -- multibyte UTF-8 counted in bytes, not chars: 600 × 3 = 1800 bytes + mkNameLink (T.replicate 600 "\x4e2d") `shouldSatisfy` isLeft + + it "unNameLink / unNameOwner round-trip the smart ctors" $ do + case (mkNameOwner twentyOnes, mkNameLink "abc") of + (Right o, Right l) -> do + unNameOwner o `shouldBe` twentyOnes + unNameLink l `shouldBe` "abc" + _ -> expectationFailure "smart ctors failed" + +namehashSpec :: Spec +namehashSpec = do + it "keccak256 of empty string matches reference vector" $ + keccak256 "" `shouldBe` keccak256Empty + + it "keccak256 of \"abc\" matches reference vector" $ + keccak256 "abc" `shouldBe` keccak256Abc + + it "Keccak-256 is NOT SHA3-256 (different output for same input)" $ do + let sha3 = BA.convert (Crypton.hash @ByteString @Crypton.SHA3_256 "abc") :: ByteString + sha3 `shouldBe` sha3_256Abc + keccak256 "abc" `shouldNotBe` sha3 + + it "namehash of empty name is 32 zero bytes" $ + namehash "" `shouldBe` B.replicate 32 '\NUL' + + it "namehash of \"eth\" matches ENS reference vector" $ + namehash "eth" `shouldBe` namehashEth + + it "snrcSelector is 4 bytes" $ + B.length snrcSelector `shouldBe` 4 + + it "encodeGetRecord = selector ++ 32-byte node" $ do + let node = namehash "alice.eth" + bytes = encodeGetRecord node + B.length bytes `shouldBe` 36 + B.take 4 bytes `shouldBe` snrcSelector + B.drop 4 bytes `shouldBe` node + +abiBoundsSpec :: Spec +abiBoundsSpec = do + let mkBuf n = B.replicate n '\NUL' + + it "decodeWord256Int64 fails when offset + 32 > buf length" $ + decodeWord256Int64 0 (mkBuf 31) `shouldBe` Left AbiTruncated + + it "decodeWord256Int64 rejects non-zero high 24 bytes (Int64 overflow)" $ do + let buf = B.replicate 23 '\NUL' <> B.singleton '\x01' <> B.replicate 8 '\NUL' + decodeWord256Int64 0 buf `shouldBe` Left AbiNonZeroHighBytes + + it "decodeWord256Int64 succeeds for low 8 bytes set" $ do + let buf = B.replicate 24 '\NUL' <> "\x00\x00\x00\x00\x00\x00\x12\x34" + decodeWord256Int64 0 buf `shouldBe` Right 0x1234 + + it "decodeAddress rejects non-zero high 12 bytes" $ do + let buf = B.replicate 11 '\NUL' <> B.singleton '\x01' <> B.replicate 20 '\NUL' + decodeAddress 0 buf `shouldSatisfy` isLeft + + it "decodeString fails on backward offset" $ + decodeString 100 50 1024 (mkBuf 200) `shouldBe` Left AbiBackwardOffset + + it "decodeString fails when declared length exceeds the per-field cap" $ do + let lenBytes = B.replicate 24 '\NUL' <> "\x00\x00\x00\x00\x00\x00\x00\x64" -- length 100 + buf = lenBytes <> B.replicate 100 'x' + decodeString 0 0 10 buf `shouldBe` Left AbiOversized + + it "decodeStringArray fails when depth ≥ 2" $ + decodeStringArray 2 0 0 8 1024 (mkBuf 64) `shouldBe` Left AbiDepthExceeded + + it "decodeStringArray fails when array count exceeds cap" $ do + let lenBytes = B.replicate 24 '\NUL' <> "\x00\x00\x00\x00\x00\x00\x00\x09" -- 9 elements + buf = lenBytes <> B.replicate 1024 '\NUL' + decodeStringArray 0 0 0 8 1024 buf `shouldBe` Left AbiOversized + +zeroOwnerSpec :: Spec +zeroOwnerSpec = do + it "decodeGetRecord returns Nothing for zero-owner buffer" $ do + -- 8 slots × 32 bytes; owner at slot 1 (offset 32) is all-zero by construction + let buf = B.replicate (32 * 8) '\NUL' + decodeGetRecord buf `shouldBe` Right Nothing + + it "decodeGetRecord fails on truncated buffer" $ do + let tiny = B.replicate 31 '\NUL' + decodeGetRecord tiny `shouldBe` Left AbiTruncated + +resolverCacheSpec :: Spec +resolverCacheSpec = do + let mkEnv ethCall = do + hitsRef <- newIORef 0 + missRef <- newIORef 0 + let cfg = + NamesConfig + { ethereumEndpoint = "http://stub", + snrcAddress = either error id (mkNameOwner twentyOnes), + rpcAuth = Nothing, + cacheSeconds = 300, + cacheMaxEntries = 100, + cacheMaxBytes = 1024 * 1024, + rpcTimeoutMs = 1000, + rpcMaxResponseBytes = 65536, + rpcMaxConcurrency = 4, + dangerousColocation = False + } + env <- newNamesEnvWith cfg ethCall Nothing hitsRef missRef + pure (env, hitsRef, missRef) + + it "maps stub zero-owner response to NotFound and counts as cache miss" $ do + (env, _, missRef) <- mkEnv $ \_ _ -> pure (Right (B.replicate (32 * 8) '\NUL')) + r <- resolveName env "alice" + r `shouldBe` Left NotFound + misses <- readIORef missRef + misses `shouldBe` 1 + + it "concurrent identical lookups don't crash and all return NotFound" $ do + callCount <- newIORef (0 :: Int) + (env, _, _) <- mkEnv $ \_ _ -> do + atomicModifyIORef' callCount (\v -> (v + 1, ())) + pure (Right (B.replicate (32 * 8) '\NUL')) + rs <- replicateConcurrently 8 (resolveName env "alice") + all (== Left NotFound) rs `shouldBe` True + -- NotFound is currently not cached, so each leader makes an RPC. + -- Once decodeGetRecord returns Just rec (post-SNRC), coalescing + -- means concurrent callers share one RPC and call count == 1. + n <- readIORef callCount + n `shouldSatisfy` (>= 1) diff --git a/tests/Test.hs b/tests/Test.hs index ae6df6e78..84718a9fc 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -22,6 +22,7 @@ import FileDescriptionTests (fileDescriptionTests) import GHC.IO.Exception (IOException (..)) import qualified GHC.IO.Exception as IOException import RemoteControl (remoteControlTests) +import SMPNamesTests (smpNamesTests) import SMPProxyTests (smpProxyTests) import ServerTests import Simplex.Messaging.Server.Env.STM (AStoreType (..)) @@ -97,6 +98,7 @@ main = do #endif describe "TSessionSubs tests" tSessionSubsTests describe "Util tests" utilTests + describe "Names resolver tests" smpNamesTests describe "Agent core tests" agentCoreTests #if defined(dbServerPostgres) around_ (postgressBracket testServerDBConnectInfo) $ From 44f617acf2e903e23e4b0fcdd4d9ab4caf098675 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 10:41:36 +0000 Subject: [PATCH 11/31] =?UTF-8?q?protocol:=20SMP=20v20=20=E2=80=94=20publi?= =?UTF-8?q?c-namespace=20resolver=20commands?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Bump SMP protocol version 19 -> 20 (header line, abstract, version history list). Add "Resolver commands" subsection to the SMP commands section with: - RSLV / NAME ABNF and byte layout for NameRecord (display name, owner, channel + contact links capped at 8 combined, optional admin contact, expiry, isTest). - Forwarded-only access via PFWD — direct RSLV rejected with CMD PROHIBITED. - Error semantics — every failure collapses to ERR AUTH; per-cause stats are out of band. - Note that the backing store is implementation-defined (the reference impl uses an Ethereum SNRC contract). Update "Router security requirements" to spell out the names-role outbound HTTP threat: the lookup key reaches the Ethereum endpoint, so operators MUST run their own endpoint and MUST NOT co-locate the names role with the SMP proxy role (RSLV cache miss can serialise other forwarded commands). --- protocol/simplex-messaging.md | 72 ++++++++++++++++++++++++++++++++++- 1 file changed, 70 insertions(+), 2 deletions(-) diff --git a/protocol/simplex-messaging.md b/protocol/simplex-messaging.md index f1d1f77ce..aa01974d8 100644 --- a/protocol/simplex-messaging.md +++ b/protocol/simplex-messaging.md @@ -1,4 +1,4 @@ -Version 19, 2025-01-24 +Version 20, 2026-05-25 # Simplex Messaging Protocol (SMP) @@ -67,6 +67,9 @@ Version 19, 2025-01-24 - [Queue deleted notification](#queue-deleted-notification) - [Error responses](#error-responses) - [OK response](#ok-response) + - [Resolver commands](#resolver-commands) + - [Resolve name command](#resolve-name-command) + - [Name record response](#name-record-response) - [Transport connection with the SMP router](#transport-connection-with-the-SMP-router) - [General transport protocol considerations](#general-transport-protocol-considerations) - [TLS transport encryption](#tls-transport-encryption) @@ -83,7 +86,7 @@ It's designed with the focus on communication security and integrity, under the It is designed as a low level protocol for other application protocols to solve the problem of secure and private message transmission, making [MITM attack][1] very difficult at any part of the message transmission system. -This document describes SMP protocol version 19. Versions 1-5 are discontinued. The version history: +This document describes SMP protocol version 20. Versions 1-5 are discontinued. The version history: - v1: binary protocol encoding - v2: message flags (used to control notifications) @@ -103,6 +106,7 @@ This document describes SMP protocol version 19. Versions 1-5 are discontinued. - v17: create notification credentials with NEW command - v18: support client notices in BLOCKED error - v19: service subscriptions to messages (SUBS, NSUBS, SOKS, ENDS, ALLS commands) +- v20: public namespaces resolver (RSLV command, NAME response) — forwarded-only via PFWD ## Introduction @@ -424,6 +428,8 @@ Simplex messaging router implementations MUST NOT create, store or send to any o - Any other information that may compromise privacy or [forward secrecy][4] of communication between clients using simplex messaging routers (the routers cannot compromise forward secrecy of any application layer protocol, such as double ratchet). +Routers with the names role make outbound JSON-RPC calls to an Ethereum endpoint to read `NameRecord` data; the lookup key reaches that endpoint. Operators MUST run the endpoint themselves (loopback Reth + Nimbus, or a self-hosted central deployment) — sharing one endpoint across multiple operators collapses the two-server privacy property because the endpoint operator would see every lookup key across all of them. The names role and the SMP-proxy role MUST NOT be enabled on the same router by default; a slow `RSLV` cache miss can serialise other forwarded commands on the same proxy-relay session. + ## Message delivery notifications Supporting message delivery while the client mobile app is not running requires sending push notifications with the device token. All alternative mechanisms for background message delivery are unreliable, particularly on iOS platform. @@ -1422,6 +1428,68 @@ When the command is successfully executed by the router, it should respond with ok = %s"OK" ``` +### Resolver commands + +Resolver commands implement public-namespace name resolution on the names-role +router. A names router translates an opaque lookup key (such as `alice` or +`alice.simplex.eth`) into a `NameRecord` carrying the channel and contact links +the named party publishes. + +**Forwarded-only.** RSLV is only valid when delivered inside a `PFWD` block via +the SMP proxy. A direct `RSLV` from a transport client is rejected with +`ERR CMD PROHIBITED`. This preserves the two-server privacy property of the +resolver design: the names router sees the lookup key but never the client IP, +session, or identity; the proxy router sees the client connection but cannot +read the encrypted lookup key inside the forwarded transmission. + +**Backing store.** This protocol does not prescribe where the names router +reads `NameRecord` from. The reference implementation queries the SNRC contract +on Ethereum via a JSON-RPC endpoint; alternative backings (different chains, +DHT, etc.) are valid as long as they return a `NameRecord` matching the encoding +below. + +#### Resolve name command + +```abnf +rslv = %s"RSLV" SP lookupKey +lookupKey = length *OCTET ; 1-byte length prefix, up to 64 bytes +``` + +Name-syntax validation (lowercase, namespace prefixes such as `#testnet:`, +length policy) is a client-side concern. The names router treats the lookup +key as opaque bytes. + +The names router responds with either a `NAME` response carrying the resolved +record, or `ERR AUTH` collapsing every failure mode (name not found, malformed +key, names role disabled, RPC unreachable, decode error, timeout). The wire +code does not distinguish between these — stats counters MAY be exposed +out-of-band for operator observability. + +#### Name record response + +```abnf +name = %s"NAME" SP nameRecord + +nameRecord = displayName owner channelLinks contactLinks adminAddr adminEmail expiry isTest +displayName = length *OCTET ; 1-byte length prefix, up to 255 bytes UTF-8 +owner = 20OCTET ; raw 20-byte Ethereum-style address +channelLinks = count *nameLink ; count is a 1-byte unsigned integer +contactLinks = count *nameLink ; combined count of channelLinks + contactLinks ≤ 8 +nameLink = length16 *OCTET ; 2-byte big-endian length, up to 1024 bytes UTF-8 +adminAddr = optionalText ; "0" absent or "1" + 1-byte length + UTF-8 up to 255 bytes +adminEmail = optionalText ; same encoding as adminAddr +expiry = 8OCTET ; Int64 big-endian, Unix seconds, MUST be ≥ 0 +isTest = "T" / "F" +``` + +The encoding is canonical: every primitive has exactly one valid byte form, so +two names routers reading the same backing state produce byte-identical +responses. + +**Wire-size budget.** A maximal `nameRecord` (8 links × 1024 bytes + maximal +admin / display strings) fits comfortably within the SMP proxied transmission +budget of 16224 bytes. + ## Transport connection with the SMP router ### General transport protocol considerations From 51d0a896884e042c2b9b903e9ed160ee52e841d1 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 10:43:29 +0000 Subject: [PATCH 12/31] release: bump to 6.6.0.0 + CHANGELOG entry SMP server gains public-namespace resolution (SMP protocol v20). The names role is disabled by default; configure [NAMES] to enable. --- CHANGELOG.md | 13 +++++++++++++ simplexmq.cabal | 2 +- 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 817cf7d3e..7a0e11ef9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,16 @@ +# 6.6.0 + +Version 6.6.0.0 + +SMP server: +- public-namespace resolver (SMP protocol v20): + - new `RSLV ` command and `NAME ` response, forwarded-only via PFWD + - reads name records from the Ethereum SNRC contract via a configurable JSON-RPC endpoint (Reth + Nimbus) + - in-memory cache with TTL, byte cap, FIFO eviction, and in-flight request coalescing + - new `[NAMES]` INI section; disabled by default + - new `simplex_smp_names_*` Prometheus metrics + CSV stats columns + - refuses to start with `[PROXY] enable: on` unless `allow_dangerous_colocation = on` + # 6.5.1 Version 6.5.1.0 diff --git a/simplexmq.cabal b/simplexmq.cabal index 15bad9c3e..5d0eaeb65 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -1,7 +1,7 @@ cabal-version: 1.12 name: simplexmq -version: 6.5.2.0 +version: 6.6.0.0 synopsis: SimpleXMQ message broker description: This package includes <./docs/Simplex-Messaging-Server.html server>, <./docs/Simplex-Messaging-Client.html client> and From f9269bea4336893ec4026022c266fa35faf57bb7 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 11:29:00 +0000 Subject: [PATCH 13/31] smp-server: demote names+proxy guard from refusal to warning MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The hard refusal in newEnv assumed allowSMPProxy was a real on/off flag, but it's hardcoded to True in Server/Main.hs:606 — there's no [PROXY] enable key. So every smp-server with [NAMES] enable: on would fail to start unless the operator also set allow_dangerous_colocation, which made that flag mandatory rather than an opt-in. Demote to a one-time startup warning. The performance footgun is real (slow RSLV cache miss can head-of-line-block other forwarded commands on the same proxy-relay session) but it's a soft problem the operator should be told about, not a hard refusal blocking trivial deployments. Tighten back to a refusal once [PROXY] gains a real enable toggle or forkForwardedCmd makes the head-of-line concern moot. --- plans/20260522_01_smp_public_namespaces.md | 2 +- src/Simplex/Messaging/Server/Env/STM.hs | 12 +++++------- src/Simplex/Messaging/Server/Main/Init.hs | 3 ++- 3 files changed, 8 insertions(+), 9 deletions(-) diff --git a/plans/20260522_01_smp_public_namespaces.md b/plans/20260522_01_smp_public_namespaces.md index a19763562..ffc613da6 100644 --- a/plans/20260522_01_smp_public_namespaces.md +++ b/plans/20260522_01_smp_public_namespaces.md @@ -177,7 +177,7 @@ In-flight `resolveName` calls during shutdown receive `ConnectionClosed` → `Et **`incStat` relocation.** Defined at `Server.hs:2220`, currently unexported. Move to `Server/Stats.hs` (one-line transplant + export) so `Resolver.hs` can use it. -**Co-located proxy refused.** `newEnv` aborts startup if both `allowSMPProxy = True` and `namesConfig = Just _`, unless `allow_dangerous_colocation = on`. RSLV is the first slow forwarded command; on a proxy host it can serialise other forwarded commands on the same proxy-relay session up to `rpcTimeoutMs` per cache miss. `forkForwardedCmd` async dispatch is the longer-term fix, tracked as a follow-up. +**Co-located proxy warning.** `newEnv` logs a startup warning if `allowSMPProxy = True` and `namesConfig = Just _`, unless `allow_dangerous_colocation = on`. RSLV is the first slow forwarded command; on a proxy host it can serialise other forwarded commands on the same proxy-relay session up to `rpcTimeoutMs` per cache miss. The warning is not a hard refusal because `[PROXY]` has no `enable: on/off` toggle — proxy is always on for every smp-server. `forkForwardedCmd` async dispatch is the longer-term fix, tracked as a follow-up; once the proxy role is gateable per-server, the warning can be tightened back to a refusal. ## Resolver subtree diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs index 382c820c8..e4932877b 100644 --- a/src/Simplex/Messaging/Server/Env/STM.hs +++ b/src/Simplex/Messaging/Server/Env/STM.hs @@ -609,13 +609,11 @@ newEnv config@ServerConfig {allowSMPProxy, smpCredentials, httpCredentials, serv proxyAgent <- newSMPProxyAgent smpAgentCfg random namesEnv <- case namesConfig of Nothing -> pure Nothing - Just nc - | allowSMPProxy && not (dangerousColocation nc) -> do - logError "[NAMES] enable: on with [PROXY] is refused — RSLV cache misses can serialise other forwarded commands. Set allow_dangerous_colocation = on to override." - exitFailure - | otherwise -> do - let rs = rslvStats serverStats - Just <$> newNamesEnv nc (rslvCacheHits rs) (rslvCacheMiss rs) + Just nc -> do + when (allowSMPProxy && not (dangerousColocation nc)) $ + logWarn "[NAMES] enable: on on a proxy-role host: slow RSLV cache misses can serialise other forwarded commands on the same proxy-relay session. For high-volume deployments, run [NAMES] on a separate host. Set allow_dangerous_colocation = on to silence this warning." + let rs = rslvStats serverStats + Just <$> newNamesEnv nc (rslvCacheHits rs) (rslvCacheMiss rs) pure Env { serverActive, diff --git a/src/Simplex/Messaging/Server/Main/Init.hs b/src/Simplex/Messaging/Server/Main/Init.hs index 1091bb261..c7094ff09 100644 --- a/src/Simplex/Messaging/Server/Main/Init.hs +++ b/src/Simplex/Messaging/Server/Main/Init.hs @@ -158,7 +158,8 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds = \[NAMES]\n\ \# Public-namespace resolution (SNRC on Ethereum).\n\ \# Requires an Ethereum JSON-RPC endpoint (Reth+Nimbus). See deployment guide.\n\ - \# Cannot be combined with [PROXY] enable: on by default - see allow_dangerous_colocation.\n\ + \# Co-locating with the proxy role logs a warning at startup - slow RSLV cache misses\n\ + \# can serialise other forwarded commands. Set allow_dangerous_colocation: on to silence.\n\ \# Restart required to change settings.\n\ \enable: off\n\ \# Same-host:\n\ From 7f94f49f4b58feaadfebb7ea415a6b9c68d7ba4f Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 11:34:14 +0000 Subject: [PATCH 14/31] smp-server: drop allow_dangerous_colocation flag MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The flag served no purpose once the hard refusal became a warning — operators couldn't change behaviour, only silence the message. Remove it from NamesConfig, INI parser, default template, plan, and tests. The warning now fires unconditionally for any [NAMES] enable: on deployment co-located with the proxy role (i.e. every smp-server, since proxy is always on). --- plans/20260522_01_smp_public_namespaces.md | 3 +-- src/Simplex/Messaging/Server/Env/STM.hs | 4 ++-- src/Simplex/Messaging/Server/Main.hs | 3 +-- src/Simplex/Messaging/Server/Main/Init.hs | 5 ++--- src/Simplex/Messaging/Server/Names/Resolver.hs | 3 +-- tests/SMPNamesTests.hs | 3 +-- 6 files changed, 8 insertions(+), 13 deletions(-) diff --git a/plans/20260522_01_smp_public_namespaces.md b/plans/20260522_01_smp_public_namespaces.md index ffc613da6..5f90e67fd 100644 --- a/plans/20260522_01_smp_public_namespaces.md +++ b/plans/20260522_01_smp_public_namespaces.md @@ -177,7 +177,7 @@ In-flight `resolveName` calls during shutdown receive `ConnectionClosed` → `Et **`incStat` relocation.** Defined at `Server.hs:2220`, currently unexported. Move to `Server/Stats.hs` (one-line transplant + export) so `Resolver.hs` can use it. -**Co-located proxy warning.** `newEnv` logs a startup warning if `allowSMPProxy = True` and `namesConfig = Just _`, unless `allow_dangerous_colocation = on`. RSLV is the first slow forwarded command; on a proxy host it can serialise other forwarded commands on the same proxy-relay session up to `rpcTimeoutMs` per cache miss. The warning is not a hard refusal because `[PROXY]` has no `enable: on/off` toggle — proxy is always on for every smp-server. `forkForwardedCmd` async dispatch is the longer-term fix, tracked as a follow-up; once the proxy role is gateable per-server, the warning can be tightened back to a refusal. +**Co-located proxy warning.** `newEnv` logs a startup warning whenever `allowSMPProxy = True` and `namesConfig = Just _`. RSLV is the first slow forwarded command; on a proxy host it can serialise other forwarded commands on the same proxy-relay session up to `rpcTimeoutMs` per cache miss. The warning is not a hard refusal because `[PROXY]` has no `enable: on/off` toggle — proxy is always on for every smp-server. `forkForwardedCmd` async dispatch is the longer-term fix, tracked as a follow-up; once the proxy role is gateable per-server, the warning can be tightened back to a refusal. ## Resolver subtree @@ -256,7 +256,6 @@ data NamesConfig = NamesConfig , rpcTimeoutMs :: Int -- 3000 , rpcMaxResponseBytes :: Int -- 262144 (256 KB) , rpcMaxConcurrency :: Int -- 8 - , dangerousColocation :: Bool -- override the §"Server changes" startup guard } data RpcAuth = AuthBearer Text | AuthBasic Text Text diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs index e4932877b..e001bd185 100644 --- a/src/Simplex/Messaging/Server/Env/STM.hs +++ b/src/Simplex/Messaging/Server/Env/STM.hs @@ -610,8 +610,8 @@ newEnv config@ServerConfig {allowSMPProxy, smpCredentials, httpCredentials, serv namesEnv <- case namesConfig of Nothing -> pure Nothing Just nc -> do - when (allowSMPProxy && not (dangerousColocation nc)) $ - logWarn "[NAMES] enable: on on a proxy-role host: slow RSLV cache misses can serialise other forwarded commands on the same proxy-relay session. For high-volume deployments, run [NAMES] on a separate host. Set allow_dangerous_colocation = on to silence this warning." + when allowSMPProxy $ + logWarn "[NAMES] enable: on on a proxy-role host: slow RSLV cache misses can serialise other forwarded commands on the same proxy-relay session. For high-volume deployments, run [NAMES] on a separate host." let rs = rslvStats serverStats Just <$> newNamesEnv nc (rslvCacheHits rs) (rslvCacheMiss rs) pure diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index edde8a78b..61a8603e7 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -814,8 +814,7 @@ readNamesConfig ini cacheMaxBytes = readIniDefault 67108864 "NAMES" "cache_max_bytes" ini, rpcTimeoutMs = readIniDefault 3000 "NAMES" "rpc_timeout_ms" ini, rpcMaxResponseBytes = readIniDefault 262144 "NAMES" "rpc_max_response_bytes" ini, - rpcMaxConcurrency = readIniDefault 8 "NAMES" "rpc_max_concurrency" ini, - dangerousColocation = fromMaybe False (iniOnOff "NAMES" "allow_dangerous_colocation" ini) + rpcMaxConcurrency = readIniDefault 8 "NAMES" "rpc_max_concurrency" ini } where enabled = fromMaybe False (iniOnOff "NAMES" "enable" ini) diff --git a/src/Simplex/Messaging/Server/Main/Init.hs b/src/Simplex/Messaging/Server/Main/Init.hs index c7094ff09..3dab6e721 100644 --- a/src/Simplex/Messaging/Server/Main/Init.hs +++ b/src/Simplex/Messaging/Server/Main/Init.hs @@ -159,7 +159,7 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds = \# Public-namespace resolution (SNRC on Ethereum).\n\ \# Requires an Ethereum JSON-RPC endpoint (Reth+Nimbus). See deployment guide.\n\ \# Co-locating with the proxy role logs a warning at startup - slow RSLV cache misses\n\ - \# can serialise other forwarded commands. Set allow_dangerous_colocation: on to silence.\n\ + \# can serialise other forwarded commands. For high-volume deployments, run on a separate host.\n\ \# Restart required to change settings.\n\ \enable: off\n\ \# Same-host:\n\ @@ -173,8 +173,7 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds = \# cache_max_bytes: 67108864\n\ \# rpc_timeout_ms: 3000\n\ \# rpc_max_response_bytes: 262144\n\ - \# rpc_max_concurrency: 8\n\ - \# allow_dangerous_colocation: off\n\n\ + \# rpc_max_concurrency: 8\n\n\ \[INACTIVE_CLIENTS]\n\ \# TTL and interval to check inactive clients\n\ \disconnect = on\n" diff --git a/src/Simplex/Messaging/Server/Names/Resolver.hs b/src/Simplex/Messaging/Server/Names/Resolver.hs index 52be961f1..ba90e36d5 100644 --- a/src/Simplex/Messaging/Server/Names/Resolver.hs +++ b/src/Simplex/Messaging/Server/Names/Resolver.hs @@ -44,8 +44,7 @@ data NamesConfig = NamesConfig cacheMaxBytes :: Int, rpcTimeoutMs :: Int, rpcMaxResponseBytes :: Int, - rpcMaxConcurrency :: Int, - dangerousColocation :: Bool + rpcMaxConcurrency :: Int } deriving (Show) diff --git a/tests/SMPNamesTests.hs b/tests/SMPNamesTests.hs index 452474e23..56977a5cb 100644 --- a/tests/SMPNamesTests.hs +++ b/tests/SMPNamesTests.hs @@ -239,8 +239,7 @@ resolverCacheSpec = do cacheMaxBytes = 1024 * 1024, rpcTimeoutMs = 1000, rpcMaxResponseBytes = 65536, - rpcMaxConcurrency = 4, - dangerousColocation = False + rpcMaxConcurrency = 4 } env <- newNamesEnvWith cfg ethCall Nothing hitsRef missRef pure (env, hitsRef, missRef) From 416504195757ef65562486b957987bcc3b83ab20 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 14:08:00 +0000 Subject: [PATCH 15/31] smp-server: implement UTF-8 validation for ABI strings decodeString returns raw bytes; the module header invariant 8 promised UTF-8 validation via decodeUtf8' returning AbiBadUtf8, which was never implemented. Add decodeUtf8Text :: ... -> Either AbiError Text that composes decodeString + decodeUtf8' and returns AbiBadUtf8 on invalid input. This will be used by the eventual NameRecord decoder for displayName / link / admin fields; AbiBadUtf8 becomes a real return path instead of a phantom constructor. --- src/Simplex/Messaging/Server/Names/Eth/SNRC.hs | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/src/Simplex/Messaging/Server/Names/Eth/SNRC.hs b/src/Simplex/Messaging/Server/Names/Eth/SNRC.hs index c645b8ebe..b14f2bc4d 100644 --- a/src/Simplex/Messaging/Server/Names/Eth/SNRC.hs +++ b/src/Simplex/Messaging/Server/Names/Eth/SNRC.hs @@ -33,6 +33,7 @@ module Simplex.Messaging.Server.Names.Eth.SNRC decodeWord256Int64, decodeAddress, decodeString, + decodeUtf8Text, decodeStringArray, ) where @@ -42,6 +43,8 @@ import qualified Data.ByteArray as BA import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import Data.Int (Int64) +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8') import Simplex.Messaging.Protocol (NameOwner, NameRecord, mkNameOwner, unNameOwner) -- | ABI-decode failure modes (caller collapses to ResolveError EthDecodeErr). @@ -109,6 +112,8 @@ decodeAddress off buf Left e -> Left (AbiInvariantViolated e) -- | Decode a Solidity `string` whose data starts at byte offset `off`. +-- Returns raw bytes; UTF-8 validity is the caller's choice (use +-- `decodeUtf8Text` if a Text is required). decodeString :: Int -> Int -> Int -> ByteString -> Either AbiError ByteString decodeString headEnd off cap buf | off < headEnd = Left AbiBackwardOffset @@ -123,6 +128,13 @@ decodeString headEnd off cap buf then Left AbiTruncated else Right $ B.take len (B.drop (off + 32) buf) +-- | Decode a Solidity `string` as Text, failing with AbiBadUtf8 on +-- invalid UTF-8. This is what NameRecord decoder composition will use. +decodeUtf8Text :: Int -> Int -> Int -> ByteString -> Either AbiError Text +decodeUtf8Text headEnd off cap buf = do + raw <- decodeString headEnd off cap buf + either (const (Left AbiBadUtf8)) Right (decodeUtf8' raw) + -- | Decode a Solidity `string[]` at byte offset `off`. Each element capped -- at `byteCap` bytes, total element count capped at `cntCap`. Depth must be -- < 2 (recurses one level into decodeString). From cc487d1aed82ad81b310a614607e20739360df06 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 14:08:35 +0000 Subject: [PATCH 16/31] smp-server: propagate async exceptions through coalescing leader The previous leader-side catch used E.catch on SomeException, which silently converted AsyncCancelled / ThreadKilled into a normal Left EthHttpErr result and let the leader thread continue running. Supervisors that try to cancel an outstanding eth_call (server shutdown, client disconnect) had no way to actually abort the lookup. Rewrite the leader path with E.try + SomeAsyncException detection: on async exception, fill the leader's TMVar with EthHttpErr so waiters unblock, remove the inflight entry to drop the cache pollution, then rethrow so the supervisor sees cancellation actually take effect. Synchronous exceptions still collapse to EthHttpErr as before. --- .../Messaging/Server/Names/Resolver.hs | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/src/Simplex/Messaging/Server/Names/Resolver.hs b/src/Simplex/Messaging/Server/Names/Resolver.hs index ba90e36d5..cf13a4e3b 100644 --- a/src/Simplex/Messaging/Server/Names/Resolver.hs +++ b/src/Simplex/Messaging/Server/Names/Resolver.hs @@ -143,9 +143,20 @@ coalesce env@NamesEnv {inflight} key now = do case ticket of Right mv -> atomically (readTMVar mv) -- waiter Left mv -> E.mask $ \restore -> do + -- Run the fetch with sync-only catching: async exceptions (cancel, + -- killThread) must propagate after we've completed the STM cleanup + -- so waiters never block on an orphan TMVar. r <- - restore (fetchOnceTimed env key) - `E.catch` \(e :: E.SomeException) -> pure (Left (mapEthExn e)) + E.try (restore (fetchOnceTimed env key)) >>= \case + Right ok -> pure ok + Left e + | Just (_ :: E.SomeAsyncException) <- E.fromException e -> do + -- Tell waiters the lookup failed, then rethrow. + atomically $ do + putTMVar mv (Left EthHttpErr) + modifyTVar' inflight (PSQ.delete key) + E.throwIO e + | otherwise -> pure (Left (mapSyncEthExn e)) atomically $ do putTMVar mv r modifyTVar' inflight (PSQ.delete key) @@ -154,8 +165,8 @@ coalesce env@NamesEnv {inflight} key now = do Left _ -> pure () pure r -mapEthExn :: E.SomeException -> ResolveError -mapEthExn _ = EthHttpErr +mapSyncEthExn :: E.SomeException -> ResolveError +mapSyncEthExn _ = EthHttpErr fetchOnceTimed :: NamesEnv -> ByteString -> IO (Either ResolveError NameRecord) fetchOnceTimed env key = From 1a5c4d702b5f98bb5239886574e3e6456ce0b40e Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 14:09:16 +0000 Subject: [PATCH 17/31] =?UTF-8?q?smp-server:=20real=20estimateBytes=20?= =?UTF-8?q?=E2=80=94=20derive=20size=20from=20record=20content?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The constant 4096 made cacheMaxBytes effectively a 16384-entry count cap under defaults, regardless of actual content size. A maximal NameRecord (8 × 1024-byte links + texts) is ~17 KB real memory, so operators who set cacheMaxBytes = 64 MB could see ~280 MB actual usage. Sum the encoded byte lengths of the variable-length fields (displayName, links, admin contact/email) plus a 256-byte fixed overhead for the wrapper (PSQ node + ByteString headers + key copy). Tight enough that cacheMaxBytes becomes a meaningful upper bound; still cheap to compute on insert. --- .../Messaging/Server/Names/Resolver.hs | 24 +++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/src/Simplex/Messaging/Server/Names/Resolver.hs b/src/Simplex/Messaging/Server/Names/Resolver.hs index cf13a4e3b..32f35f415 100644 --- a/src/Simplex/Messaging/Server/Names/Resolver.hs +++ b/src/Simplex/Messaging/Server/Names/Resolver.hs @@ -28,7 +28,9 @@ import Data.IORef (IORef) import Data.Text (Text) import Data.Word (Word64) import GHC.Clock (getMonotonicTimeNSec) -import Simplex.Messaging.Protocol (NameOwner, NameRecord, unNameOwner) +import qualified Data.ByteString.Char8 as B +import qualified Data.Text.Encoding as T +import Simplex.Messaging.Protocol (NameLink, NameOwner, NameRecord (..), unNameLink, unNameOwner) import Simplex.Messaging.Server.Names.Eth.RPC (EthRpcEnv, EthRpcError (..), RpcAuth (..), closeEthRpcEnv, ethCallReal, newEthRpcEnv) import Simplex.Messaging.Server.Names.Eth.SNRC (decodeGetRecord, encodeGetRecord, namehash) import Simplex.Messaging.Util (atomicModifyIORef'_) @@ -204,7 +206,21 @@ cacheInsert NamesEnv {config, cache} key now rec = atomically $ do ce = CacheEntry {ceRecord = rec, ceBytes = entryBytes} writeTVar cache (PSQ.insert key now ce psq', totalBytes' + entryBytes) --- | Approximate byte cost of a cached NameRecord (overhead + content). --- Tight enough that cacheMaxBytes bounds real memory; not byte-exact. +-- | Approximate byte cost of a cached NameRecord. Counts the user-controlled +-- variable-length content plus a fixed per-entry overhead for the wrapper +-- (TVar/PSQ node + ByteString headers + IORef). Tighter than a constant upper +-- bound so cacheMaxBytes is a meaningful cap. estimateBytes :: NameRecord -> Int -estimateBytes _ = 4096 -- conservative upper bound per NameRecord +estimateBytes NameRecord {nrDisplayName, nrChannelLinks, nrContactLinks, nrAdminAddress, nrAdminEmail} = + perEntryOverhead + + utf8Len nrDisplayName + + 20 -- nrOwner + + sum (map nameLinkBytes nrChannelLinks) + + sum (map nameLinkBytes nrContactLinks) + + maybe 0 utf8Len nrAdminAddress + + maybe 0 utf8Len nrAdminEmail + where + perEntryOverhead = 256 -- PSQ node + key copy + ByteString headers + utf8Len = B.length . T.encodeUtf8 + nameLinkBytes :: NameLink -> Int + nameLinkBytes = utf8Len . unNameLink From fdeb322aae362066fe5997097433cb978d93213b Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 14:10:33 +0000 Subject: [PATCH 18/31] smp-server: drop unLookupKey, log scrubbed endpoint at startup MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two pieces of dead code from the public-names branch: - unLookupKey was exported but had zero callers; destructure via the constructor (RSLV (LookupKey key)) where needed. Delete. - scrubUrl was exported but had zero callers; useful enough to wire in rather than delete. Add a logInfo line at newEnv when [NAMES] enable is on, showing the configured endpoint with userinfo stripped — so operators get auditable visibility without leaking basic-auth credentials into logs. --- src/Simplex/Messaging/Protocol.hs | 5 ----- src/Simplex/Messaging/Server/Env/STM.hs | 2 ++ 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index e1f8f54d1..3a5f88903 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -164,7 +164,6 @@ module Simplex.Messaging.Protocol FwdResponse (..), FwdTransmission (..), LookupKey (..), - unLookupKey, NameRecord (..), NameOwner, mkNameOwner, @@ -573,10 +572,6 @@ type QueueId = EntityId newtype LookupKey = LookupKey ByteString deriving (Eq, Show) -unLookupKey :: LookupKey -> ByteString -unLookupKey (LookupKey s) = s -{-# INLINE unLookupKey #-} - instance Encoding LookupKey where smpEncode (LookupKey s) = smpEncode s smpP = do diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs index e001bd185..401acf51a 100644 --- a/src/Simplex/Messaging/Server/Env/STM.hs +++ b/src/Simplex/Messaging/Server/Env/STM.hs @@ -116,6 +116,7 @@ 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, closeNamesEnv, newNamesEnv) +import Simplex.Messaging.Server.Names.Eth.RPC (scrubUrl) import Simplex.Messaging.Server.NtfStore import Simplex.Messaging.Server.QueueStore import Simplex.Messaging.Server.QueueStore.Postgres.Config @@ -610,6 +611,7 @@ newEnv config@ServerConfig {allowSMPProxy, smpCredentials, httpCredentials, serv namesEnv <- case namesConfig of Nothing -> pure Nothing Just nc -> do + logInfo $ "[NAMES] resolver enabled, endpoint=" <> scrubUrl (ethereumEndpoint nc) when allowSMPProxy $ logWarn "[NAMES] enable: on on a proxy-role host: slow RSLV cache misses can serialise other forwarded commands on the same proxy-relay session. For high-volume deployments, run [NAMES] on a separate host." let rs = rslvStats serverStats From 8a678d802a13ba5fd6bb6390178730cc1b58496e Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 14:17:04 +0000 Subject: [PATCH 19/31] =?UTF-8?q?smp-server:=20consolidate=20hex=20decoder?= =?UTF-8?q?=20=E2=80=94=20drop=20duplicate=20partial=20impl?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Server/Main.hs:hexDecode and Names/Eth/RPC.hs:decodeHex were byte-for-byte identical, plus Main's version was partial-by-contract (caller had to pre-validate length; B.index s 1 crashes on odd input). Export the validating fromHex from Eth/RPC, rewrite parseEthAddr to use it, drop the local hexDecode and the now-redundant isHex predicate. Also clean up trailing imports unused after earlier refactors: - Env/STM.hs no longer needs closeNamesEnv (used only in Server.hs) - Main.hs no longer needs Control.Applicative.<|> (parseEthAddr was the only consumer) - Resolver.hs fetchOnce never used the as-pattern env binding --- src/Simplex/Messaging/Server/Env/STM.hs | 2 +- src/Simplex/Messaging/Server/Main.hs | 31 +++++-------------- src/Simplex/Messaging/Server/Names/Eth/RPC.hs | 1 + .../Messaging/Server/Names/Resolver.hs | 2 +- 4 files changed, 10 insertions(+), 26 deletions(-) diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs index 401acf51a..063c1b1c3 100644 --- a/src/Simplex/Messaging/Server/Env/STM.hs +++ b/src/Simplex/Messaging/Server/Env/STM.hs @@ -115,7 +115,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, closeNamesEnv, newNamesEnv) +import Simplex.Messaging.Server.Names (NamesConfig (..), NamesEnv, newNamesEnv) import Simplex.Messaging.Server.Names.Eth.RPC (scrubUrl) import Simplex.Messaging.Server.NtfStore import Simplex.Messaging.Server.QueueStore diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index 61a8603e7..3735d441b 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -39,7 +39,6 @@ module Simplex.Messaging.Server.Main strParse, ) where -import Control.Applicative ((<|>)) import Control.Concurrent.STM import Control.Exception (finally) import Control.Logger.Simple @@ -79,6 +78,7 @@ import Simplex.Messaging.Server.MsgStore.Journal (JournalMsgStore (..), QStoreCf import Simplex.Messaging.Server.MsgStore.Types (MsgStoreClass (..), SQSType (..), SMSType (..), newMsgStore) import Simplex.Messaging.Protocol (mkNameOwner, NameOwner) import Simplex.Messaging.Server.Names (NamesConfig (..), RpcAuth (..)) +import Simplex.Messaging.Server.Names.Eth.RPC (fromHex) import Simplex.Messaging.Server.QueueStore.Postgres.Config import Simplex.Messaging.Server.StoreLog.ReadWrite (readQueueStore) import Simplex.Messaging.Transport (supportedProxyClientSMPRelayVRange, alpnSupportedSMPHandshakes, supportedServerSMPRelayVRange) @@ -823,30 +823,13 @@ readNamesConfig ini lookupValue "NAMES" key ini -- | Parse a 20-byte Ethereum address as text "0x[hex40]" or "[hex40]". --- Step 4 minimal validation; EIP-55 checksum check lands in step 5. +-- EIP-55 mixed-case checksum verification is a follow-up. parseEthAddr :: Text -> Either String NameOwner -parseEthAddr t = - let s = case T.stripPrefix "0x" t <|> T.stripPrefix "0X" t of - Just rest -> rest - Nothing -> t - in if T.length s == 40 && T.all isHex s - then mkNameOwner (hexDecode (encodeUtf8 s)) - else Left "expected 0x-prefixed 40 hex characters" - where - isHex c = (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F') - --- | Decode a hex string of even length. Precondition: input is already --- validated as even-length and all-hex (validated by caller). -hexDecode :: ByteString -> ByteString -hexDecode = B.pack . go - where - go s - | B.null s = [] - | otherwise = toEnum (16 * digit (B.head s) + digit (B.index s 1)) : go (B.drop 2 s) - digit c - | c >= '0' && c <= '9' = fromEnum c - fromEnum '0' - | c >= 'a' && c <= 'f' = 10 + fromEnum c - fromEnum 'a' - | otherwise = 10 + fromEnum c - fromEnum 'A' +parseEthAddr t = do + bs <- fromHex (encodeUtf8 t) + if B.length bs == 20 + then mkNameOwner bs + else Left "expected a 20-byte address (40 hex characters, optionally 0x-prefixed)" parseRpcAuth :: Text -> Either String RpcAuth parseRpcAuth t = case T.words t of diff --git a/src/Simplex/Messaging/Server/Names/Eth/RPC.hs b/src/Simplex/Messaging/Server/Names/Eth/RPC.hs index f89127343..f7d1a0649 100644 --- a/src/Simplex/Messaging/Server/Names/Eth/RPC.hs +++ b/src/Simplex/Messaging/Server/Names/Eth/RPC.hs @@ -20,6 +20,7 @@ module Simplex.Messaging.Server.Names.Eth.RPC newEthRpcEnv, closeEthRpcEnv, ethCallReal, + fromHex, scrubUrl, ) where diff --git a/src/Simplex/Messaging/Server/Names/Resolver.hs b/src/Simplex/Messaging/Server/Names/Resolver.hs index 32f35f415..ebf6017bd 100644 --- a/src/Simplex/Messaging/Server/Names/Resolver.hs +++ b/src/Simplex/Messaging/Server/Names/Resolver.hs @@ -177,7 +177,7 @@ fetchOnceTimed env key = Nothing -> pure (Left TimedOut) fetchOnce :: NamesEnv -> ByteString -> IO (Either ResolveError NameRecord) -fetchOnce env@NamesEnv {ethCall, config} key = do +fetchOnce NamesEnv {ethCall, config} key = do let node = namehash key callData = encodeGetRecord node to = unNameOwner (snrcAddress config) From 39e4b28516dd0609b3e778b1b6e35d22e085cafb Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 14:18:40 +0000 Subject: [PATCH 20/31] smp-server: validate ethereum_endpoint URL per the design plan MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The plan promised a URL validator for [NAMES] ethereum_endpoint that rejects userinfo, query, fragment, requires an explicit port, and only permits http/https schemes. Was not implemented — the previous code passed the raw string straight to http-client's parseRequest, which accepts userinfo (silently honoured: credentials leak via Host header and logs). Add validateUrl using network-uri's parseAbsoluteURI. Reject: - non-http(s) schemes - empty host - userinfo (use rpc_auth instead — separate concern, separate parsing, no header-injection surface) - missing explicit port (a config like "http://localhost" silently defaults to :80 when Reth listens on :8545 — that's a likely-typo) - query string - URL fragment Also reject https://non-loopback without rpc_auth — almost always a misconfiguration. Loopback exempt so http://127.0.0.1:8545 without auth remains the recommended same-host topology. Surfaces validation failures at startup as fail-fast error with the specific reason ("[NAMES] ethereum_endpoint: ..."), rather than the silent SSRF/credential-leak hazard before. --- src/Simplex/Messaging/Server/Main.hs | 55 ++++++++++++++++++++++------ 1 file changed, 43 insertions(+), 12 deletions(-) diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index 3735d441b..2d80c0d1d 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -76,6 +76,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 Network.URI (URI (..), URIAuth (..), parseAbsoluteURI) import Simplex.Messaging.Protocol (mkNameOwner, NameOwner) import Simplex.Messaging.Server.Names (NamesConfig (..), RpcAuth (..)) import Simplex.Messaging.Server.Names.Eth.RPC (fromHex) @@ -804,24 +805,54 @@ readNamesConfig :: Ini -> Maybe NamesConfig readNamesConfig ini | not enabled = Nothing | otherwise = - Just - NamesConfig - { ethereumEndpoint = requiredText "ethereum_endpoint", - snrcAddress = either (error . ("[NAMES] snrc_address: " <>)) id $ parseEthAddr (requiredText "snrc_address"), - rpcAuth = either (error . ("[NAMES] rpc_auth: " <>)) Just . parseRpcAuth =<< eitherToMaybe (lookupValue "NAMES" "rpc_auth" ini), - cacheSeconds = readIniDefault 300 "NAMES" "cache_seconds" ini, - cacheMaxEntries = readIniDefault 100000 "NAMES" "cache_max_entries" ini, - cacheMaxBytes = readIniDefault 67108864 "NAMES" "cache_max_bytes" ini, - rpcTimeoutMs = readIniDefault 3000 "NAMES" "rpc_timeout_ms" ini, - rpcMaxResponseBytes = readIniDefault 262144 "NAMES" "rpc_max_response_bytes" ini, - rpcMaxConcurrency = readIniDefault 8 "NAMES" "rpc_max_concurrency" ini - } + let rpcAuth_ = either (error . ("[NAMES] rpc_auth: " <>)) Just . parseRpcAuth =<< eitherToMaybe (lookupValue "NAMES" "rpc_auth" ini) + endpoint = requiredText "ethereum_endpoint" + in Just + NamesConfig + { ethereumEndpoint = either (error . ("[NAMES] ethereum_endpoint: " <>)) id (validateUrl endpoint rpcAuth_), + snrcAddress = either (error . ("[NAMES] snrc_address: " <>)) id $ parseEthAddr (requiredText "snrc_address"), + rpcAuth = rpcAuth_, + cacheSeconds = readIniDefault 300 "NAMES" "cache_seconds" ini, + cacheMaxEntries = readIniDefault 100000 "NAMES" "cache_max_entries" ini, + cacheMaxBytes = readIniDefault 67108864 "NAMES" "cache_max_bytes" ini, + rpcTimeoutMs = readIniDefault 3000 "NAMES" "rpc_timeout_ms" ini, + rpcMaxResponseBytes = readIniDefault 262144 "NAMES" "rpc_max_response_bytes" ini, + rpcMaxConcurrency = readIniDefault 8 "NAMES" "rpc_max_concurrency" ini + } where enabled = fromMaybe False (iniOnOff "NAMES" "enable" ini) requiredText key = either (error . (("[NAMES] " <> T.unpack key <> " is required: ") <>)) id $ lookupValue "NAMES" key ini +-- | Validate the ethereum_endpoint URL: +-- * scheme must be http: or https: +-- * authority (host) must be present and non-empty +-- * port MUST be explicit (rejects http://host without :8545 to avoid +-- accidentally hitting :80 when Reth listens on :8545) +-- * userinfo (user:pass@) MUST NOT be present (credentials belong in +-- rpc_auth so they don't leak via Host header or logs) +-- * query and fragment MUST NOT be present +-- * https requires rpc_auth on non-loopback hosts (operator misconfig +-- guard — a public HTTPS endpoint without auth is almost always wrong) +validateUrl :: Text -> Maybe RpcAuth -> Either String Text +validateUrl url auth_ = do + uri <- maybe (Left "not an absolute URI") Right $ parseAbsoluteURI (T.unpack url) + let scheme = uriScheme uri + unless (scheme == "http:" || scheme == "https:") $ + Left ("scheme " <> show scheme <> " not supported (use http or https)") + ua <- maybe (Left "missing authority (host)") Right (uriAuthority uri) + when (null (uriRegName ua)) $ Left "empty host" + unless (null (uriUserInfo ua)) $ Left "userinfo (user:pass@) not allowed; use rpc_auth instead" + when (null (uriPort ua)) $ Left "explicit port required (e.g. http://host:8545)" + unless (null (uriQuery uri)) $ Left "query string not allowed" + unless (null (uriFragment uri)) $ Left "fragment not allowed" + when (scheme == "https:" && not (isLoopback (uriRegName ua)) && isNothing auth_) $ + Left "https endpoint on a non-loopback host requires rpc_auth" + Right url + where + isLoopback h = h == "127.0.0.1" || h == "localhost" || h == "[::1]" + -- | Parse a 20-byte Ethereum address as text "0x[hex40]" or "[hex40]". -- EIP-55 mixed-case checksum verification is a follow-up. parseEthAddr :: Text -> Either String NameOwner From 61399e060d371d873062f64aaa360615a284fad5 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 14:20:06 +0000 Subject: [PATCH 21/31] smp-server: strengthen coalescing test to assert n == 1 MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Previous test stubbed ethCall as a fast non-blocking function and asserted callCount >= 1 — which a broken impl that fires one ethCall per caller also satisfies. The test passed against any implementation. Block the stub on a TMVar gate so the leader's eth_call cannot return before the 7 waiters race to register at the inflight TMap. Fire 8 concurrent resolveName calls in a background async, sleep 50 ms to let the waiters attach, then release the gate. Assert callCount == 1 — only the leader hit the RPC. Now the test genuinely fails if coalescing breaks. --- tests/SMPNamesTests.hs | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/tests/SMPNamesTests.hs b/tests/SMPNamesTests.hs index 56977a5cb..1d8ecc9ee 100644 --- a/tests/SMPNamesTests.hs +++ b/tests/SMPNamesTests.hs @@ -4,7 +4,9 @@ module SMPNamesTests (smpNamesTests) where -import Control.Concurrent.Async (replicateConcurrently) +import Control.Concurrent (threadDelay) +import Control.Concurrent.Async (async, replicateConcurrently, wait) +import Control.Concurrent.STM (atomically, newEmptyTMVarIO, putTMVar, readTMVar) import qualified Crypto.Hash as Crypton import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B @@ -251,15 +253,23 @@ resolverCacheSpec = do misses <- readIORef missRef misses `shouldBe` 1 - it "concurrent identical lookups don't crash and all return NotFound" $ do + it "concurrent identical lookups coalesce — only the leader makes the RPC" $ do + -- Block the stub on a TMVar so the leader's eth_call doesn't return + -- before the 7 waiters race to attach to the inflight TMap. Without + -- coalescing, every caller would invoke ethCall and callCount would + -- be 8; with coalescing, only the leader fires. + gate <- newEmptyTMVarIO callCount <- newIORef (0 :: Int) (env, _, _) <- mkEnv $ \_ _ -> do atomicModifyIORef' callCount (\v -> (v + 1, ())) + atomically (readTMVar gate) pure (Right (B.replicate (32 * 8) '\NUL')) - rs <- replicateConcurrently 8 (resolveName env "alice") + -- Run the 8 callers in a background task so we can release the gate + -- only after they've all had a chance to register on the inflight map. + callers <- async $ replicateConcurrently 8 (resolveName env "alice") + threadDelay 50000 -- 50 ms — ample time for the 7 waiters to attach + atomically (putTMVar gate ()) + rs <- wait callers all (== Left NotFound) rs `shouldBe` True - -- NotFound is currently not cached, so each leader makes an RPC. - -- Once decodeGetRecord returns Just rec (post-SNRC), coalescing - -- means concurrent callers share one RPC and call count == 1. n <- readIORef callCount - n `shouldSatisfy` (>= 1) + n `shouldBe` 1 From 3691dc63f62637fdf5e00d7eb66cdda09eec5ddb Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 15:16:06 +0000 Subject: [PATCH 22/31] smp-server: reject uint256 with sign bit set in low 8 bytes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit decodeWord256Int64 rejected values with any non-zero byte in the high 24 bytes, but accepted values 2^63 .. 2^64-1 in the low 8 bytes — those silently decode to *negative* Int64 because the Int64 type is signed. Downstream length math (decodeString len, decodeStringArray cnt) sees the negative value, compares len > cap as False, off + 32 + len as not-overflowing, then B.take clamps negatives to 0 and returns empty bytes instead of failing. A malicious or buggy SNRC contract could null out string and array fields with no AbiOversized / AbiTruncated signal. Add the sign-bit check on byte (off + 24). Both invariants are now necessary and together sufficient for a safe Int64 cast. Add tests covering the sign-bit case and the max representable positive value (Int64.maxBound = 0x7FFF...FFFF). --- src/Simplex/Messaging/Server/Names/Eth/SNRC.hs | 9 +++++++-- tests/SMPNamesTests.hs | 11 +++++++++++ 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/src/Simplex/Messaging/Server/Names/Eth/SNRC.hs b/src/Simplex/Messaging/Server/Names/Eth/SNRC.hs index b14f2bc4d..80b11a255 100644 --- a/src/Simplex/Messaging/Server/Names/Eth/SNRC.hs +++ b/src/Simplex/Messaging/Server/Names/Eth/SNRC.hs @@ -91,11 +91,16 @@ padLeft32 bs where n = B.length bs --- | Read a uint256 at byte offset, fail if it doesn't fit in Int64. +-- | Read a uint256 at byte offset, fail if it doesn't fit in *signed* Int64. +-- Rejects both (a) any non-zero byte in the high 24 bytes and (b) the high +-- bit of the low 8 bytes being set — the latter is essential because Int64 +-- would otherwise sign-flip a uint64 value into a negative integer, silently +-- corrupting downstream length math. decodeWord256Int64 :: Int -> ByteString -> Either AbiError Int64 decodeWord256Int64 off buf | off + 32 > B.length buf = Left AbiTruncated - | B.any (/= toEnum 0) (B.take 24 (B.drop off buf)) = Left AbiNonZeroHighBytes + | B.any (/= '\NUL') (B.take 24 (B.drop off buf)) = Left AbiNonZeroHighBytes + | B.index buf (off + 24) >= '\x80' = Left AbiNonZeroHighBytes | otherwise = Right $ B.foldl shiftIn 0 (B.take 8 (B.drop (off + 24) buf)) where shiftIn :: Int64 -> Char -> Int64 diff --git a/tests/SMPNamesTests.hs b/tests/SMPNamesTests.hs index 1d8ecc9ee..25d550ffd 100644 --- a/tests/SMPNamesTests.hs +++ b/tests/SMPNamesTests.hs @@ -191,6 +191,17 @@ abiBoundsSpec = do let buf = B.replicate 23 '\NUL' <> B.singleton '\x01' <> B.replicate 8 '\NUL' decodeWord256Int64 0 buf `shouldBe` Left AbiNonZeroHighBytes + it "decodeWord256Int64 rejects sign bit set in low 8 bytes (silent negative)" $ do + -- 0x8000000000000000 would decode to Int64.minBound without the check; + -- downstream length math would then see a negative len and silently + -- return empty bytes from B.take instead of failing. + let buf = B.replicate 24 '\NUL' <> "\x80\x00\x00\x00\x00\x00\x00\x00" + decodeWord256Int64 0 buf `shouldBe` Left AbiNonZeroHighBytes + + it "decodeWord256Int64 succeeds for the max representable positive value" $ do + let buf = B.replicate 24 '\NUL' <> "\x7F\xFF\xFF\xFF\xFF\xFF\xFF\xFF" + decodeWord256Int64 0 buf `shouldBe` Right maxBound + it "decodeWord256Int64 succeeds for low 8 bytes set" $ do let buf = B.replicate 24 '\NUL' <> "\x00\x00\x00\x00\x00\x00\x12\x34" decodeWord256Int64 0 buf `shouldBe` Right 0x1234 From 04be7ba8163451808b1a15f8f1c5f03d1c89936c Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 15:17:07 +0000 Subject: [PATCH 23/31] smp-server: validateUrl rejects path beyond / MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Infura-style endpoints like https://mainnet.infura.io/v3/ embed the secret in the URL path. They were accepted by the previous validator (path wasn't checked), and the startup logInfo line scrubbed only userinfo — not path — so the API key would land in journald. Reject any path beyond / at config time. Operators with a path-style endpoint must move the credential into rpc_auth (Basic or Bearer) instead. Loopback endpoints (http://127.0.0.1:8545) naturally have empty/"/" paths, so the same-host topology is unaffected. Also flips the URL leak vector promised to be defended-against when scrubUrl was wired into the startup log. --- src/Simplex/Messaging/Server/Main.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index 2d80c0d1d..06d8703b3 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -847,6 +847,9 @@ validateUrl url auth_ = do when (null (uriPort ua)) $ Left "explicit port required (e.g. http://host:8545)" unless (null (uriQuery uri)) $ Left "query string not allowed" unless (null (uriFragment uri)) $ Left "fragment not allowed" + let path = uriPath uri + unless (path == "" || path == "/") $ + Left "URL path not allowed; API keys embedded in the path leak to logs — use rpc_auth instead" when (scheme == "https:" && not (isLoopback (uriRegName ua)) && isNothing auth_) $ Left "https endpoint on a non-loopback host requires rpc_auth" Right url From a9e289c6d0f241c64f59802bae0e32ed4cdb849e Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 15:17:54 +0000 Subject: [PATCH 24/31] smp-server: fix CHANGELOG + INI template footguns MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - CHANGELOG bullet 6 referenced allow_dangerous_colocation which was dropped in 7f94f49f, and the hard refusal was demoted to a warning in f9269bea. Rewrite the bullet to match current behaviour. - The [NAMES] INI template's snrc_address example was the zero address. An operator uncommenting it verbatim would have a syntactically valid config that eth_calls to 0x0, gets zero bytes back, hits the zero-owner sentinel, and silently AUTHs every RSLV. Replace with "0x" so an unsubstituted copy fails hex parsing at startup. - Add an INI comment explaining cache_max_entries / cache_max_bytes interaction — whichever fills first triggers eviction. --- CHANGELOG.md | 2 +- src/Simplex/Messaging/Server/Main/Init.hs | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 7a0e11ef9..82726d740 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,7 +9,7 @@ SMP server: - in-memory cache with TTL, byte cap, FIFO eviction, and in-flight request coalescing - new `[NAMES]` INI section; disabled by default - new `simplex_smp_names_*` Prometheus metrics + CSV stats columns - - refuses to start with `[PROXY] enable: on` unless `allow_dangerous_colocation = on` + - logs a startup warning when co-located with the proxy role: slow RSLV cache misses can serialise other forwarded commands on the same proxy-relay session (run names on a separate host for high-volume deployments) # 6.5.1 diff --git a/src/Simplex/Messaging/Server/Main/Init.hs b/src/Simplex/Messaging/Server/Main/Init.hs index 3dab6e721..bc6689d85 100644 --- a/src/Simplex/Messaging/Server/Main/Init.hs +++ b/src/Simplex/Messaging/Server/Main/Init.hs @@ -167,7 +167,8 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds = \# Central Reth via Caddy:\n\ \# ethereum_endpoint: https://eth.simplex.chat:443\n\ \# rpc_auth: basic :\n\ - \# snrc_address: 0x0000000000000000000000000000000000000000\n\ + \# snrc_address: 0x\n\ + \# (cache_max_entries and cache_max_bytes both cap the cache; whichever fills first triggers FIFO eviction)\n\ \# cache_seconds: 300\n\ \# cache_max_entries: 100000\n\ \# cache_max_bytes: 67108864\n\ From 0e13048020d31044595feeeb84ace1ae83dbb3a1 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 15:19:40 +0000 Subject: [PATCH 25/31] smp-server: cache NotFound results to bound DoS via unique-name spam Previously fetchOnce returned Left NotFound and coalesce skipped cache insertion for any Left, so every RSLV for a non-existent name hit eth_call. An adversary holding a proxy connection could spam unique non-existent names to keep rpcMaxConcurrency saturated indefinitely. Cache NotFound results with a shorter TTL (30s, bounded by cacheSeconds) so newly-registered names become visible quickly while still absorbing unique-name bursts. CacheEntry now carries ceResult :: Maybe NameRecord (Nothing = NotFound) and ceTtlNs per-entry so positive and negative results expire on different schedules. Transient errors (HTTP / decode / timeout) still bypass the cache so a flapping endpoint doesn't durably poison entries. Add a regression test: two sequential NotFound lookups must produce exactly one ethCall (hit + miss counters confirm). --- .../Messaging/Server/Names/Resolver.hs | 50 ++++++++++++------- tests/SMPNamesTests.hs | 17 +++++++ 2 files changed, 50 insertions(+), 17 deletions(-) diff --git a/src/Simplex/Messaging/Server/Names/Resolver.hs b/src/Simplex/Messaging/Server/Names/Resolver.hs index ebf6017bd..85b9a04fa 100644 --- a/src/Simplex/Messaging/Server/Names/Resolver.hs +++ b/src/Simplex/Messaging/Server/Names/Resolver.hs @@ -62,11 +62,14 @@ data ResolveError -- Production wires this to ethCallReal; tests substitute a stub. type EthCall = ByteString -> ByteString -> IO (Either EthRpcError ByteString) --- | Cache value bundles a NameRecord with its insertion-time byte cost --- so eviction can keep total cache bytes under cacheMaxBytes. +-- | Cache value bundles a result (NameRecord or NotFound sentinel) with +-- its insertion-time byte cost and per-entry TTL (NotFound expires faster +-- than positive results so newly-registered names become visible quickly +-- while still preventing DoS via unique-name spam). data CacheEntry = CacheEntry - { ceRecord :: NameRecord, - ceBytes :: Int + { ceResult :: Maybe NameRecord, -- Nothing = NotFound; Just = Found + ceBytes :: Int, + ceTtlNs :: Word64 } -- | Cache state: (PSQ keyed by LookupKey, priority = insert time in ns, total bytes). @@ -108,27 +111,37 @@ resolveName :: NamesEnv -> ByteString -> IO (Either ResolveError NameRecord) resolveName env key = do now <- getMonotonicTimeNSec cacheLookup env key now >>= \case - Just rec -> do + Just result -> do atomicModifyIORef'_ (cacheHitsRef env) (+ 1) - pure (Right rec) + pure $ maybe (Left NotFound) Right result Nothing -> do atomicModifyIORef'_ (cacheMissRef env) (+ 1) coalesce env key now -cacheLookup :: NamesEnv -> ByteString -> Word64 -> IO (Maybe NameRecord) -cacheLookup NamesEnv {config, cache} key now = atomically $ do +-- | Look up the key in cache. Returns: +-- Nothing — cache miss (or expired entry, which is evicted) +-- Just Nothing — cache hit for NotFound +-- Just (Just rec) — cache hit for a NameRecord +cacheLookup :: NamesEnv -> ByteString -> Word64 -> IO (Maybe (Maybe NameRecord)) +cacheLookup NamesEnv {cache} key now = atomically $ do (psq, totalBytes) <- readTVar cache case PSQ.lookup key psq of Just (insertedAt, ce) - | now < insertedAt + ttlNs config -> pure (Just (ceRecord ce)) + | now < insertedAt + ceTtlNs ce -> pure (Just (ceResult ce)) | otherwise -> do -- Expired: evict and signal miss. writeTVar cache (PSQ.delete key psq, totalBytes - ceBytes ce) pure Nothing Nothing -> pure Nothing -ttlNs :: NamesConfig -> Word64 -ttlNs cfg = fromIntegral (cacheSeconds cfg) * 1000000000 +ttlFoundNs :: NamesConfig -> Word64 +ttlFoundNs cfg = fromIntegral (cacheSeconds cfg) * 1000000000 + +-- | NotFound cache TTL — short enough that a newly-registered name becomes +-- visible within seconds, long enough to absorb a unique-name DoS burst. +-- Bounded by cacheSeconds in case the operator deliberately ran a tiny TTL. +ttlNotFoundNs :: NamesConfig -> Word64 +ttlNotFoundNs cfg = min (ttlFoundNs cfg) (30 * 1000000000) -- | Leader/waiter coalescing. Leader runs the RPC under E.mask; waiters -- block on the leader's TMVar. Cleanup runs even on async exception. @@ -163,8 +176,9 @@ coalesce env@NamesEnv {inflight} key now = do putTMVar mv r modifyTVar' inflight (PSQ.delete key) case r of - Right rec -> cacheInsert env key now rec - Left _ -> pure () + Right rec -> cacheInsert env key now (Just rec) (ttlFoundNs (config env)) + Left NotFound -> cacheInsert env key now Nothing (ttlNotFoundNs (config env)) + Left _ -> pure () -- transient errors (HTTP, decode, timeout) are not cached pure r mapSyncEthExn :: E.SomeException -> ResolveError @@ -192,10 +206,10 @@ fetchOnce NamesEnv {ethCall, config} key = do Right (Just rec) -> pure (Right rec) Left _ -> pure (Left EthDecodeErr) -cacheInsert :: NamesEnv -> ByteString -> Word64 -> NameRecord -> IO () -cacheInsert NamesEnv {config, cache} key now rec = atomically $ do +cacheInsert :: NamesEnv -> ByteString -> Word64 -> Maybe NameRecord -> Word64 -> IO () +cacheInsert NamesEnv {config, cache} key now result ttl = atomically $ do (psq, totalBytes) <- readTVar cache - let entryBytes = estimateBytes rec + let entryBytes = maybe notFoundOverhead estimateBytes result (psq', totalBytes') = evictWhile psq totalBytes evictWhile p tb | PSQ.size p > cacheMaxEntries config || tb + entryBytes > cacheMaxBytes config = @@ -203,8 +217,10 @@ cacheInsert NamesEnv {config, cache} key now rec = atomically $ do Just (_, _, ce, rest) -> evictWhile rest (tb - ceBytes ce) Nothing -> (p, tb) | otherwise = (p, tb) - ce = CacheEntry {ceRecord = rec, ceBytes = entryBytes} + ce = CacheEntry {ceResult = result, ceBytes = entryBytes, ceTtlNs = ttl} writeTVar cache (PSQ.insert key now ce psq', totalBytes' + entryBytes) + where + notFoundOverhead = 128 -- PSQ node + key copy + small constant for the Nothing sentinel -- | Approximate byte cost of a cached NameRecord. Counts the user-controlled -- variable-length content plus a fixed per-entry overhead for the wrapper diff --git a/tests/SMPNamesTests.hs b/tests/SMPNamesTests.hs index 25d550ffd..f597c4ae0 100644 --- a/tests/SMPNamesTests.hs +++ b/tests/SMPNamesTests.hs @@ -264,6 +264,23 @@ resolverCacheSpec = do misses <- readIORef missRef misses `shouldBe` 1 + it "subsequent NotFound lookups hit the cache (no second RPC)" $ do + callCount <- newIORef (0 :: Int) + (env, hitsRef, missRef) <- mkEnv $ \_ _ -> do + atomicModifyIORef' callCount (\v -> (v + 1, ())) + pure (Right (B.replicate (32 * 8) '\NUL')) + -- First lookup: miss, eth_call fires, NotFound cached. + _ <- resolveName env "alice" + -- Second lookup: should hit cache, not call ethCall. + r2 <- resolveName env "alice" + r2 `shouldBe` Left NotFound + callCount' <- readIORef callCount + callCount' `shouldBe` 1 + missCount <- readIORef missRef + hitCount <- readIORef hitsRef + missCount `shouldBe` 1 + hitCount `shouldBe` 1 + it "concurrent identical lookups coalesce — only the leader makes the RPC" $ do -- Block the stub on a TMVar so the leader's eth_call doesn't return -- before the 7 waiters race to attach to the inflight TMap. Without From da119253987e4bcedb7923bb5bfdb79249e1216a Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 15:20:20 +0000 Subject: [PATCH 26/31] smp-server: filter expired records server-side as defense in depth MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit nrExpiry was parsed and bounds-checked at the wire layer but never compared against current time. A pre-upgrade or buggy SNRC contract that returns expired records unmodified would have its data cached and served to clients. In fetchOnce, after a successful ABI decode, compare nrExpiry to the current POSIX time. If nrExpiry > 0 and < now, treat the record as NotFound (now also cache-friendly per the previous fix). nrExpiry == 0 is the sentinel for "never expires" (reserved names); unaffected. This is defense in depth — the contract is expected to filter expired records itself by returning the zero-owner sentinel — but the smp-server also enforces, so a stale contract doesn't poison the user experience. --- src/Simplex/Messaging/Server/Names/Resolver.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/src/Simplex/Messaging/Server/Names/Resolver.hs b/src/Simplex/Messaging/Server/Names/Resolver.hs index 85b9a04fa..caa1e3387 100644 --- a/src/Simplex/Messaging/Server/Names/Resolver.hs +++ b/src/Simplex/Messaging/Server/Names/Resolver.hs @@ -27,6 +27,7 @@ import qualified Data.HashPSQ as PSQ import Data.IORef (IORef) import Data.Text (Text) import Data.Word (Word64) +import Data.Time.Clock.POSIX (getPOSIXTime) import GHC.Clock (getMonotonicTimeNSec) import qualified Data.ByteString.Char8 as B import qualified Data.Text.Encoding as T @@ -203,7 +204,15 @@ fetchOnce NamesEnv {ethCall, config} key = do Left (JsonRpcErr c m) -> pure (Left EthRpcErr {rpcCode = c, rpcMessage = m}) Right ret -> case decodeGetRecord ret of Right Nothing -> pure (Left NotFound) - Right (Just rec) -> pure (Right rec) + Right (Just rec) -> do + nowSec <- floor <$> getPOSIXTime + -- Defense in depth: the SNRC contract should already return the + -- zero-owner sentinel for expired records, but a buggy / pre-upgrade + -- contract might not. nrExpiry == 0 means "never expires" (reserved + -- names); any positive expiry in the past is treated as NotFound. + if nrExpiry rec /= 0 && nrExpiry rec < nowSec + then pure (Left NotFound) + else pure (Right rec) Left _ -> pure (Left EthDecodeErr) cacheInsert :: NamesEnv -> ByteString -> Word64 -> Maybe NameRecord -> Word64 -> IO () From 13f1e7dd350e40a03837c369762cc2b438f13f97 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 15:21:12 +0000 Subject: [PATCH 27/31] smp-server: parseRpcAuth accepts mixed-case scheme keyword Caddy and most HTTP/RFC 7235 docs write the auth scheme capitalized (Bearer / Basic). Operators who paste "Bearer " verbatim into rpc_auth previously got a parse error because the matcher only accepted the all-lowercase form. Fold the scheme keyword to lowercase before matching. Token / user / pass preserve case (HTTP wire convention applies the scheme name only). --- src/Simplex/Messaging/Server/Main.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index 06d8703b3..9dfec8aba 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -865,10 +865,13 @@ parseEthAddr t = do then mkNameOwner bs else Left "expected a 20-byte address (40 hex characters, optionally 0x-prefixed)" +-- | Parse an rpc_auth INI value. Scheme keyword is case-insensitive so +-- "Bearer " / "BEARER " (Caddy / RFC 7235 convention) work +-- as well as the lowercase form. parseRpcAuth :: Text -> Either String RpcAuth parseRpcAuth t = case T.words t of - ["bearer", tok] -> Right $ AuthBearer tok - ["basic", up] -> case T.breakOn ":" up 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" From 115a115de38338362e92cd90a9ea62e96df21c60 Mon Sep 17 00:00:00 2001 From: sh Date: Mon, 25 May 2026 15:23:27 +0000 Subject: [PATCH 28/31] smp-server: probe ethereum endpoint at startup + log sync exceptions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two observability fixes for [NAMES] enable: on deployments: 1. Endpoint probe. newEnv now calls pingEndpoint immediately after constructing NamesEnv: a single eth_call to getRecord(namehash "") against the configured snrcAddress. Logs "endpoint probe ok" on success or a warning on transport failure (DNS, TLS, refused, 4xx, 5xx). JSON-RPC errors are tolerated — those indicate the endpoint is reachable but possibly misconfigured, which surfaces later via the rslvEthErrs counter. Deliberately does NOT exitFailure: a network blip or an Ethereum host that comes up minutes after smp-server should not block the server from accepting non-RSLV traffic. The warning is the operator signal. 2. Log exception text before mapping to EthHttpErr. The previous mapSyncEthExn returned EthHttpErr with no diagnostic — TLS errors, DNS failures, IOExceptions all collapsed identically and the only observability was the aggregate counter. Now the original exception message is logged at the synchronous catch point in coalesce. --- src/Simplex/Messaging/Server/Env/STM.hs | 12 +++++++-- src/Simplex/Messaging/Server/Names.hs | 3 ++- .../Messaging/Server/Names/Resolver.hs | 25 ++++++++++++++++++- 3 files changed, 36 insertions(+), 4 deletions(-) diff --git a/src/Simplex/Messaging/Server/Env/STM.hs b/src/Simplex/Messaging/Server/Env/STM.hs index 063c1b1c3..6f6ca1aaf 100644 --- a/src/Simplex/Messaging/Server/Env/STM.hs +++ b/src/Simplex/Messaging/Server/Env/STM.hs @@ -115,8 +115,9 @@ 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) +import Simplex.Messaging.Server.Names (NamesConfig (..), NamesEnv, newNamesEnv, pingEndpoint) import Simplex.Messaging.Server.Names.Eth.RPC (scrubUrl) +import Simplex.Messaging.Util (tshow) import Simplex.Messaging.Server.NtfStore import Simplex.Messaging.Server.QueueStore import Simplex.Messaging.Server.QueueStore.Postgres.Config @@ -615,7 +616,14 @@ newEnv config@ServerConfig {allowSMPProxy, smpCredentials, httpCredentials, serv when allowSMPProxy $ logWarn "[NAMES] enable: on on a proxy-role host: slow RSLV cache misses can serialise other forwarded commands on the same proxy-relay session. For high-volume deployments, run [NAMES] on a separate host." let rs = rslvStats serverStats - Just <$> newNamesEnv nc (rslvCacheHits rs) (rslvCacheMiss rs) + env <- newNamesEnv nc (rslvCacheHits rs) (rslvCacheMiss rs) + -- Probe the endpoint at startup. Don't exitFailure: a flapping + -- network or an Ethereum 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 AUTH until reachable): " <> tshow e + pure (Just env) pure Env { serverActive, diff --git a/src/Simplex/Messaging/Server/Names.hs b/src/Simplex/Messaging/Server/Names.hs index eea09b013..a3088a79d 100644 --- a/src/Simplex/Messaging/Server/Names.hs +++ b/src/Simplex/Messaging/Server/Names.hs @@ -10,9 +10,10 @@ module Simplex.Messaging.Server.Names ResolveError (..), newNamesEnv, closeNamesEnv, + pingEndpoint, resolveName, ) where import Simplex.Messaging.Server.Names.Eth.RPC (RpcAuth (..)) -import Simplex.Messaging.Server.Names.Resolver (NamesConfig (..), NamesEnv, ResolveError (..), closeNamesEnv, newNamesEnv, resolveName) +import Simplex.Messaging.Server.Names.Resolver (NamesConfig (..), NamesEnv, ResolveError (..), closeNamesEnv, newNamesEnv, pingEndpoint, resolveName) diff --git a/src/Simplex/Messaging/Server/Names/Resolver.hs b/src/Simplex/Messaging/Server/Names/Resolver.hs index caa1e3387..8dbd8d60f 100644 --- a/src/Simplex/Messaging/Server/Names/Resolver.hs +++ b/src/Simplex/Messaging/Server/Names/Resolver.hs @@ -16,16 +16,19 @@ module Simplex.Messaging.Server.Names.Resolver newNamesEnv, newNamesEnvWith, closeNamesEnv, + pingEndpoint, resolveName, ) where import Control.Concurrent.STM import qualified Control.Exception as E +import Control.Logger.Simple (logError) import Data.ByteString.Char8 (ByteString) import qualified Data.HashPSQ as PSQ import Data.IORef (IORef) import Data.Text (Text) +import qualified Data.Text as T import Data.Word (Word64) import Data.Time.Clock.POSIX (getPOSIXTime) import GHC.Clock (getMonotonicTimeNSec) @@ -106,6 +109,24 @@ newNamesEnvWith config ethCall rpcEnv cacheHitsRef cacheMissRef = do closeNamesEnv :: NamesEnv -> IO () closeNamesEnv NamesEnv {rpcEnv} = maybe (pure ()) closeEthRpcEnv rpcEnv +-- | Reach the configured endpoint with a harmless probe call to confirm +-- network reachability and basic config sanity. Returns Left only on +-- transport-level failures (DNS, TLS, refused) — a JSON-RPC error (e.g. +-- a misconfigured snrc_address) is treated as "endpoint reachable", +-- because the operator-friendly signal we want is "is the eth host alive, +-- not is your contract address right." That distinction surfaces later +-- via the rslvEthErrs counter. +pingEndpoint :: NamesEnv -> IO (Either EthRpcError ()) +pingEndpoint NamesEnv {ethCall, config} = do + let to = unNameOwner (snrcAddress config) + -- Use the ENS-style root node (32 zero bytes) — always a valid + -- bytes32 input that costs the contract nothing to look up. + callData = encodeGetRecord (namehash "") + ethCall to callData >>= \case + Left e@(HttpFailure _) -> pure (Left e) + Left e@(HttpStatusErr _) -> pure (Left e) + _ -> pure (Right ()) + -- | Resolve a lookup key. Coalesces concurrent identical requests, caches -- results for cacheSeconds, and bounds RPCs by rpcTimeoutMs. resolveName :: NamesEnv -> ByteString -> IO (Either ResolveError NameRecord) @@ -172,7 +193,9 @@ coalesce env@NamesEnv {inflight} key now = do putTMVar mv (Left EthHttpErr) modifyTVar' inflight (PSQ.delete key) E.throwIO e - | otherwise -> pure (Left (mapSyncEthExn e)) + | otherwise -> do + logError $ "[NAMES] resolver fetch raised " <> T.pack (E.displayException e) + pure (Left (mapSyncEthExn e)) atomically $ do putTMVar mv r modifyTVar' inflight (PSQ.delete key) From 2fca0c9d9c3fdc647f5a56b0b9497b5a4e42d838 Mon Sep 17 00:00:00 2001 From: sh Date: Wed, 27 May 2026 07:37:29 +0000 Subject: [PATCH 29/31] smp-server: fuse fetchOnce transport-error dispatch Five parallel cases mapping EthRpcError to ResolveError were inlined in fetchOnce, conflating the structural mapping with the resolver's main flow. Extract mapEthRpcError so fetchOnce reads as one round-trip: "call, map transport errors, decode, expiry-check." The mapping is a named concept; the resolver loop reads as the domain. No behavior change. --- .../Messaging/Server/Names/Resolver.hs | 43 +++++++++++-------- 1 file changed, 24 insertions(+), 19 deletions(-) diff --git a/src/Simplex/Messaging/Server/Names/Resolver.hs b/src/Simplex/Messaging/Server/Names/Resolver.hs index 8dbd8d60f..c325b3c34 100644 --- a/src/Simplex/Messaging/Server/Names/Resolver.hs +++ b/src/Simplex/Messaging/Server/Names/Resolver.hs @@ -215,28 +215,33 @@ fetchOnceTimed env key = Nothing -> pure (Left TimedOut) fetchOnce :: NamesEnv -> ByteString -> IO (Either ResolveError NameRecord) -fetchOnce NamesEnv {ethCall, config} key = do - let node = namehash key - callData = encodeGetRecord node - to = unNameOwner (snrcAddress config) - ethCall to callData >>= \case - Left (HttpFailure _) -> pure (Left EthHttpErr) - Left (HttpStatusErr _) -> pure (Left EthHttpErr) - Left BodyTooLarge -> pure (Left EthDecodeErr) - Left (InvalidJson _) -> pure (Left EthDecodeErr) - Left (JsonRpcErr c m) -> pure (Left EthRpcErr {rpcCode = c, rpcMessage = m}) +fetchOnce NamesEnv {ethCall, config} key = + ethCall (unNameOwner (snrcAddress config)) (encodeGetRecord (namehash key)) >>= \case + Left e -> pure (Left (mapEthRpcError e)) Right ret -> case decodeGetRecord ret of Right Nothing -> pure (Left NotFound) - Right (Just rec) -> do - nowSec <- floor <$> getPOSIXTime - -- Defense in depth: the SNRC contract should already return the - -- zero-owner sentinel for expired records, but a buggy / pre-upgrade - -- contract might not. nrExpiry == 0 means "never expires" (reserved - -- names); any positive expiry in the past is treated as NotFound. - if nrExpiry rec /= 0 && nrExpiry rec < nowSec - then pure (Left NotFound) - else pure (Right rec) + Right (Just rec) -> checkExpiry rec Left _ -> pure (Left EthDecodeErr) + where + -- Defense in depth: the SNRC contract should already return the + -- zero-owner sentinel for expired records, but a buggy / pre-upgrade + -- contract might not. nrExpiry == 0 means "never expires" (reserved + -- names); any positive expiry in the past is treated as NotFound. + checkExpiry rec = do + nowSec <- floor <$> getPOSIXTime + pure $ if nrExpiry rec /= 0 && nrExpiry rec < nowSec + then Left NotFound + else Right rec + +-- | Collapse the JSON-RPC transport-layer error space into the resolver's +-- public error space. Reused by fetchOnce and pingEndpoint. +mapEthRpcError :: EthRpcError -> ResolveError +mapEthRpcError = \case + HttpFailure _ -> EthHttpErr + HttpStatusErr _ -> EthHttpErr + BodyTooLarge -> EthDecodeErr + InvalidJson _ -> EthDecodeErr + JsonRpcErr c m -> EthRpcErr {rpcCode = c, rpcMessage = m} cacheInsert :: NamesEnv -> ByteString -> Word64 -> Maybe NameRecord -> Word64 -> IO () cacheInsert NamesEnv {config, cache} key now result ttl = atomically $ do From c244bcd388c640a986f660d394dda6c3064271d7 Mon Sep 17 00:00:00 2001 From: sh Date: Wed, 27 May 2026 07:37:57 +0000 Subject: [PATCH 30/31] smp-server: inline mapSyncEthExn MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Single-use one-liner that discarded its argument — the exception text was already logged immediately above the call site by the N7 fix. The function was a remnant from before that logging was added. Inline the constant return at the call site; the line is gone. --- src/Simplex/Messaging/Server/Names/Resolver.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/Simplex/Messaging/Server/Names/Resolver.hs b/src/Simplex/Messaging/Server/Names/Resolver.hs index c325b3c34..1ed654659 100644 --- a/src/Simplex/Messaging/Server/Names/Resolver.hs +++ b/src/Simplex/Messaging/Server/Names/Resolver.hs @@ -195,7 +195,7 @@ coalesce env@NamesEnv {inflight} key now = do E.throwIO e | otherwise -> do logError $ "[NAMES] resolver fetch raised " <> T.pack (E.displayException e) - pure (Left (mapSyncEthExn e)) + pure (Left EthHttpErr) atomically $ do putTMVar mv r modifyTVar' inflight (PSQ.delete key) @@ -205,9 +205,6 @@ coalesce env@NamesEnv {inflight} key now = do Left _ -> pure () -- transient errors (HTTP, decode, timeout) are not cached pure r -mapSyncEthExn :: E.SomeException -> ResolveError -mapSyncEthExn _ = EthHttpErr - fetchOnceTimed :: NamesEnv -> ByteString -> IO (Either ResolveError NameRecord) fetchOnceTimed env key = timeout (rpcTimeoutMs (config env) * 1000) (fetchOnce env key) >>= \case From 37764a4acbfec2ca2c453b795874de2ec08fd579 Mon Sep 17 00:00:00 2001 From: sh Date: Wed, 27 May 2026 07:38:58 +0000 Subject: [PATCH 31/31] smp-server: fuse RSLV handler dispatch MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Four parallel branches that each (a) chose a counter and (b) built a response carried the same shape — "incStat $> response (corrId, NoEntity, )". Compute the (counter, msg) pair in one dispatch, then increment + respond once. The post-processing on a sum value is now in one place; adding a new ResolveError variant means changing one mapping line, not four. No behavior change. --- src/Simplex/Messaging/Server.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index b7870f62a..e28b303bf 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -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 @@ -1499,13 +1499,13 @@ client Cmd SResolver (RSLV (LookupKey key)) -> do st <- asks (rslvStats . serverStats) incStat (rslvReqs st) - asks namesEnv >>= \case - Nothing -> incStat (rslvDisabled st) $> response (corrId, NoEntity, ERR AUTH) - Just nenv -> - liftIO (resolveName nenv key) >>= \case - Right rec -> incStat (rslvSucc st) $> response (corrId, NoEntity, NAME rec) - Left NotFound -> incStat (rslvNotFound st) $> response (corrId, NoEntity, ERR AUTH) - Left _ -> incStat (rslvEthErrs st) $> response (corrId, NoEntity, ERR AUTH) + (selector, msg) <- asks namesEnv >>= \case + Nothing -> pure (rslvDisabled, ERR AUTH) + Just nenv -> liftIO (resolveName nenv key) <&> \case + Right rec -> (rslvSucc, NAME rec) + Left NotFound -> (rslvNotFound, ERR AUTH) + Left _ -> (rslvEthErrs, ERR AUTH) + incStat (selector st) $> response (corrId, NoEntity, msg) 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