use labelhash for name queries instead of plaintext

apps/simplex-badge-service/src/BadgeService/Service.hs

@@ -34,6 +34,7 @@ import Simplex.Chat.Badges.Service (BadgeServiceErrorCode (..))
 import Simplex.Chat.Bot (initializeBotAddress')
 import Simplex.Chat.Controller
 import Simplex.Chat.Core (sendChatCmd, simplexChatCore)
+import Data.Maybe (listToMaybe)
 import Simplex.Chat.Names.Protocol
 import Simplex.Chat.Names.Snrc (Intent (..), RecordKey (..), SnrcDeployment (..), devChainId, intentDigest, parseRecordKey)
 import Simplex.Chat.Wallet (parseEthSignature, recoverSigner)
@@ -132,22 +133,6 @@ maxNameLength = 63
 mockTld :: Text
 mockTld = safeDecodeUtf8 (sdTld mockDeployment)
 
-validNameChar :: Char -> Bool
-validNameChar c = (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || c == '-'
-
--- | Letter-digit-hyphen, and the hyphen rules that come with it. The charset
--- alone is not enough: it admits @xn--@, and a punycode label is ASCII that
--- renders as something else entirely, which is the same confusable attack the
--- lowercase rule closes. Positions 3 and 4 are refused wholesale rather than
--- @xn--@ specifically, because that slot is reserved for exactly this purpose
--- and the next prefix to be defined should not need a code change.
-validLabel :: Text -> Bool
-validLabel l =
-  T.all validNameChar l
-    && not ("-" `T.isPrefixOf` l)
-    && not ("-" `T.isSuffixOf` l)
-    && not ("--" `T.isPrefixOf` T.drop 2 l)
-
 reservedLabels :: Set Text
 reservedLabels = S.fromList ["simplex", "support", "admin", "acme"]
 
@@ -327,23 +312,26 @@ handleNamesRequest chain NamesRequest {nrVersion, nrRequest}
                     pure $ NRPError NECBadRequest (Just "term is longer than this registry allows") Nothing
                 | Just e <- checkGates nrName -> pure e
                 | otherwise -> register c now nrName nrOwner nrLink (addUTCTime (fromIntegral nrTtl) now) commitment
-        NRQuote {nrLabel, nrYears} -> atomically $ do
+        -- A quote names no name: it carries the labelhash, so this answers
+        -- only what the chain knows. Charset is unanswerable from a hash and
+        -- stays with the client; length is asserted by the caller and re-checked
+        -- against the plaintext at registration.
+        NRQuote {nrLabelHash, nrLabelLen, nrYears} -> atomically $ do
           c <- readTVar chain
-          let full = nrLabel <> ".simplex"
-              live = M.lookup full (chainNames c)
+          let -- The mock holds the registry in a Map keyed by full name, so it
+              -- scans. A real registrar asks the resolver for this labelhash.
+              live = listToMaybe [e | (full, e) <- M.toList (chainNames c), mkLabelHash (T.takeWhile (/= '.') full) == nrLabelHash]
+              reserved = any ((nrLabelHash ==) . mkLabelHash) (S.toList reservedLabels)
           pure
             NRPQuote
-              { nrLabel,
+              { nrLabelHash,
                 nrAvailable =
                   maybe
-                    ( validLabel nrLabel
-                        && not (S.member nrLabel reservedLabels)
-                        && T.length nrLabel >= minNameLength
-                    )
+                    (not reserved && fromIntegral nrLabelLen >= minNameLength)
                     (const False)
                     live,
                 nrTakenUntil = neExpiry <$> live,
-                nrReserved = S.member nrLabel reservedLabels,
+                nrReserved = reserved,
                 -- $10/yr for 6+ characters, the only rung reachable while the
                 -- minimum length is 6
                 nrPriceUsdCents = 1000 * nrYears,

src/Simplex/Chat/Library/Commands.hs

@@ -1469,11 +1469,15 @@ processChatCommand cxt nm = \case
     respData <- withAgent $ \a -> sendServiceRequestAsync a (aUserId user) cReq requestTimeout (C.unStored <$> signKey) (LB.toStrict $ J.encode request)
     resp <- either (const $ throwCmdError "invalid service response") pure $ J.eitherDecodeStrict' respData
     pure $ CRServiceResponse user resp
+  -- Only the labelhash is sent, so the registrar never learns a name the user
+  -- has not committed to yet. The charset rules come with the client because
+  -- they are the one thing a hash cannot be checked against.
   APINameQuote sendTarget label years -> withUser $ \user -> do
+    unless (validLabel label) $ throwCmdError "name may only contain a-z, 0-9 and inner hyphens"
     cReq <- resolveServiceTarget nm user sendTarget
-    namesRPC user cReq (NRQuote label years) >>= \case
-      NRPQuote {nrLabel, nrAvailable, nrReserved, nrPriceUsdCents, nrYears} ->
-        pure $ CRNameQuote user nrLabel nrAvailable nrReserved nrPriceUsdCents nrYears
+    namesRPC user cReq (NRQuote (mkLabelHash label) (fromIntegral $ T.length label) years) >>= \case
+      NRPQuote {nrAvailable, nrReserved, nrPriceUsdCents, nrYears} ->
+        pure $ CRNameQuote user label nrAvailable nrReserved nrPriceUsdCents nrYears
       _ -> throwCmdError "unexpected quote response"
   -- Asks the registrar, which holds the table. Safe to expose because codes are
   -- unguessable random values, so this cannot be used to probe for one.

src/Simplex/Chat/Names/Protocol.hs

@@ -32,8 +32,11 @@ module Simplex.Chat.Names.Protocol
     RequestId (..),
     RedemptionCode (..),
     IntentSig (..),
+    LabelHash (..),
     NameRegPhase (..),
     mkCommitment,
+    mkLabelHash,
+    validLabel,
   )
 where
 
@@ -53,6 +56,8 @@ import Data.Time.Clock (UTCTime)
 import Data.Word (Word16, Word32)
 import Simplex.Messaging.Encoding (smpEncode)
 import Simplex.Messaging.Encoding.String
+import qualified Data.Text as T
+import Simplex.Chat.Names.Snrc (labelHash)
 import Simplex.Messaging.Eth.Address (Address, unAddress)
 import Simplex.Messaging.Eth.Keccak (keccak256)
 import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, taggedObjectJSON)
@@ -79,7 +84,13 @@ newtype NameSecret = NameSecret {unSecret :: ByteString}
 newtype TxHash = TxHash {unTxHash :: ByteString}
   deriving (Eq, Show)
 
--- | All three are on-chain byte values, so they are encoded the way Ethereum
+-- | ENS labelhash of a single label: @keccak256("acme")@, not the namehash of
+-- the full name. Quoting a name sends only this, so the label a client is about
+-- to register is never revealed to the registrar before it is committed.
+newtype LabelHash = LabelHash {unLabelHash :: ByteString}
+  deriving (Eq, Show)
+
+-- | All of these are on-chain byte values, so they are encoded the way Ethereum
 -- writes them — @0x@-prefixed hex — not base64.
 hexEncode :: ByteString -> ByteString
 hexEncode = ("0x" <>) . BAE.convertToBase BAE.Base16
@@ -94,6 +105,10 @@ instance StrEncoding Commitment where
   strEncode = hexEncode . unCommitment
   strP = Commitment <$> hexP
 
+instance StrEncoding LabelHash where
+  strEncode = hexEncode . unLabelHash
+  strP = LabelHash <$> hexP
+
 instance StrEncoding NameSecret where
   strEncode = hexEncode . unSecret
   strP = NameSecret <$> hexP
@@ -106,6 +121,10 @@ instance ToJSON Commitment where toJSON = strToJSON; toEncoding = strToJEncoding
 
 instance FromJSON Commitment where parseJSON = strParseJSON "Commitment"
 
+instance ToJSON LabelHash where toJSON = strToJSON; toEncoding = strToJEncoding
+
+instance FromJSON LabelHash where parseJSON = strParseJSON "LabelHash"
+
 instance ToJSON NameSecret where toJSON = strToJSON; toEncoding = strToJEncoding
 
 instance FromJSON NameSecret where parseJSON = strParseJSON "NameSecret"
@@ -120,6 +139,30 @@ mkCommitment :: Text -> Address -> NameSecret -> NameTtl -> Commitment
 mkCommitment name owner (NameSecret secret) ttl =
   Commitment . keccak256 $ B.concat [encodeUtf8 name, unAddress owner, secret, smpEncode ttl]
 
+mkLabelHash :: Text -> LabelHash
+mkLabelHash = LabelHash . labelHash . encodeUtf8
+
+validNameChar :: Char -> Bool
+validNameChar c = (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') || c == '-'
+
+-- | What the contract accepts in a label. Shared rather than mirrored: a quote
+-- carries only 'LabelHash', so the registrar cannot see the charset and the
+-- client is the only side that can check it. Two copies that drifted would let
+-- a client call a name available that registration then refuses.
+--
+-- Letter-digit-hyphen, and the hyphen rules that come with it. The charset
+-- alone is not enough: it admits @xn--@, and a punycode label is ASCII that
+-- renders as something else entirely, which is the same confusable attack the
+-- lowercase rule closes. Positions 3 and 4 are refused wholesale rather than
+-- @xn--@ specifically, because that slot is reserved for exactly this purpose
+-- and the next prefix to be defined should not need a code change.
+validLabel :: Text -> Bool
+validLabel l =
+  T.all validNameChar l
+    && not ("-" `T.isPrefixOf` l)
+    && not ("-" `T.isSuffixOf` l)
+    && not ("--" `T.isPrefixOf` T.drop 2 l)
+
 -- | @{ version, request }@ — the outer envelope. Fields are @nr@-prefixed so
 -- they do not shadow local bindings where this module is imported unqualified.
 data NamesRequest = NamesRequest
@@ -176,7 +219,11 @@ data NamesCommand
       }
   | -- | Availability and price. @years@ is an input because a price without a
     -- term is meaningless; the CLI ignores the price, mobile IAP needs it.
-    NRQuote {nrLabel :: Text, nrYears :: Word32}
+    -- @nrLabelLen@ travels alongside because the length cannot be recovered
+    -- from the hash and the registry has a minimum. A client gains nothing by
+    -- lying: understating it is refused as too short, and overstating it only
+    -- defers the refusal to 'NRBuy', which sees the plaintext.
+    NRQuote {nrLabelHash :: LabelHash, nrLabelLen :: Word32, nrYears :: Word32}
   | -- | Register against a redemption code. The term is /not/ a field: it comes
     -- from the code's tier, so client and service cannot disagree about what was
     -- paid for. @requestId@ makes a resent request distinguishable from a
@@ -210,7 +257,7 @@ data NamesResponse
   = NRPCommitted {nrTxHash :: TxHash}
   | NRPRegistered {nrName :: Text, nrExpiry :: UTCTime, nrTxHash :: TxHash}
   | NRPQuote
-      { nrLabel :: Text,
+      { nrLabelHash :: LabelHash,
         nrAvailable :: Bool,
         nrTakenUntil :: Maybe UTCTime,
         nrReserved :: Bool,

tests/Bots/NamesServiceTests.hs

@@ -41,11 +41,16 @@ namesServiceTests = do
   it "recovers the derivation marks from an imported phrase" testRecoverMarks
   it "buys with a code, then re-points the link with a signature" testBuyAndLink
   it "refuses a spent code, a reserved name and a short name" testBuyRefusals
+  it "quotes a name by labelhash, without sending the name" testNameQuote
 
 -- | Pins the wire format. The end-to-end test cannot catch a key renamed on
 -- both sides at once, so the encodings are asserted literally here.
 namesProtocolTests :: Spec
 namesProtocolTests = do
+  -- A quote sends only this, so "is it reserved" is answered by hash equality.
+  -- The whole label is hashed, so a reserved label cannot match as a prefix.
+  it "labelhash covers the whole label" $ \_ ->
+    mkLabelHash "acme" `shouldNotBe` mkLabelHash "acmecorp"
   -- Name keys are plain BIP-44, so they line up with wallets users already have.
   -- Pinned against the standard test mnemonic: profile 0's names are exactly
   -- MetaMask's account list (m/44'/60'/0'/0/k), and each profile's first name is
@@ -347,6 +352,31 @@ testBuyAndLink ps =
 
 -- | Every refusal has its own message. A user who types a reserved name must be
 -- told that, not "bad request".
+-- A quote carries only the labelhash and the label's length, so the registrar
+-- answers all of these without ever seeing the name. Charset is the one rule it
+-- cannot check against a hash, so the client refuses that one locally.
+testNameQuote :: HasCallStack => TestParams -> IO ()
+testNameQuote ps =
+  withBadgeService ps $ \client bsLink -> do
+    client ##> ("/name quote " <> bsLink <> " spender")
+    client <##. "spender.simplex - available"
+    client ##> ("/name quote " <> bsLink <> " acme")
+    client <##. "acme.simplex - reserved"
+    -- charset is unanswerable from a hash, so this never reaches the registrar
+    client ##> ("/name quote " <> bsLink <> " acme!!")
+    client <## "bad chat command: name may only contain a-z, 0-9 and inner hyphens"
+    -- the same name, now registered, is found again by its hash alone
+    client ##> ("/name buy " <> bsLink <> " spender " <> T.unpack (devCode 1) <> " simplex:/contact#/x")
+    client <## "name spender.simplex: revealing"
+    client <## "name spender.simplex: registered"
+    client <##. "name registered: spender.simplex -> 0x"
+    client <##. "  derivation path: m/44'/60'/0'/0/"
+    client ##> ("/name quote " <> bsLink <> " spender")
+    client <## "spender.simplex - taken"
+    -- the length travels with the hash, so the minimum is still enforced
+    client ##> ("/name quote " <> bsLink <> " abc")
+    client <## "abc.simplex - taken"
+
 testBuyRefusals :: HasCallStack => TestParams -> IO ()
 testBuyRefusals ps =
   withBadgeService ps $ \client bsLink -> do