store: merge prepaid name codes

src/Simplex/Chat/Badges/Code.hs

@@ -6,19 +6,24 @@
 -- A code is "SB-" and 20 Crockford base32 characters in four groups of five:
 -- 19 payload characters and a final check character.
 --
--- A name code is "SN-" and 30 characters in six groups of five: the 128-bit wallet
--- entropy and the first 22 bits of its SHA-256.
+-- A name code is one of two kinds, told apart by the length of the text after "SN":
+-- - an owner code, "SN-" and 30 characters in six groups of five: the 128-bit wallet
+--   entropy and the first 22 bits of its SHA-256;
+-- - a prepaid code, "SN", the shortest name length it pays for in one or two ASCII digits
+--   (6 to 63, no leading zero), then 20 characters in four groups of five: 19 payload
+--   characters and a check character over the length digits and the payload.
 --
 -- Reading folds the characters the alphabet omits so that a code copied by hand still
--- verifies: it is case-insensitive and maps 'I' and 'L' to '1' and 'O' to '0'.
+-- verifies: it is case-insensitive and maps 'I' and 'L' to '1' and 'O' to '0', except in a
+-- prepaid code's length.
 --
--- The check character is Luhn mod N with N = 32 over the payload values, which keeps it
--- inside the same 32-character alphabet. It detects every single-character substitution
--- and every transposition of adjacent characters except '0' next to 'Z' - the values 0 and
--- N-1, which is Luhn's one blind spot at any base.
+-- The check character of badge and prepaid codes is Luhn mod N with N = 32 over the values
+-- before it, which keeps it inside the same 32-character alphabet. It detects every
+-- single-character substitution and every transposition of adjacent characters except '0'
+-- next to 'Z' - the values 0 and N-1, which is Luhn's one blind spot at any base.
 --
--- 'BadgeCode' is only constructed by 'parseBadgeCode' and 'randomBadgeCode', so a code
--- whose check character fails cannot be hashed, looked up or sent.
+-- 'BadgeCode' and 'NamePrepaidCode' are only constructed by their parse and random
+-- functions, so a code whose check character fails cannot be hashed, looked up or sent.
 module Simplex.Chat.Badges.Code
   ( BadgeCode,
     parseBadgeCode,
@@ -26,11 +31,19 @@ module Simplex.Chat.Badges.Code
     badgeCodeText,
     badgeCodeHash,
     formatBadgeCode,
-    NameCode,
-    randomNameCode,
+    NameCode (..),
     parseNameCode,
     formatNameCode,
-    nameCodeEntropy,
+    NameOwnerCode,
+    randomNameOwnerCode,
+    parseNameOwnerCode,
+    formatNameOwnerCode,
+    nameOwnerCodeEntropy,
+    NamePrepaidCode,
+    randomNamePrepaidCode,
+    namePrepaidCodeText,
+    namePrepaidCodeHash,
+    namePrepaidCodeLength,
   )
 where
 
@@ -41,14 +54,15 @@ import Crypto.Random (ChaChaDRG)
 import Data.Bits (shiftR)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
