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

src/Simplex/Messaging/Server/Main.hs

@@ -46,7 +46,7 @@ import Control.Monad
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Char (isAlpha, isAscii, toUpper)
+import Data.Char (isAlpha, isAscii, toLower, toUpper)
 import Data.Either (fromRight)
 import Data.Functor (($>))
 import Data.Ini (Ini, lookupValue, readIniFile)
@@ -813,9 +813,9 @@ readNamesConfig ini
               { ethereumEndpoint = either (error . ("[NAMES] ethereum_endpoint: " <>)) id (validateUrl endpoint rpcAuth_),
                 tldRegistries = registries,
                 rpcAuth = rpcAuth_,
-                rpcTimeoutMs = positiveIniInt 3000 100 "rpc_timeout_ms",
-                rpcMaxResponseBytes = positiveIniInt 262144 1024 "rpc_max_response_bytes",
-                rpcMaxConcurrency = positiveIniInt 8 1 "rpc_max_concurrency"
+                rpcTimeoutMs = boundedIniInt 3000 100 60000 "rpc_timeout_ms",
+                rpcMaxResponseBytes = boundedIniInt 262144 1024 16777216 "rpc_max_response_bytes",
+                rpcMaxConcurrency = boundedIniInt 8 1 1024 "rpc_max_concurrency"
               }
   where
     enabled = fromMaybe False (iniOnOff "NAMES" "enable" ini)
@@ -825,10 +825,14 @@ readNamesConfig ini
     -- Reject zero / negative values that would deadlock waitQSem (concurrency = 0),
     -- time-out every RSLV immediately (timeout = 0), or accept zero-length
     -- responses (max_response_bytes = 0). The lower bounds also catch sub-sane
-    -- values an operator might choose by accident.
-    positiveIniInt def floor_ key = case readIniDefault def "NAMES" key ini of
-      n | n >= floor_ -> n
-        | otherwise -> error $ "[NAMES] " <> T.unpack key <> " must be at least " <> show floor_ <> " (got " <> show n <> ")"
+    -- values an operator might choose by accident. The upper bounds defend
+    -- against operator-misconfig footguns: 16 MiB response cap (worst-case
+    -- per-call memory), 60 s timeout (no operator wants RSLV to hang longer),
+    -- 1024 concurrent RPCs (any higher should run a separate names router).
+    boundedIniInt def floor_ ceiling_ key = case readIniDefault def "NAMES" key ini of
+      n | n >= floor_ && n <= ceiling_ -> n
+        | otherwise ->
+            error $ "[NAMES] " <> T.unpack key <> " must be in [" <> show floor_ <> ".." <> show ceiling_ <> "] (got " <> show n <> ")"
     readTldRegistries =
       let regs = TldRegistries
             { tldSimplex = optionalAddr "registry_tld_simplex",
@@ -885,7 +889,14 @@ validateUrl url auth_ = do
   Right url
   where
     isLoopback h = h == "127.0.0.1" || h == "localhost" || h == "[::1]"
-    isLinkLocal h = "169.254." `isPrefixOf` h || h == "[fe80::1]"
+    -- IPv4 link-local 169.254.0.0/16 and the IPv6 link-local prefix fe80::/10
+    -- (matched as the textual prefix "[fe80:"). Also catches IPv4-mapped IPv6
+    -- forms like "[::ffff:169.254.169.254]" so the cloud-metadata IP can't be
+    -- reached via the IPv6 alias.
+    isLinkLocal h =
+      "169.254." `isPrefixOf` h
+        || "[fe80:" `isPrefixOf` map toLower h
+        || "[::ffff:169.254." `isPrefixOf` map toLower h
 
 -- | Parse a 20-byte Ethereum address as text "0x[hex40]" or "[hex40]".
 -- EIP-55 mixed-case checksum verification is a follow-up.

src/Simplex/Messaging/SimplexName.hs

@@ -75,16 +75,18 @@ instance StrEncoding SimplexNameDomain where
   strP = parseDomain . safeDecodeUtf8 <$?> A.takeWhile1 (not . A.isSpace)
     where
       parseDomain s = AT.parseOnly (nameLabelP `AT.sepBy1` AT.char '.' <* AT.endOfInput) s >>= mkDomain
-      -- TLD label compared lowercase: DNS labels are case-insensitive, and a
-      -- mixed-case `foo.SIMPLEX` would otherwise fall through to TLDWeb and
-      -- route through `registry_tld_all` instead of `registry_tld_simplex`.
-      mkDomain labels = case reverse labels of
+      -- All labels lowercased: DNS labels are case-insensitive, and namehash is
+      -- byte-defined — preserving original case would make `Alice.simplex` and
+      -- `alice.simplex` resolve to different on-chain records. A mixed-case TLD
+      -- would also fall through to TLDWeb and route through `registry_tld_all`
+      -- instead of `registry_tld_simplex`.
+      mkDomain labels = case reverse (map T.toLower labels) of
         [] -> Left "empty name"
         [_] -> Left "domain requires TLD"
-        tld : name : sub -> Right $ case T.toLower tld of
+        tld : name : sub -> Right $ case tld of
           "simplex" -> SimplexNameDomain TLDSimplex name sub
           "testing" -> SimplexNameDomain TLDTesting name sub
-          _ -> SimplexNameDomain TLDWeb (T.intercalate "." labels) []
+          _ -> SimplexNameDomain TLDWeb (T.intercalate "." (reverse (tld : name : sub))) []
 
 fullDomainName :: SimplexNameDomain -> Text
 fullDomainName SimplexNameDomain {nameTLD, domain, subDomain} = T.intercalate "." (reverse subDomain ++ [domain] ++ tld')

tests/SMPNamesTests.hs

@@ -292,6 +292,14 @@ tldWhitelistSpec = do
           domain d `shouldBe` "privacy"
         Nothing -> expectationFailure "expected Just"
 
+    it "normalizes case across all labels (Alice.SIMPLEX ≡ alice.simplex for namehash)" $ do
+      env <- mkEnv $ TldRegistries {tldSimplex = Just addr1, tldTesting = Nothing, tldAll = Nothing}
+      let lower = RslvRequest {name = "alice.simplex", contract = addr1}
+          mixed = RslvRequest {name = "Alice.SIMPLEX", contract = addr1}
+      case (verifyRslv env lower, verifyRslv env mixed) of
+        (Just (_, dL), Just (_, dM)) -> dL `shouldBe` dM
+        _ -> expectationFailure "both should parse"
+
     it "rejects mismatched contract address" $ do
       env <- mkEnv $ TldRegistries {tldSimplex = Just addr1, tldTesting = Nothing, tldAll = Nothing}
       let req = RslvRequest {name = "privacy.simplex", contract = addr2}