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

src/Simplex/Messaging/Protocol.hs

@@ -256,7 +256,7 @@ import Data.Kind
 import Data.List (foldl')
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as L
-import Data.Maybe (isJust, isNothing)
+import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.String
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -750,11 +750,11 @@ unNameOwner (NameOwner bs) = bs
 
 instance J.ToJSON NameOwner where
   toJSON (NameOwner bs) = J.String $ "0x" <> decodeLatin1 (BAE.convertToBase BAE.Base16 bs)
-  toEncoding (NameOwner bs) = J.toEncoding $ "0x" <> decodeLatin1 (BAE.convertToBase BAE.Base16 bs)
 
 instance J.FromJSON NameOwner where
   parseJSON = J.withText "NameOwner" $ \t -> do
-    let hex = maybe t id (T.stripPrefix "0x" t)
+    -- Accept "0x" and "0X" prefixes (matches Server/Main.hs:parseEthAddr via fromHex).
+    let hex = fromMaybe t (T.stripPrefix "0x" t <|> T.stripPrefix "0X" t)
     case BAE.convertFromBase BAE.Base16 (encodeUtf8 hex) of
       Left e -> fail e
       Right bs -> either fail pure (mkNameOwner bs)
@@ -775,7 +775,6 @@ unNameLink (NameLink t) = t
 
 instance J.ToJSON NameLink where
   toJSON (NameLink t) = J.toJSON t
-  toEncoding (NameLink t) = J.toEncoding t
 
 instance J.FromJSON NameLink where
   parseJSON = J.withText "NameLink" (either fail pure . mkNameLink)
@@ -809,18 +808,22 @@ instance J.ToJSON NameRecord where
 
 instance J.FromJSON NameRecord where
   parseJSON = J.withObject "NameRecord" $ \o -> do
-    nrDisplayName <- o J..: "displayName"
+    nrDisplayName <- o J..: "displayName" >>= capUtf8 "displayName" 255
     nrOwner <- o J..: "owner"
     nrChannelLinks <- o J..: "channelLinks"
     nrContactLinks <- o J..: "contactLinks"
     when (length nrChannelLinks + length nrContactLinks > 8) $
       fail "combined channelLinks + contactLinks > 8"
-    nrAdminAddress <- o J..:? "adminAddress"
-    nrAdminEmail <- o J..:? "adminEmail"
+    nrAdminAddress <- o J..:? "adminAddress" >>= traverse (capUtf8 "adminAddress" 255)
+    nrAdminEmail <- o J..:? "adminEmail" >>= traverse (capUtf8 "adminEmail" 255)
     nrExpiry <- o J..: "expiry"
     when (nrExpiry < 0) $ fail "expiry must be non-negative"
     nrIsTest <- o J..: "isTest"
     pure NameRecord {nrDisplayName, nrOwner, nrChannelLinks, nrContactLinks, nrAdminAddress, nrAdminEmail, nrExpiry, nrIsTest}
+    where
+      capUtf8 fld lim t
+        | B.length (encodeUtf8 t) <= lim = pure t
+        | otherwise = fail $ fld <> " exceeds " <> show lim <> " bytes UTF-8"
 
 data BrokerMsg where
   -- SMP broker messages (responses, client messages, notifications)

src/Simplex/Messaging/Server/Main.hs

@@ -841,7 +841,12 @@ validateUrl url auth_ = do
   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)"
+  case uriPort ua of
+    "" -> Left "explicit port required (e.g. http://host:8545)"
+    ':' : portStr -> case readMaybe portStr of
+      Just n | n >= 1 && n <= 65535 -> Right ()
+      _ -> Left $ "port " <> portStr <> " out of range (must be 1..65535)"
+    other -> Left $ "unexpected port syntax: " <> other
   unless (null (uriQuery uri)) $ Left "query string not allowed"
   unless (null (uriFragment uri)) $ Left "fragment not allowed"
   let path = uriPath uri

src/Simplex/Messaging/Server/Main/Init.hs

@@ -158,8 +158,9 @@ 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\
-        \# Co-locating with the proxy role logs a warning at startup - slow RSLV cache misses\n\
-        \# can serialise other forwarded commands. For high-volume deployments, run on a separate host.\n\
+        \# Co-locating with the proxy role logs a startup advisory: slow RSLV calls can\n\
+        \# serialise other forwarded commands on the same proxy-relay session.\n\
+        \# For high-volume deployments, run [NAMES] on a separate host.\n\
         \# Restart required to change settings.\n\
         \enable: off\n\
         \# Same-host:\n\