-import Data.Char (isAlphaNum, toUpper)
+import Data.Char (digitToInt, isAlphaNum, toUpper)
 import Data.List (elemIndex, foldl')
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.BIP39 (EntropyStrength (..), WalletEntropy, mkEntropy, randomEntropy, unEntropy)
-import Simplex.Messaging.Util (eitherToMaybe)
+import Simplex.Messaging.Util (eitherToMaybe, tshow)
+import Text.Read (readMaybe)
 
 -- | A code that has passed its check character, in canonical form: 'codePrefix' followed by
 -- 20 upper-case alphabet characters, without separators.
@@ -105,14 +119,17 @@ parseBadgeCode t = do
     then Just $ BadgeCode $ codePrefix <> T.pack (map valueChar vs)
     else Nothing
 
--- | A new code from the CSPRNG. 256 is a multiple of the base, so a byte reduces without bias.
 randomBadgeCode :: TVar ChaChaDRG -> IO BadgeCode
 randomBadgeCode drg = do
-  bs <- atomically $ C.randomBytes (codeLength - 1) drg
-  let payload = map ((`mod` base) . fromEnum) $ B.unpack bs
-      vs = payload <> [checkValue payload]
+  payload <- randomPayload drg
+  let vs = payload <> [checkValue payload]
   pure $ BadgeCode $ codePrefix <> T.pack (map valueChar vs)
 
+-- | The payload values of a new badge or prepaid code from the CSPRNG. 256 is a multiple of
+-- the base, so a byte reduces without bias.
+randomPayload :: TVar ChaChaDRG -> IO [Int]
+randomPayload drg = map ((`mod` base) . fromEnum) . B.unpack <$> atomically (C.randomBytes (codeLength - 1) drg)
+
 -- | The canonical form: the only representation of a code that is hashed or sent.
 badgeCodeText :: BadgeCode -> Text
 badgeCodeText (BadgeCode t) = t
@@ -130,38 +147,103 @@ formatBadgeCode (BadgeCode t) = T.intercalate "-" $ codePrefix : groups (T.drop
       | T.null s = []
       | otherwise = let (g, rest) = T.splitAt groupLength s in g : groups rest
 
-newtype NameCode = NameCode WalletEntropy
-
-nameCodeLength :: Int
-nameCodeLength = 30
+data NameCode = NCOwner NameOwnerCode | NCPrepaid NamePrepaidCode
+  deriving (Eq, Show)
 
 nameCodePrefix :: Text
 nameCodePrefix = "SN"
 
-nameCodeChecksumBits :: Int
-nameCodeChecksumBits = 22
-
-randomNameCode :: TVar ChaChaDRG -> IO NameCode
-randomNameCode drg = NameCode <$> atomically (randomEntropy ES128 drg)
-
+-- | Read either kind of name code as typed, as 'parseBadgeCode' reads a badge code.
 parseNameCode :: Text -> Maybe NameCode
 parseNameCode t = do
   body <- T.stripPrefix nameCodePrefix $ T.toUpper $ T.filter isAlphaNum t
-  vs <- mapM charValue $ T.unpack body
-  guard $ length vs == nameCodeLength
-  let (payload, checksum) = foldl' (\acc v -> acc * toInteger base + toInteger v) 0 vs `divMod` (2 ^ nameCodeChecksumBits)
-  guard $ checksum == nameCodeChecksum payload
-  NameCode <$> eitherToMaybe (mkEntropy $ i2ospOf_ 16 payload)
+  if T.length body == nameOwnerCodeLength
+    then NCOwner <$> parseOwnerBody body
+    else NCPrepaid <$> parsePrepaidBody body
 
+-- | The code as it is shown and printed.
 formatNameCode :: NameCode -> Text
-formatNameCode (NameCode e) = T.intercalate "-" $ nameCodePrefix : T.chunksOf groupLength (T.pack $ map valueChar values)
+formatNameCode = \case
+  NCOwner c -> formatNameOwnerCode c
+  NCPrepaid (NamePrepaidCode len body) -> T.intercalate "-" $ (nameCodePrefix <> tshow len) : T.chunksOf groupLength body
+
+newtype NameOwnerCode = NameOwnerCode WalletEntropy
+  deriving (Eq, Show)
+
+nameOwnerCodeLength :: Int
+nameOwnerCodeLength = 30
+
+nameOwnerCodeChecksumBits :: Int
+nameOwnerCodeChecksumBits = 22
+
+randomNameOwnerCode :: TVar ChaChaDRG -> IO NameOwnerCode
+randomNameOwnerCode drg = NameOwnerCode <$> atomically (randomEntropy ES128 drg)
+
+parseNameOwnerCode :: Text -> Maybe NameOwnerCode
+parseNameOwnerCode t =
+  parseNameCode t >>= \case
+    NCOwner c -> Just c
+    NCPrepaid _ -> Nothing
+
+parseOwnerBody :: Text -> Maybe NameOwnerCode
+parseOwnerBody body = do
+  vs <- mapM charValue $ T.unpack body
+  let (payload, checksum) = foldl' (\acc v -> acc * toInteger base + toInteger v) 0 vs `divMod` (2 ^ nameOwnerCodeChecksumBits)
+  guard $ checksum == nameOwnerCodeChecksum payload
+  NameOwnerCode <$> eitherToMaybe (mkEntropy $ i2ospOf_ 16 payload)
+
+formatNameOwnerCode :: NameOwnerCode -> Text
+formatNameOwnerCode (NameOwnerCode e) = T.intercalate "-" $ nameCodePrefix : T.chunksOf groupLength (T.pack $ map valueChar values)
   where
     payload = os2ip $ unEntropy e
-    n = payload * 2 ^ nameCodeChecksumBits + nameCodeChecksum payload
-    values = reverse $ take nameCodeLength $ map (fromInteger . (`mod` toInteger base)) $ iterate (`div` toInteger base) n
+    n = payload * 2 ^ nameOwnerCodeChecksumBits + nameOwnerCodeChecksum payload
+    values = reverse $ take nameOwnerCodeLength $ map (fromInteger . (`mod` toInteger base)) $ iterate (`div` toInteger base) n
 
-nameCodeEntropy :: NameCode -> WalletEntropy
-nameCodeEntropy (NameCode e) = e
+nameOwnerCodeEntropy :: NameOwnerCode -> WalletEntropy
+nameOwnerCodeEntropy (NameOwnerCode e) = e
 
-nameCodeChecksum :: Integer -> Integer
-nameCodeChecksum = (`shiftR` (256 - nameCodeChecksumBits)) . os2ip . C.sha256Hash . i2ospOf_ 16
+nameOwnerCodeChecksum :: Integer -> Integer
+nameOwnerCodeChecksum = (`shiftR` (256 - nameOwnerCodeChecksumBits)) . os2ip . C.sha256Hash . i2ospOf_ 16
+
+-- | A prepaid code that has passed its check: the shortest name length it pays for and the
+-- 20 canonical characters after it.
+data NamePrepaidCode = NamePrepaidCode Int Text
+  deriving (Eq, Show)
+
+minPrepaidNameLength :: Int
+minPrepaidNameLength = 6
+
+maxPrepaidNameLength :: Int
+maxPrepaidNameLength = 63
+
+-- | The length must be 6 to 63, or the code will not parse.
+randomNamePrepaidCode :: TVar ChaChaDRG -> Int -> IO NamePrepaidCode
+randomNamePrepaidCode drg len = do
+  payload <- randomPayload drg
+  let vs = payload <> [checkValue $ lengthValues len <> payload]
+  pure $ NamePrepaidCode len $ T.pack $ map valueChar vs
+
+parsePrepaidBody :: Text -> Maybe NamePrepaidCode
+parsePrepaidBody body = do
+  let (lenText, codeText) = T.splitAt (T.length body - codeLength) body
+  len <- readMaybe $ T.unpack lenText
+  -- a leading zero adds nothing to the check, so it would give the same code a second text and hash
+  guard $ tshow len == lenText && len >= minPrepaidNameLength && len <= maxPrepaidNameLength
+  vs <- mapM charValue $ T.unpack codeText
+  let (payload, checkChar) = splitAt (codeLength - 1) vs
+  guard $ checkChar == [checkValue $ lengthValues len <> payload]
+  Just $ NamePrepaidCode len $ T.pack $ map valueChar vs
+
+lengthValues :: Int -> [Int]
+lengthValues = map digitToInt . show
+
+-- | The canonical form, "SN", the length and the 20 characters: the only representation hashed.
+namePrepaidCodeText :: NamePrepaidCode -> Text
+namePrepaidCodeText (NamePrepaidCode len body) = nameCodePrefix <> tshow len <> body
+
+-- | SHA-256 over the ASCII bytes of the canonical form, as 'badgeCodeHash'.
+namePrepaidCodeHash :: NamePrepaidCode -> ByteString
+namePrepaidCodeHash = C.sha256Hash . encodeUtf8 . namePrepaidCodeText
+
+namePrepaidCodeLength :: NamePrepaidCode -> Int
+namePrepaidCodeLength (NamePrepaidCode len _) = len

tests/BadgeTests.hs

@@ -12,7 +12,7 @@ module BadgeTests (badgeTests) where
 import StoreService.Service (badgeErrorRetryAfter)
 import Control.Concurrent.STM (atomically)
 import Control.Monad (forM_)
-import Data.ByteArray.Encoding (Base (Base16), convertToBase)
+import Data.ByteArray.Encoding (Base (Base16, Base64URLUnpadded), convertToBase)
 import Data.ByteString.Char8 (ByteString)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
@@ -63,9 +63,15 @@ badgeTests = do
     it "reads a code as typed - any case, separators, ambiguous characters" testCodeNormalisation
     it "rejects a code whose check character does not match" testCodeCheckCharacter
     it "hashes the canonical form, whatever was typed" testCodeHash
-  describe "name codes" $ do
-    it "encodes the entropy and its checksum" testNameCodeVectors
-    it "rejects a name code with a wrong character" testNameCodeChecksum
+  describe "StoreService names: codes" $ do
+    it "encodes an owner code's entropy and its checksum" testNameOwnerCodeVectors
+    it "rejects an owner code with a wrong character" testNameOwnerCodeChecksum
+    it "reads the webapp's prepaid codes: length, canonical form, display and hash" testNamePrepaidCodeVectors
+    it "reads a taken order's code derived by the webapp, and refuses its lengths outside 6 to 63" testTakenOrderCodeVectors
+    it "never reads an owner code as prepaid, nor the reverse" testNameCodeKinds
+    it "reads random codes of both kinds back, as typed" testNameCodeRoundTrip
+    it "refuses a prepaid code with one character changed or two adjacent swapped, except 0 and Z" testNamePrepaidCodeCheck
+    it "refuses a prepaid code whose length is not plain ASCII digits" testNamePrepaidCodeLengthDigits
   describe "ledger transitions" $ do
     it "issues a twelve month code one month at a time, and no thirteenth" testTwelveMonths
     it "lapses only the elapsed months after a gap, leaving paidThrough unchanged" testLapseAfterGap
@@ -337,25 +343,138 @@ testCodeHash = do
   Just typed <- pure $ parseBadgeCode $ T.toLower $ formatBadgeCode code
   badgeCodeHash typed `shouldBe` badgeCodeHash code
 
-testNameCodeVectors :: IO ()
-testNameCodeVectors =
-  forM_ nameCodeVectors $ \(entropy, formatted) -> do
-    let code = parseNameCode formatted
-    formatNameCode <$> code `shouldBe` Just formatted
-    convertToBase Base16 . unEntropy . nameCodeEntropy <$> code `shouldBe` Just entropy
+testNameOwnerCodeVectors :: IO ()
+testNameOwnerCodeVectors =
+  forM_ nameOwnerCodeVectors $ \(entropy, formatted) -> do
+    let code = parseNameOwnerCode formatted
+    formatNameOwnerCode <$> code `shouldBe` Just formatted
+    convertToBase Base16 . unEntropy . nameOwnerCodeEntropy <$> code `shouldBe` Just entropy
+    formatNameCode <$> parseNameCode (T.toLower formatted) `shouldBe` Just formatted
 
-testNameCodeChecksum :: IO ()
-testNameCodeChecksum =
-  formatNameCode <$> parseNameCode "SN-KT45V-59ATD-HCNTT-EZRTA-HT8VT-8A0BV" `shouldBe` Nothing
+testNameOwnerCodeChecksum :: IO ()
+testNameOwnerCodeChecksum = do
+  formatNameOwnerCode <$> parseNameOwnerCode "SN-KT45V-59ATD-HCNTT-EZRTA-HT8VT-8A0BV" `shouldBe` Nothing
+  parseNameCode "SN-DWPHT-6JBFR-ZR1MA-T5HQ9-P17QM-F5GM5" `shouldBe` Nothing
 
--- entropy and its name code, computed by a separate Python implementation of the format
-nameCodeVectors :: [(ByteString, T.Text)]
-nameCodeVectors =
+-- entropy and its name code, computed by a separate Python implementation of the format,
+-- and the webapp's fixture from simplex.domains webapp/test/crypto.test.ts
+nameOwnerCodeVectors :: [(ByteString, T.Text)]
+nameOwnerCodeVectors =
   [ ("00000000000000000000000000000000", "SN-00000-00000-00000-00000-00000-0VME2"),
     ("ffffffffffffffffffffffffffffffff", "SN-ZZZZZ-ZZZZZ-ZZZZZ-ZZZZZ-ZZZZZ-XDCD9"),
-    ("9e885d952ad362caeb4efe34a8e91bd2", "SN-KT45V-59ATD-HCNTT-EZRTA-HT8VT-8A0BT")
+    ("9e885d952ad362caeb4efe34a8e91bd2", "SN-KT45V-59ATD-HCNTT-EZRTA-HT8VT-8A0BT"),
+    ("6f2d1c9a4b7e3f80d15a2c6e9b04f7a3", "SN-DWPHS-6JBFR-ZR1MA-T5HQ9-P17QM-F5GM5")
   ]
 
+testNamePrepaidCodeVectors :: IO ()
+testNamePrepaidCodeVectors = do
+  forM_ namePrepaidCodeVectors $ \(typed, len, canonical, display, hash) -> do
+    Just (NCPrepaid code) <- pure $ parseNameCode typed
+    (namePrepaidCodeLength code, namePrepaidCodeText code, formatNameCode (NCPrepaid code)) `shouldBe` (len, canonical, display)
+    convertToBase Base64URLUnpadded (namePrepaidCodeHash code) `shouldBe` (hash :: ByteString)
+  -- the webapp's typo vector
+  parseNameCode "SN7-4K2P7-TQ9M1-ZX3RB-8HJ5X" `shouldBe` Nothing
+
+-- typed code, length, canonical form, display and the webapp's codeHash
+namePrepaidCodeVectors :: [(T.Text, Int, T.Text, T.Text, ByteString)]
+namePrepaidCodeVectors =
+  [ ("SN7-BJTBP-29596-R3HJ8-25YM7", 7, "SN7BJTBP29596R3HJ825YM7", "SN7-BJTBP-29596-R3HJ8-25YM7", "7hg6ED6EotRVm21uS1KOZ-CKEzkJK5hvG4W5atfcn_Q"),
+    ("sn7 bjtbp 29596 r3hj8 25ym7", 7, "SN7BJTBP29596R3HJ825YM7", "SN7-BJTBP-29596-R3HJ8-25YM7", "7hg6ED6EotRVm21uS1KOZ-CKEzkJK5hvG4W5atfcn_Q"),
+    ("SN8-25X6F-6JDNM-8C59E-HDHJD", 8, "SN825X6F6JDNM8C59EHDHJD", "SN8-25X6F-6JDNM-8C59E-HDHJD", "cOnJDSzWBEZiY2z1I-HMGW2gylyx_13V8sOpMDeJOvU")
+  ]
+
+-- takenOrderCode(seed of the webapp's fixture entropy, "t2Jk8RmQ4vXw9NcP3yLb6g", length), computed by the webapp's code.ts
+testTakenOrderCodeVectors :: IO ()
+testTakenOrderCodeVectors = do
+  forM_ takenOrderCodeVectors $ \(display, len, hash) -> do
+    Just (NCPrepaid code) <- pure $ parseNameCode display
+    (namePrepaidCodeLength code, formatNameCode (NCPrepaid code)) `shouldBe` (len, display)
+    convertToBase Base64URLUnpadded (namePrepaidCodeHash code) `shouldBe` (hash :: ByteString)
+  -- the webapp reads these, but no name length is outside 6 to 63
+  parseNameCode "SN5-N0N9J-5D292-HPSYA-R911Q" `shouldBe` Nothing
+  parseNameCode "SN64-N0N9J-5D292-HPSYA-R911C" `shouldBe` Nothing
+
+takenOrderCodeVectors :: [(T.Text, Int, ByteString)]
+takenOrderCodeVectors =
+  [ ("SN6-N0N9J-5D292-HPSYA-R911P", 6, "SKKFjAl5K21B6HRIgQcYQ3AaZ67nVxl2xszsSkZ97cA"),
+    ("SN7-N0N9J-5D292-HPSYA-R911N", 7, "pXhWV9oSfjH0oaQ78HPSGKTg1lScZhNGi-YZnqt-GyQ"),
+    ("SN12-N0N9J-5D292-HPSYA-R911R", 12, "FozeCQ3A_sUsZF9_OwQDp42kdHRMsoJazuGvOkTS-FQ"),
+    ("SN63-N0N9J-5D292-HPSYA-R911D", 63, "U-Nh_Kw3-xDlQuFJffkuCAyolK5m9EfN3QuYiJ28A0A")
+  ]
+
+testNameCodeKinds :: IO ()
+testNameCodeKinds = do
+  drg <- C.newRandom
+  forM_ [1 :: Int .. 100] $ \_ -> do
+    owner <- randomNameOwnerCode drg
+    parseNameCode (formatNameOwnerCode owner) `shouldBe` Just (NCOwner owner)
+  forM_ [6 .. 63] $ \len -> do
+    prepaid <- randomNamePrepaidCode drg len
+    parseNameCode (namePrepaidCodeText prepaid) `shouldBe` Just (NCPrepaid prepaid)
+    parseNameOwnerCode (namePrepaidCodeText prepaid) `shouldBe` Nothing
+
+testNameCodeRoundTrip :: IO ()
+testNameCodeRoundTrip = do
+  drg <- C.newRandom
+  owner <- NCOwner <$> randomNameOwnerCode drg
+  forM_ (typings $ formatNameCode owner) $ \typed -> parseNameCode typed `shouldBe` Just owner
+  forM_ [6 .. 63] $ \len -> do
+    prepaid <- randomNamePrepaidCode drg len
+    let display = formatNameCode (NCPrepaid prepaid)
+    T.length display `shouldBe` T.length (namePrepaidCodeText prepaid) + 4 -- four separators
+    T.isPrefixOf ("SN" <> tshow len <> "-") display `shouldBe` True
+    forM_ (namePrepaidCodeText prepaid : typings display) $ \typed -> parseNameCode typed `shouldBe` Just (NCPrepaid prepaid)
+  where
+    typings display = [display, T.toLower display, T.replace "-" " " display, misreadAfterLength display]
+    -- folding never applies to a prepaid code's length, which is refused when misread
+    misreadAfterLength display = let (prefix, rest) = T.breakOn "-" display in prefix <> T.map misread rest
+    misread = \case
+      '1' -> 'I'
+      '0' -> 'O'
+      c -> c
+
+testNamePrepaidCodeCheck :: IO ()
+testNamePrepaidCodeCheck = do
+  drg <- C.newRandom
+  forM_ [6, 9, 10, 63] $ \len -> do
+    code <- randomNamePrepaidCode drg len
+    let canonical = namePrepaidCodeText code
+        (prefix, rest) = T.splitAt 2 canonical
+        changed =
+          [ prefix <> T.take i rest <> T.singleton c <> T.drop (i + 1) rest
+            | i <- [0 .. T.length rest - 1],
+              c <- "0123456789ABCDEFGHJKMNPQRSTVWXYZ",
+              c /= T.index rest i
+          ]
+        swapped =
+          [ prefix <> T.take i rest <> T.pack [b, a] <> T.drop (i + 2) rest
+            | i <- [0 .. T.length rest - 2],
+              let a = T.index rest i
+                  b = T.index rest (i + 1),
+              a /= b,
+              -- Luhn mod 32's blind spot, the values 0 and 31
+              [a, b] `notElem` ["0Z", "Z0"]
+          ]
+    forM_ (changed <> swapped) $ \typed -> (typed, parseNameCode typed) `shouldBe` (typed, Nothing)
+  -- the blind spot itself: a 0 and Z swapped in the payload still pass the check
+  Just code <- pure $ parseNameCode "SN7-N0ZNJ-5D292-HPSYA-R911N"
+  Just swapped <- pure $ parseNameCode "SN7-NZ0NJ-5D292-HPSYA-R911N"
+  swapped `shouldNotBe` code
+
+testNamePrepaidCodeLengthDigits :: IO ()
+testNamePrepaidCodeLengthDigits = do
+  drg <- C.newRandom
+  code <- randomNamePrepaidCode drg 10
+  let display = formatNameCode (NCPrepaid code)
+  parseNameCode display `shouldBe` Just (NCPrepaid code)
+  -- O and I fold to 0 and 1 in the 20 characters, never in the length
+  parseNameCode (T.replace "SN10-" "SN1O-" display) `shouldBe` Nothing
+  parseNameCode (T.replace "SN10-" "SNI0-" display) `shouldBe` Nothing
+  -- a leading zero adds nothing to the check, so it would be a second text with another hash
+  parseNameCode "SN07-BJTBP-29596-R3HJ8-25YM7" `shouldBe` Nothing
+  parseNameCode "SN-BJTBP-29596-R3HJ8-25YM7" `shouldBe` Nothing
+  parseNameCode "SN100-BJTBP-29596-R3HJ8-25YM7" `shouldBe` Nothing
+
 -- Ledger transitions, against plans/2026-07-30-supporter-badges-v3-ux.md §3
 
 at :: Integer -> Int -> Int -> UTCTime

tests/Bots/StoreService/WebUIMock.hs

@@ -15,7 +15,7 @@ import Control.Concurrent.STM (TVar)
 import Crypto.Random (ChaChaDRG)
 import Data.Text (Text)
 import Data.Word (Word64)
-import Simplex.Chat.Badges.Code (NameCode, formatNameCode, nameCodeEntropy, parseNameCode, randomNameCode)
+import Simplex.Chat.Badges.Code (NameOwnerCode, formatNameOwnerCode, nameOwnerCodeEntropy, parseNameOwnerCode, randomNameOwnerCode)
 import Simplex.Messaging.Crypto.BIP32 (masterKey, xkKey)
 import Simplex.Messaging.Crypto.BIP39 (entropySeed)
 import Simplex.Messaging.Crypto.BIP44 (CoinType (..), bip44Path, mkAccountIndex)
@@ -24,19 +24,19 @@ import Simplex.Messaging.Eth.Address (Address, deriveAddress)
 import Simplex.Messaging.Eth.EIP712 (Eip712Domain)
 
 data EphemeralWallet = EphemeralWallet
-  { ewCode :: NameCode,
+  { ewCode :: NameOwnerCode,
     ewKey :: Secp256k1PrivateKey,
     ewAddress :: Address
   }
 
 newEphemeralWallet :: TVar ChaChaDRG -> IO EphemeralWallet
-newEphemeralWallet g = randomNameCode g >>= walletFromNameCode g
+newEphemeralWallet g = randomNameOwnerCode g >>= walletFromNameOwnerCode g
 
 redemptionCode :: EphemeralWallet -> Text
-redemptionCode = formatNameCode . ewCode
+redemptionCode = formatNameOwnerCode . ewCode
 
 walletFromCode :: TVar ChaChaDRG -> Text -> IO EphemeralWallet
-walletFromCode g = maybe (fail "invalid name code") (walletFromNameCode g) . parseNameCode
+walletFromCode g = maybe (fail "invalid name code") (walletFromNameOwnerCode g) . parseNameOwnerCode
 
 signRegisterIntent :: TVar ChaChaDRG -> Eip712Domain -> EphemeralWallet -> Registration -> Word64 -> IO RegisterIntent
 signRegisterIntent g domain EphemeralWallet {ewKey} r deadline =
@@ -44,9 +44,9 @@ signRegisterIntent g domain EphemeralWallet {ewKey} r deadline =
   where
     nonce = 0
 
-walletFromNameCode :: TVar ChaChaDRG -> NameCode -> IO EphemeralWallet
-walletFromNameCode g ewCode = do
-  master <- either fail pure $ masterKey $ entropySeed (nameCodeEntropy ewCode) ""
+walletFromNameOwnerCode :: TVar ChaChaDRG -> NameOwnerCode -> IO EphemeralWallet
+walletFromNameOwnerCode g ewCode = do
+  master <- either fail pure $ masterKey $ entropySeed (nameOwnerCodeEntropy ewCode) ""
   account <- either fail pure $ mkAccountIndex 0
   (xk, ewAddress) <- deriveAddress g master (bip44Path Ethereum account) >>= either fail pure
   pure EphemeralWallet {ewCode, ewKey = xkKey xk, ewAddress}