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

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

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

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

Author: shumvgolove

src/Simplex/Messaging/SimplexName.hs

@@ -21,6 +21,8 @@ import Control.Applicative (optional, (<|>))
 import qualified Data.Aeson.TH as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import qualified Data.Attoparsec.Text as AT
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
 import Data.Char (isDigit)
 import Data.Functor (($>))
 import Data.Text (Text)
@@ -65,19 +67,31 @@ nameLabelP = T.intercalate "-" <$> AT.takeWhile1 (\c -> isNameLetter c || isDigi
     -- (Cyrillic а vs ASCII a hash to different on-chain records).
     isNameLetter c = c >= 'a' && c <= 'z' || c >= 'A' && c <= 'Z'
 
+-- | DoS defense for the bare-name / bare-domain entry points. The outer
+-- parser would otherwise `takeWhile1 (not . isSpace)` unbounded, allowing
+-- a crafted multi-megabyte token to be decoded and re-parsed before any
+-- validation. Cap at 253 bytes (DNS full-domain limit) — generous against
+-- any realistic SimpleX name and forces the surrounding `parseOnly`
+-- (which requires consuming all input) to fail on oversized inputs.
+boundedNonSpace :: A.Parser ByteString
+boundedNonSpace = do
+  bs <- A.scan (0 :: Int) $ \i c ->
+    if i < 253 && not (A.isSpace c) then Just (i + 1) else Nothing
+  if B.null bs then fail "expected non-empty name token" else pure bs
+
 instance StrEncoding SimplexNameInfo where
   strEncode SimplexNameInfo {nameType, nameDomain} =
     "simplex:/name" <> strEncode nameType <> strEncode nameDomain
   strP = optional "simplex:/name" *> ((strP >>= infoP) <|> infoP NTPublicGroup)
     where
       infoP NTPublicGroup = SimplexNameInfo NTPublicGroup <$> (strP <|> bareName)
       infoP NTContact = SimplexNameInfo NTContact <$> strP
-      bareName = parseBare . safeDecodeUtf8 <$?> A.takeWhile1 (not . A.isSpace)
+      bareName = parseBare . safeDecodeUtf8 <$?> boundedNonSpace
       parseBare s = (\name -> SimplexNameDomain TLDSimplex name []) <$> AT.parseOnly (nameLabelP <* AT.endOfInput) s
 
 instance StrEncoding SimplexNameDomain where
   strEncode = encodeUtf8 . fullDomainName
-  strP = parseDomain . safeDecodeUtf8 <$?> A.takeWhile1 (not . A.isSpace)
+  strP = parseDomain . safeDecodeUtf8 <$?> boundedNonSpace
     where
       parseDomain s = AT.parseOnly (nameLabelP `AT.sepBy1` AT.char '.' <* AT.endOfInput) s >>= mkDomain
       -- All labels lowercased: DNS labels are case-insensitive, and namehash is

tests/SMPNamesTests.hs

@@ -341,6 +341,11 @@ tldWhitelistSpec = do
       for_ ["\1072lice.simplex", "\945pple.simplex", "\65313pple.simplex"] $ \name ->
         verifyRslv env RslvRequest {name, contract = addr1} `shouldBe` Nothing
 
+    it "rejects oversized inputs (>253 bytes) — bounded parser allocation" $ do
+      env <- mkEnv $ TldRegistries {tldSimplex = Just addr1, tldTesting = Nothing, tldAll = Nothing}
+      let oversize = T.replicate 254 "a" <> ".simplex"
+      verifyRslv env RslvRequest {name = oversize, contract = addr1} `shouldBe` Nothing
+
 resolverSpec :: Spec
 resolverSpec = do
   let regs = TldRegistries {tldSimplex = Just addr1, tldTesting = Nothing, tldAll = Nothing}