src/Simplex/Messaging/Server/Names.hs

@@ -24,16 +24,18 @@ module Simplex.Messaging.Server.Names
   )
 where
 
+import Control.Monad (when, unless)
 import qualified Control.Exception as E
 import Control.Logger.Simple (logError)
 import Data.ByteString.Char8 (ByteString)
+import Data.IORef (IORef, atomicModifyIORef', newIORef)
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock.POSIX (getPOSIXTime)
 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.Server.Names.Eth.SNRC (decodeAddress, decodeGetRecord, encodeGetRecord, isZeroOwner, namehash)
 import System.Timeout (timeout)
 
 data NamesConfig = NamesConfig
@@ -61,7 +63,10 @@ type EthCall = ByteString -> ByteString -> IO (Either EthRpcError ByteString)
 data NamesEnv = NamesEnv
   { config :: NamesConfig,
     ethCall :: EthCall,
-    rpcEnv :: Maybe EthRpcEnv -- Nothing for test stubs
+    rpcEnv :: Maybe EthRpcEnv, -- Nothing for test stubs
+    -- One-shot guard so the placeholder-decoder warning logs once per process,
+    -- not once per RSLV.
+    placeholderWarned :: IORef Bool
   }
 
 newNamesEnv :: NamesConfig -> IO NamesEnv
@@ -71,7 +76,9 @@ newNamesEnv cfg = do
 
 -- | Allocate resolver with an injected ethCall (test seam).
 newNamesEnvWith :: NamesConfig -> EthCall -> Maybe EthRpcEnv -> IO NamesEnv
-newNamesEnvWith config ethCall rpcEnv = pure NamesEnv {config, ethCall, rpcEnv}
+newNamesEnvWith config ethCall rpcEnv = do
+  placeholderWarned <- newIORef False
+  pure NamesEnv {config, ethCall, rpcEnv, placeholderWarned}
 
 closeNamesEnv :: NamesEnv -> IO ()
 closeNamesEnv NamesEnv {rpcEnv} = mapM_ closeEthRpcEnv rpcEnv
@@ -101,14 +108,25 @@ resolveName env key = do
           pure (Left EthHttpErr)
 
 fetch :: NamesEnv -> ByteString -> IO (Either ResolveError NameRecord)
-fetch NamesEnv {ethCall, config} key =
+fetch env@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 Nothing -> notFoundWithPlaceholderWarn ret
       Right (Just rec) -> checkExpiry rec
       Left _ -> pure (Left EthDecodeErr)
   where
+    -- decodeGetRecord is currently a placeholder: it returns Right Nothing
+    -- for BOTH "zero-owner sentinel" (real NotFound) and "non-zero owner
+    -- with real data but no ABI decoder yet". Inspect the owner slot
+    -- directly to distinguish, and surface the latter once per process so
+    -- an operator who enables [NAMES] against a working SNRC contract sees
+    -- the resolver is functionally stubbed.
+    notFoundWithPlaceholderWarn ret = do
+      case decodeAddress 32 ret of
+        Right owner -> unless (isZeroOwner owner) (warnPlaceholderOnce env)
+        Left _ -> pure ()
+      pure (Left NotFound)
     -- 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
@@ -119,6 +137,14 @@ fetch NamesEnv {ethCall, config} key =
         then Left NotFound
         else Right rec
 
+warnPlaceholderOnce :: NamesEnv -> IO ()
+warnPlaceholderOnce NamesEnv {placeholderWarned} = do
+  first <- atomicModifyIORef' placeholderWarned (\w -> (True, not w))
+  when first $
+    logError
+      "[NAMES] decodeGetRecord placeholder hit — SNRC ABI codec not finalised; \
+      \every non-zero-owner record returns NotFound until the decoder ships"
+
 -- | Collapse the JSON-RPC transport-layer error space into the resolver's
 -- public error space.
 mapEthRpcError :: EthRpcError -> ResolveError

src/Simplex/Messaging/Server/Names/Eth/SNRC.hs

@@ -35,6 +35,7 @@ module Simplex.Messaging.Server.Names.Eth.SNRC
     decodeString,
     decodeUtf8Text,
     decodeStringArray,
+    isZeroOwner,
   )
 where