names v2 TUI implemented with mocks

2026-08-29 03:18:37 +00:00 · 2026-08-06 16:17:58 +02:00
parent 5f376affa8
commit 2f60d56fe6
17 changed files with 1396 additions and 119 deletions
@@ -0,0 +1,230 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | End-to-end walkthrough of the SimpleX names UX against a mocked service.
+--
+-- The periphery is mocked — no store payment, no relayer, no chain — but the
+-- crypto is real: every intent is signed with the profile's derived key, and the
+-- mock recovers the signer from the signature and applies the same rules the
+-- contracts do. A step that prints OK here is a step the contracts would accept.
+--
+-- Run: cabal run simplex-names-demo
+module Main (main) where
+
+import Control.Concurrent.STM
+import Control.Monad (forM_, unless)
+import Crypto.Random (drgNew)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Char8 as BC
+import Data.Word (Word32)
+import Simplex.Chat.Names.Service
+import Simplex.Chat.Names.Service.Mock
+import Simplex.Chat.Names.Snrc
+import Simplex.Chat.Wallet
+import qualified Simplex.Messaging.Crypto.BIP39 as B39
+import System.Exit (exitFailure)
+
+main :: IO ()
+main = do
+  g <- newTVarIO =<< drgNew
+  chain <- newMockChain
+  let svc = mockNamesService chain
+  setPendingRounds chain 2 -- stand in for the 60s commit-reveal wait
+
+  section "1. First purchase creates the seed, lazily"
+  entropy <- atomically $ newSeed B39.MS128 g
+  let wallet = WalletSeed {wsId = SeedId 1, wsEntropy = entropy, wsBackedUp = False}
+  phrase <- expect "recovery key" $ recoveryKeyPhrase wallet
+  say $ "  seed created, id " <> bshow (wsId wallet)
+  say $ "  recovery key: " <> phrase
+  say "  (shown once after purchase; a reminder persists until acknowledged)"
+
+  section "2. Each chat profile derives its own address from that one seed"
+  alice <- expect "alice key" $ deriveAccount wallet 0
+  bob <- expect "bob key" $ deriveAccount wallet 1
+  say $ "  profile 0 (personal)  -> " <> bshow (accountAddress alice)
+  say $ "  profile 1 (anonymous) -> " <> bshow (accountAddress bob)
+  unless (accountAddress alice /= accountAddress bob) $ die "profiles must not share an address"
+  say "  different addresses, so names under the two are unlinked on-chain"
+
+  section "3. Quote a name"
+  checkQuote svc "ab" "too short is rejected"
+  checkQuote svc "simplex" "reserved name is rejected"
+  q <- expectIO "quote" $ quoteName svc "alicechat"
+  say $ "  alicechat.simplex available=" <> bshow (nqAvailable q) <> " price=" <> money (nqPriceCents q) <> "/yr"
+
+  section "4. Pay and register (payment proof mocked, registration sponsored)"
+  let contactLink = "https://smp16.simplex.im/a#alice-contact"
+  pid <-
+    expectIO "purchase" $
+      buyName
+        svc
+        BuyRequest
+          { brLabel = "alicechat",
+            brOwner = accountAddress alice,
+            brYears = 1,
+            brPayment = PPAppleReceipt "mock-storekit-jws",
+            brContactLink = Just contactLink,
+            brChannelLink = Nothing
+          }
+  say $ "  purchase accepted: " <> bshow pid
+  reg <- pollUntilConfirmed svc pid
+  say $ "  registered, tx " <> BC.take 18 (rsTxHash reg) <> "..."
+
+  section "5. The app confirms independently by resolving the name"
+  rec1 <- expectIO "resolve" $ resolveName svc "alicechat.simplex"
+  say $ "  owner   " <> bshow (nrvOwner rec1)
+  say $ "  contact " <> bshow (nrvContact rec1)
+  unless (nrvOwner rec1 == accountAddress alice) $ die "owner is not our derived address"
+  say "  owner matches our key -> the name is ours; profile claim can now be set"
+
+  section "6. Repoint the name after rotating the contact address"
+  let newLink = "https://smp11.simplex.im/a#alice-rotated"
+  n0 <- expectIO "nonce" $ currentNonce svc (accountAddress alice)
+  txSet <-
+    relaySigned svc alice $
+      SetTextRecord
+        { sxName = "alicechat.simplex",
+          sxKey = contactRecordKey,
+          sxValue = newLink,
+          sxNonce = n0,
+          sxDeadline = farFuture
+        }
+  say $ "  relayed setTextWithSig, tx " <> BC.take 18 txSet <> "..."
+  rec2 <- expectIO "resolve" $ resolveName svc "alicechat.simplex"
+  unless (nrvContact rec2 == [newLink]) $ die "record did not change"
+  say $ "  contact now " <> bshow (nrvContact rec2)
+
+  section "7. Forgery and replay are rejected"
+  -- Bob signs an intent over Alice's name. Use *Bob's* nonce so the request is
+  -- otherwise well-formed and the ownership check is what actually rejects it —
+  -- signing with Alice's nonce would trip the nonce check first and prove nothing.
+  nBob <- expectIO "nonce" $ currentNonce svc (accountAddress bob)
+  let forged =
+        SetTextRecord
+          { sxName = "alicechat.simplex",
+            sxKey = contactRecordKey,
+            sxValue = "https://evil.example/a#hijack",
+            sxNonce = nBob,
+            sxDeadline = farFuture
+          }
+  relaySignedRaw svc bob forged >>= \case
+    Left SENotOwner -> say "  forged by another key: rejected as not the owner"
+    Left e -> die $ "expected SENotOwner, got: " <> serviceErrorText e
+    Right _ -> die "a forged intent was accepted"
+  -- Alice replaying her own already-used nonce.
+  nAlice <- expectIO "nonce" $ currentNonce svc (accountAddress alice)
+  relaySignedRaw svc alice forged {sxNonce = nAlice - 1} >>= \case
+    Left SEBadNonce -> say "  replayed nonce: rejected"
+    Left e -> die $ "expected SEBadNonce, got: " <> serviceErrorText e
+    Right _ -> die "a replayed nonce was accepted"
+  -- An expired deadline.
+  relaySignedRaw svc alice forged {sxNonce = nAlice, sxDeadline = 0} >>= \case
+    Left SEExpiredIntent -> say "  expired deadline: rejected"
+    Left e -> die $ "expected SEExpiredIntent, got: " <> serviceErrorText e
+    Right _ -> die "an expired intent was accepted"
+
+  section "8. Gift the name to a contact"
+  say $ "  recipient address " <> bshow (accountAddress bob) <> " (how this is learned is the open decision in the plan)"
+  n2 <- expectIO "nonce" $ currentNonce svc (accountAddress alice)
+  txXfer <-
+    relaySigned svc alice $
+      TransferName
+        { tiFrom = accountAddress alice,
+          tiTo = accountAddress bob,
+          tiLabel = "alicechat",
+          tiNonce = n2,
+          tiDeadline = farFuture
+        }
+  say $ "  relayed transferWithSig, tx " <> BC.take 18 txXfer <> "..."
+  rec3 <- expectIO "resolve" $ resolveName svc "alicechat.simplex"
+  unless (nrvOwner rec3 == accountAddress bob) $ die "transfer did not move ownership"
+  say $ "  owner now " <> bshow (nrvOwner rec3)
+  say $ "  records carried over: " <> bshow (nrvContact rec3)
+
+  section "9. The previous owner can no longer touch it"
+  n3 <- expectIO "nonce" $ currentNonce svc (accountAddress alice)
+  afterGift <-
+    relaySignedRaw svc alice $
+      SetTextRecord
+        { sxName = "alicechat.simplex",
+          sxKey = contactRecordKey,
+          sxValue = "https://smp16.simplex.im/a#taken-back",
+          sxNonce = n3,
+          sxDeadline = farFuture
+        }
+  case afterGift of
+    Left SENotOwner -> say "  rejected: no longer the owner"
+    Left e -> say $ "  rejected: " <> serviceErrorText e
+    Right _ -> die "the old owner could still write records"
+
+  section "10. Recovery: wipe the device, re-import the recovery key"
+  imported <- expect "import" $ importRecoveryKey phrase
+  let restored = WalletSeed {wsId = SeedId 1, wsEntropy = imported, wsBackedUp = True}
+  forM_ [(0 :: Word32, "personal"), (1, "anonymous")] $ \(i, label) -> do
+    pk <- expect "derive" $ deriveAccount restored i
+    owned <- expectIO "ownedBy" $ namesOwnedBy svc (accountAddress pk)
+    say $ "  profile " <> bshow i <> " (" <> label <> ") " <> bshow (accountAddress pk) <> " owns " <> bshow owned
+  restoredAlice <- expect "derive" $ deriveAccount restored 0
+  unless (accountAddress restoredAlice == accountAddress alice) $ die "recovery derived a different address"
+  say "  same addresses recovered from the phrase alone"
+
+  putStrLn ""
+  putStrLn "ALL STEPS OK"
+
+-- helpers
+
+farFuture :: Integer
+farFuture = 1786000000 + 3600
+
+section :: ByteString -> IO ()
+section t = putStrLn "" >> BC.putStrLn t
+
+say :: ByteString -> IO ()
+say = BC.putStrLn
+
+bshow :: Show a => a -> ByteString
+bshow = BC.pack . show
+
+money :: Int -> ByteString
+money cents = BC.pack $ "$" <> show (cents `div` 100) <> "." <> pad (cents `mod` 100)
+  where
+    pad n = let s = show n in if length s < 2 then '0' : s else s
+
+die :: ByteString -> IO a
+die msg = BC.putStrLn ("FAILED: " <> msg) >> exitFailure
+
+expect :: ByteString -> Either String a -> IO a
+expect what = either (\e -> die (what <> ": " <> BC.pack e)) pure
+
+expectIO :: ByteString -> IO (Either ServiceError a) -> IO a
+expectIO what act = act >>= either (\e -> die (what <> ": " <> serviceErrorText e)) pure
+
+checkQuote :: NamesService -> ByteString -> ByteString -> IO ()
+checkQuote svc label why =
+  quoteName svc label >>= \case
+    Left e -> say $ "  " <> why <> " (" <> serviceErrorText e <> ")"
+    Right _ -> die $ "expected rejection: " <> label
+
+pollUntilConfirmed :: NamesService -> PurchaseId -> IO RegistrationStatus
+pollUntilConfirmed svc pid = go (10 :: Int)
+  where
+    go 0 = die "registration never confirmed"
+    go n =
+      expectIO "status" (registrationStatus svc pid) >>= \case
+        RegPending -> say "  waiting for commit-reveal..." >> go (n - 1)
+        RegFailed e -> die $ "registration failed: " <> e
+        r@RegConfirmed {} -> pure r
+
+-- | Sign an intent with a profile key and hand it to the relayer.
+relaySigned :: NamesService -> WalletAccount -> Intent -> IO ByteString
+relaySigned svc pk intent =
+  relaySignedRaw svc pk intent >>= either (\e -> die ("relay: " <> serviceErrorText e)) pure
+
+relaySignedRaw :: NamesService -> WalletAccount -> Intent -> IO (Either ServiceError ByteString)
+relaySignedRaw svc pk intent = do
+  digest <- expect "digest" $ intentDigest mockDeployment intent
+  sig <- expect "sign" $ signDigest pk digest
+  relayIntent svc SignedIntent {siIntent = intent, siSignature = sig}