7 rounds of /goal

apps/simplex-badge-service/src/BadgeService/Names/Chain.hs

@@ -1,6 +1,6 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module BadgeService.Names.Chain
   ( ChainClient (..),
@@ -14,7 +14,7 @@ where
 import BadgeService.Names.Registration (RegisterIntent, commitCalldata, registerWithCreditCalldata)
 import Control.Concurrent.STM (TVar)
 import Control.Exception (try)
-import Control.Monad.Except (ExceptT (..), liftEither, runExceptT, withExceptT)
+import Control.Monad.Except (ExceptT, liftEither, runExceptT)
 import Control.Monad.IO.Class (liftIO)
 import Crypto.Random (ChaChaDRG)
 import Data.Aeson ((.:), (.:?), (.=))
@@ -33,7 +33,7 @@ import Numeric (readHex)
 import Simplex.Messaging.Crypto.Secp256k1 (Secp256k1PrivateKey)
 import Simplex.Messaging.Eth.Address (Address, addressFromPrivateKey)
 import Simplex.Messaging.Eth.Transaction (Eip1559Tx (..), signEip1559Tx)
-import Simplex.Messaging.Util (eitherToMaybe, tshow)
+import Simplex.Messaging.Util (eitherToMaybe, liftError', tshow)
 
 data ChainClient = ChainClient
   { ccManager :: Manager,
@@ -44,10 +44,7 @@ data ChainClient = ChainClient
     ccRegistrarKey :: Secp256k1PrivateKey
   }
 
-data ChainError
-  = CERpc Text
-  | CEReverted ByteString
-  | CEInternal Text
+newtype ChainError = ChainError Text
   deriving (Eq, Show)
 
 newtype TxHash = TxHash ByteString
@@ -69,39 +66,29 @@ sendTransaction g c@ChainClient {ccChainId, ccRegistrarKey} to calldata = runExc
   let tx =
         Eip1559Tx
           { txChainId = ccChainId,
-            txNonce = fromInteger nonce,
-            txMaxPriorityFeePerGas = fromInteger tip,
-            txMaxFeePerGas = fromInteger $ 2 * baseFee + tip,
-            txGasLimit = fromInteger gas,
+            txNonce = nonce,
+            txMaxPriorityFeePerGas = tip,
+            txMaxFeePerGas = 2 * baseFee + tip,
+            txGasLimit = gas,
             txTo = to,
             txValue = 0,
             txData = calldata
           }
-  raw <- withExceptT (CEInternal . T.pack) $ ExceptT $ signEip1559Tx g ccRegistrarKey tx
+  raw <- liftError' (ChainError . T.pack) $ signEip1559Tx g ccRegistrarKey tx
   TxHash <$> rpc c "eth_sendRawTransaction" [J.String $ hex raw] bytes
 
 rpc :: ChainClient -> Text -> [J.Value] -> (J.Value -> JT.Parser a) -> ExceptT ChainError IO a
 rpc ChainClient {ccManager, ccRpcUrl} method params parseResult = do
-  resp <- withExceptT (CERpc . httpError) $ ExceptT $ try $ do
+  resp <- liftError' (\(e :: HTTP.HttpException) -> ChainError $ tshow e) $ try $ do
     req <- HTTP.parseRequest ccRpcUrl
     HTTP.httpLbs req {HTTP.method = "POST", HTTP.requestHeaders = [(hContentType, "application/json")], HTTP.requestBody = HTTP.RequestBodyLBS body} ccManager
-  liftEither $ either (Left . CERpc . T.pack) id $ JT.parseEither response =<< J.eitherDecode (HTTP.responseBody resp)
+  liftEither $ either (Left . ChainError . T.pack) id $ JT.parseEither response =<< J.eitherDecode (HTTP.responseBody resp)
   where
     body = J.encode $ J.object ["jsonrpc" .= ("2.0" :: Text), "id" .= (1 :: Int), "method" .= method, "params" .= params]
     response = J.withObject "JSON-RPC response" $ \o -> o .:? "error" >>= maybe (Right <$> (parseResult =<< o .: "result")) rpcError
-    rpcError = J.withObject "JSON-RPC error" $ \e -> do
-      revert <- e .:? "data"
-      message <- e .: "message"
-      pure $ Left $ case revert of
-        Just (J.String d) | Just bs <- fromHex d -> CEReverted bs
-        _ -> CERpc message
+    rpcError = J.withObject "JSON-RPC error" $ \e -> Left . ChainError <$> e .: "message"
 
-httpError :: HTTP.HttpException -> Text
-httpError = \case
-  HTTP.HttpExceptionRequest _ content -> tshow content
-  e -> tshow e
-
-quantity :: J.Value -> JT.Parser Integer
+quantity :: (Eq a, Num a) => J.Value -> JT.Parser a
 quantity = J.withText "quantity" $ \t -> case T.stripPrefix "0x" t of
   Just h | [(n, "")] <- readHex (T.unpack h) -> pure n
   _ -> fail $ "not a quantity: " <> T.unpack t

apps/simplex-badge-service/src/BadgeService/Names/Registration.hs

@@ -71,7 +71,7 @@ registerIntentDigest domain r@Registration {rLabel, rOwner, rResolver} deadline
   hashTypedData
     domain
     "RegisterName(string label,address owner,address resolver,bytes[] data,uint256 deadline)"
-    [ VString $ encodeUtf8 rLabel,
+    [ VBytes $ encodeUtf8 rLabel,
       VAddress rOwner,
       VAddress rResolver,
       VArray $ map VBytes $ recordCalls r,

plans/2026-10-12-names-sponsored-registration.md

@@ -16,17 +16,17 @@ Contracts: ens-contracts PR #35 (`SimplexController`, `SimplexSponsor`, `Simplex
 
 ## 1. Summary
 
-A user buys a `.simplex` name on the web, before the app supports wallets or name purchases, and without a browser wallet extension. The web UI makes a new wallet for the name, the service registers the name to that wallet and pays the gas, and the user keeps a redemption code that is the wallet. Later the user redeems the code in the app.
+A user buys a `.simplex` name on the web, before the app supports wallets or name purchases, and without a browser wallet extension. The web UI makes a new wallet for the name, the service registers the name to that wallet and pays the gas, and the user keeps a redemption code from which the wallet's key is derived. Later the user redeems the code in the app.
 
 This PR adds the functions this needs and tests that run the whole flow against a fake Ethereum node. It adds no plumbing: no worker, database, ini section or HTTP API.
 
 ## 2. User story
 
 1. The user opens the names web UI, picks a name and pays.
-2. The web UI generates a wallet for this one name. Nothing is installed and no extension is needed.
-3. The web UI shows a redemption code, `SN-XXXXX-XXXXX-XXXXX-XXXXX-XXXXX-XXXXX`. The code is the wallet: whoever holds it owns the name.
-4. The store service registers the name to the wallet's address. The user pays no gas and holds no ETH.
-5. Later, once the app supports wallets, the user enters the code in the app, and the app takes over the name.
+2. The web UI generates a wallet for this one name.
+3. The web UI shows a redemption code, `SN-XXXXX-XXXXX-XXXXX-XXXXX-XXXXX-XXXXX`. The wallet's key is derived from the code, so whoever has the code controls the name.
+4. The service registers the name to the wallet's address. The user pays no gas and holds no ETH.
+5. Later, once the app supports wallets, the user enters the code in the app, and the name moves to the app's wallet.
 
 ## 3. Scope
 
@@ -45,14 +45,14 @@ Not in this PR:
 
 ## 4. The flow
 
-1. **Wallet and code (web UI).** 128 bits of random entropy are the wallet. Its key is derived as from the 12-word BIP-39 phrase of the same entropy, at `m/44'/60'/0'/0/0`, so the wallet also works in any BIP-44 wallet app. The code is `SN-` and 30 Crockford base32 characters: the entropy and the first 22 bits of its SHA-256.
-2. **Commitment (web UI).** The web UI chooses a 32-byte secret and builds the registration: label, TLD, owner (the wallet's address), duration, secret, resolver, and the `simplex.contact` and `simplex.channel` records. Records are `setText` calls on the resolver, links joined with `;`. The commitment is `keccak256(abi.encode(Registration))`, as `SimplexController.makeCommitment` computes it.
-3. **Commit (service).** The client sends only the commitment, so the name is not revealed. The service sends `commit(commitment)` to the controller.
-4. **Intent (web UI).** After `minCommitmentAge`, the wallet signs `RegisterName(string label,address owner,address resolver,bytes[] data,uint256 deadline)` under the `SimplexSponsor` EIP-712 domain. The client sends the registration, the deadline and the signature.
-5. **Verify (service).** The service checks that the secret is 32 bytes, the deadline has not passed, and the owner signed the intent. A failed check costs no gas.
-6. **Register (service).** The service sends `registerWithCredit(registration, deadline, signature)` to the sponsor. The sponsor checks the signature and spends the registrar's allowance, and the controller registers the name to the owner with its records.
+1. **Wallet and code (web UI).** The wallet's entropy is 128 random bits. Its key is the BIP-44 key at `m/44'/60'/0'/0/0` of the 12-word BIP-39 phrase with this entropy, so a BIP-44 wallet app can import it from that phrase. The code is `SN-` and 30 Crockford base32 characters: the entropy and the first 22 bits of its SHA-256.
+2. **Commitment (web UI).** The web UI chooses a 32-byte secret and builds the registration: label, TLD, owner (the wallet's address), duration, secret, resolver, and the `simplex.contact` and `simplex.channel` records. Records are `setText` calls on the resolver, `simplex.contact` then `simplex.channel`, links joined with `;`, and no call for a key without links. The commitment is `keccak256(abi.encode(Registration))`, as `SimplexController.makeCommitment` computes it.
+3. **Commit (service).** The web UI sends only the commitment, so the name is not revealed. The service sends `commit(commitment)` to the controller.
+4. **Intent (web UI).** The wallet signs `RegisterName(string label,address owner,address resolver,bytes[] data,uint256 deadline)` under the `SimplexSponsor` EIP-712 domain. The web UI sends the registration, the deadline and the signature.
+5. **Verify (service).** The service checks that the secret is 32 bytes, the deadline has not passed, and the owner signed the intent.
+6. **Register (service).** At least `minCommitmentAge` after the commit, the service sends `registerWithCredit(registration, deadline, signature)` to the sponsor. The sponsor checks the signature and spends the registrar's allowance, and the controller registers the name to the owner with its records.
 
-Every transaction is first dry-run with `eth_estimateGas`. A revert sends nothing. The service signs EIP-1559 transactions with its registrar key: nonce from the pending block, priority fee from `eth_maxPriorityFeePerGas`, maximum fee twice the base fee plus the priority fee.
+Every transaction is first dry-run with `eth_estimateGas`; if it reverts, nothing is sent. The service signs EIP-1559 transactions with its registrar key: gas limit from the estimate, nonce from the registrar's pending transaction count, priority fee from `eth_maxPriorityFeePerGas`, maximum fee twice the latest base fee plus the priority fee.
 
 ## 5. Code
 
@@ -70,29 +70,30 @@ simplexmq:
 Test mocks:
 
 - `tests/Bots/BadgeService/WebUIMock.hs`, the web UI's side: `newEphemeralWallet`, `redemptionCode`, `walletFromCode`, `signRegisterIntent`.
-- `tests/Bots/BadgeService/FakeEthNode.hs`, a JSON-RPC node that answers the calls above, records the transactions sent, and reverts the dry run on request.
+- `tests/Bots/BadgeService/FakeEthNode.hs`, a JSON-RPC node that answers the five calls `sendCommit` and `sendRegister` make, records the transactions sent, and reverts the dry run on request.
 
 ## 6. Tests
 
 `tests/Bots/BadgeService/NameRegistrationTests.hs`:
 
-- the commitment, the `commit` calldata, and the `registerWithCredit` calldata with and without records, against expected bytes;
-- verification refuses an intent signed by another wallet, an intent past its deadline, and a secret that is not 32 bytes;
+- the `commit` calldata of a registration's commitment, and the `registerWithCredit` calldata with and without records, against expected bytes;
+- verification fails for an intent signed by another wallet, an intent past its deadline, and a secret that is not 32 bytes;
 - a reverted dry run sends nothing;
-- the whole flow: a new wallet, its code read back to the same wallet, the commit, the signed intent, its verification, the registration, and exactly the two expected transactions sent to the controller and the sponsor.
+- the whole flow: a new wallet, its code read back to the same wallet, the commit, the signed intent, its verification, and the registration, each transaction checked against the expected bytes sent to the controller and the sponsor.
 
-`tests/BadgeTests.hs`: name code vectors, and a code with a wrong character is refused.
+`tests/BadgeTests.hs`: name code vectors, and a code with a wrong character does not parse.
 
-simplexmq `tests/CoreTests/EthCryptoTests.hs`: the `RegisterName` digest, the serialized signature, the recovered address, and every refusal in `recoverPublicKey`.
+simplexmq `tests/CoreTests/EthCryptoTests.hs`: the `RegisterName` digest, the serialized signature, the recovered address, and every error in `recoverPublicKey`.
 
 Expected values come from independent implementations:
 
-- calldata, commitments and signatures from viem, against the ABIs compiled from PR #35, with the addresses and chain id of the PR's test deployment;
+- the commitment and calldata from viem, against the ABIs compiled from PR #35, with the addresses and chain id of the PR's test deployment;
+- the simplexmq digest and signature from viem;
 - name codes from a separate Python implementation.
 
 Checked once against the PR #35 contracts, outside CI:
 
-- with the PR's own test fixture, the exact calldata the tests expect registered the name to the owner with both records, and a changed signature byte was refused with `InvalidSignature()`;
+- with the PR's own test fixture, the exact calldata the tests expect registered the name to the owner with both records, and a changed signature byte reverted with `InvalidSignature()`;
 - on a local hardhat node, `sendCommit` and `sendRegister` registered the name over JSON-RPC.
 
 Run:
@@ -104,11 +105,15 @@ $(cabal list-bin -w ghc-9.6.3 test:simplex-chat-test) -m "name codes" -m "badge
 
 ## 7. Left to the plumbing PR
 
-- Call `verifyRegisterIntent` before `sendRegister`, so that a bad intent costs no gas and a secret that is not 32 bytes cannot change what the contract decodes.
+- Call `verifyRegisterIntent` before `sendRegister`, so that a secret that is not 32 bytes cannot change what the contract decodes.
 - Check the duration and the price against what was paid. `RegisterName` does not sign the duration, and the registrar's allowance pays for it.
+- Send `commit` only for a paid order. It costs the registrar gas, and the service cannot check a name the commitment hides.
+- Accept only the default resolver, bound the size of the links, and cap the gas limit. The client chooses the resolver and the links, the controller calls that resolver with the records, and the registrar pays for the gas the estimate returns.
 - Validate and lower-case the label. The contract hashes the label as given, and resolution lower-cases it.
-- Send from one registrar key one transaction at a time, since the nonce comes from the pending block.
+- Send from one registrar key one transaction at a time, since the nonce is the registrar's pending transaction count.
 - Wait for the commit's receipt and `minCommitmentAge` before registering.
 - Bound the size of RPC responses.
-- Check that reth returns revert data in `error.data`. A hardhat node does not when the revert comes from the controller through the sponsor.
+- Read the revert reason from `error.data` to tell a revert from a failed call, after checking that reth returns it there. A hardhat node does not when the revert comes from the controller through the sponsor.
+- Keep the RPC URL out of logged errors, as it can contain an API key.
+- Add `BadgeService.Names.Chain` and `BadgeService.Names.Registration` to the `simplex-badge-service` executable in `simplex-chat.cabal`; this PR builds them only in the test suite.
 - Pin the simplexmq commit in `cabal.project` and `scripts/nix/sha256map.nix`.

simplex-chat.cabal

@@ -438,8 +438,6 @@ executable simplex-badge-service
       BadgeService.Group
       BadgeService.Group.Command
       BadgeService.Log
-      BadgeService.Names.Chain
-      BadgeService.Names.Registration
       BadgeService.Options
       BadgeService.Orders
       BadgeService.Poller

src/Simplex/Chat/Badges/Code.hs

@@ -138,8 +138,8 @@ nameCodeLength = 30
 nameCodePrefix :: Text
 nameCodePrefix = "SN"
 
-checksumBits :: Int
-checksumBits = 22
+nameCodeChecksumBits :: Int
+nameCodeChecksumBits = 22
 
 randomNameCode :: TVar ChaChaDRG -> IO NameCode
 randomNameCode drg = NameCode <$> atomically (randomEntropy ES128 drg)
@@ -149,19 +149,19 @@ 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, digest) = foldl' (\acc v -> acc * toInteger base + toInteger v) 0 vs `divMod` (2 ^ checksumBits)
-  guard $ digest == checksum payload
+  let (payload, digest) = foldl' (\acc v -> acc * toInteger base + toInteger v) 0 vs `divMod` (2 ^ nameCodeChecksumBits)
+  guard $ digest == nameCodeChecksum payload
   NameCode <$> eitherToMaybe (mkEntropy $ i2ospOf_ 16 payload)
 
 formatNameCode :: NameCode -> Text
 formatNameCode (NameCode e) = T.intercalate "-" $ nameCodePrefix : T.chunksOf groupLength (T.pack $ map valueChar values)
   where
     payload = os2ip $ unEntropy e
-    n = payload * 2 ^ checksumBits + checksum payload
+    n = payload * 2 ^ nameCodeChecksumBits + nameCodeChecksum payload
     values = reverse $ take nameCodeLength $ map (fromInteger . (`mod` toInteger base)) $ iterate (`div` toInteger base) n
 
 nameCodeEntropy :: NameCode -> WalletEntropy
 nameCodeEntropy (NameCode e) = e
 
-checksum :: Integer -> Integer
-checksum = (`shiftR` (256 - checksumBits)) . os2ip . C.sha256Hash . i2ospOf_ 16
+nameCodeChecksum :: Integer -> Integer
+nameCodeChecksum = (`shiftR` (256 - nameCodeChecksumBits)) . os2ip . C.sha256Hash . i2ospOf_ 16

tests/Bots/BadgeService/FakeEthNode.hs

@@ -37,27 +37,27 @@ data FakeEthNode = FakeEthNode
   }
 
 data FakeState = FakeState
-  { fsRevert :: Maybe ByteString,
+  { fsRevert :: Bool,
     fsSent :: [ByteString]
   }
 
-fakeGas, fakeTip, fakeBaseFee :: Integer
+fakeGas, fakeTip, fakeBaseFee :: Num a => a
 fakeGas = 200000
 fakeTip = 1000000000
 fakeBaseFee = 2000000000
 
 withFakeEthNode :: (FakeEthNode -> IO a) -> IO a
 withFakeEthNode action = do
-  fnState <- newTVarIO FakeState {fsRevert = Nothing, fsSent = []}
+  fnState <- newTVarIO FakeState {fsRevert = False, fsSent = []}
   fnManager <- HTTP.newManager HTTP.defaultManagerSettings
   Warp.testWithApplication (pure $ fakeApp fnState) $ \port ->
     action FakeEthNode {fnUrl = "http://127.0.0.1:" <> show port, fnManager, fnState}
 
-revertCalls :: FakeEthNode -> ByteString -> IO ()
-revertCalls FakeEthNode {fnState} revert = atomically $ modifyTVar' fnState $ \s -> s {fsRevert = Just revert}
+revertCalls :: FakeEthNode -> IO ()
+revertCalls FakeEthNode {fnState} = atomically $ modifyTVar' fnState $ \s -> s {fsRevert = True}
 
 sentTransactions :: FakeEthNode -> IO [ByteString]
-sentTransactions FakeEthNode {fnState} = reverse . fsSent <$> readTVarIO fnState
+sentTransactions FakeEthNode {fnState} = fsSent <$> readTVarIO fnState
 
 fakeApp :: TVar FakeState -> Application
 fakeApp st req respond = do
@@ -74,7 +74,7 @@ answer :: TVar FakeState -> Text -> [J.Value] -> STM [JT.Pair]
 answer st method params = do
   FakeState {fsRevert, fsSent} <- readTVar st
   case (method, params) of
-    ("eth_estimateGas", _) -> pure $ maybe (result $ quantity fakeGas) reverted fsRevert
+    ("eth_estimateGas", _) -> pure $ if fsRevert then reverted else result $ quantity fakeGas
     ("eth_getTransactionCount", _) -> pure $ result $ quantity $ toInteger $ length fsSent
     ("eth_maxPriorityFeePerGas", _) -> pure $ result $ quantity fakeTip
     ("eth_getBlockByNumber", _) -> pure $ result $ J.object ["baseFeePerGas" .= quantity fakeBaseFee]
@@ -84,7 +84,7 @@ answer st method params = do
     _ -> pure ["error" .= J.object ["code" .= (-32601 :: Int), "message" .= ("method not found" :: Text)]]
   where
     result v = ["result" .= v]
-    reverted revert = ["error" .= J.object ["code" .= (3 :: Int), "message" .= ("execution reverted" :: Text), "data" .= hex revert]]
+    reverted = ["error" .= J.object ["code" .= (3 :: Int), "message" .= ("execution reverted" :: Text)]]
 
 quantity :: Integer -> Text
 quantity n = "0x" <> T.pack (showHex n "")

tests/Bots/BadgeService/NameRegistrationTests.hs

@@ -7,13 +7,12 @@ import BadgeService.Names.Chain
 import BadgeService.Names.Registration
 import Bots.BadgeService.FakeEthNode
 import Bots.BadgeService.WebUIMock
-import Control.Concurrent.STM (TVar, atomically)
+import Control.Concurrent.STM (TVar)
 import Crypto.Random (ChaChaDRG)
 import qualified Data.ByteArray as BA
 import Data.ByteArray.Encoding (Base (Base16), convertToBase)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
-import Data.Either (isLeft)
 import Data.Text (Text)
 import Data.Word (Word64)
 import qualified Simplex.Messaging.Crypto as C
@@ -30,10 +29,9 @@ badgeNameRegistrationTests :: Spec
 badgeNameRegistrationTests = describe "badge service name registration" $ do
   g <- runIO C.newRandom
   describe "encoding" $ do
-    it "computes the commitment of a registration" testCommitment
     it "encodes registerWithCredit with records" $ testRegisterCalldataWithRecords g
     it "encodes registerWithCredit without records" $ testRegisterCalldataWithoutRecords g
-    it "encodes commit" testCommitCalldata
+    it "encodes commit with the commitment of a registration" testCommitCalldata
   describe "verifying the register intent" $ do
     it "refuses an intent signed by another wallet" $ testVerifyOtherSigner g
     it "refuses an intent past its deadline" $ testVerifyExpired g
@@ -41,68 +39,62 @@ badgeNameRegistrationTests = describe "badge service name registration" $ do
   it "sends nothing when the dry run reverts" $ testRevertedDryRun g
   it "registers a name the client committed to without revealing it" $ testCommitThenRegister g
 
-testCommitment :: IO ()
-testCommitment =
-  toHex (makeCommitment withRecords) `shouldBe` "43aeb4617085160f4dc7ad495d1119f39bca441276b1990123fd3ecb8a40a360"
-
 testRegisterCalldataWithRecords :: TVar ChaChaDRG -> IO ()
 testRegisterCalldataWithRecords g = do
-  intent <- knownIntent g withRecords
+  intent <- knownIntent g knownRegistration
   toHex (registerWithCreditCalldata intent)
     `shouldBe` "88596f95000000000000000000000000000000000000000000000000000000000000006000000000000000000000000000000000000000000000000000000000f4865700000000000000000000000000000000000000000000000000000000000000046000000000000000000000000000000000000000000000000000000000000001000000000000000000000000009858effd232b4033e47d90003d41ec34ecaeda940000000000000000000000000000000000000000000000000000000003c2670011111111111111111111111111111111111111111111111111111111111111110000000000000000000000002279b7a0a67db372996a5fab50d91eaa73d2ebe6000000000000000000000000000000000000000000000000000000000000014000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000762616b657279310000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000020000000000000000000000000000000000000000000000000000000000000040000000000000000000000000000000000000000000000000000000000000016000000000000000000000000000000000000000000000000000000000000000e410f13a8c58c186cadf476923d25ea4950487d1aaf21906ba5574c87f5b9435b61b994370000000000000000000000000000000000000000000000000000000000000006000000000000000000000000000000000000000000000000000000000000000a0000000000000000000000000000000000000000000000000000000000000000f73696d706c65782e636f6e746163740000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002068747470733a2f2f736d702e73696d706c65782e696d2f6123636f6e7461637400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010410f13a8c58c186cadf476923d25ea4950487d1aaf21906ba5574c87f5b9435b61b994370000000000000000000000000000000000000000000000000000000000000006000000000000000000000000000000000000000000000000000000000000000a0000000000000000000000000000000000000000000000000000000000000000f73696d706c65782e6368616e6e656c0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003b68747470733a2f2f736d70312e73696d706c65782e696d2f63236f6e653b68747470733a2f2f736d70322e73696d706c65782e696d2f632374776f00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000412de2e4a88b03d3f6ea59855699ac50d2c19ecf8ca705203ef407d3604bc585b5012ce66b1c22eced32a151acdfc3dab92789477caf68c9d5ea4a76923ad01b321b00000000000000000000000000000000000000000000000000000000000000"
 
 testRegisterCalldataWithoutRecords :: TVar ChaChaDRG -> IO ()
 testRegisterCalldataWithoutRecords g = do
-  intent <- knownIntent g withRecords {rContactLinks = [], rChannelLinks = []}
+  intent <- knownIntent g knownRegistration {rContactLinks = [], rChannelLinks = []}
   toHex (registerWithCreditCalldata intent)
     `shouldBe` "88596f95000000000000000000000000000000000000000000000000000000000000006000000000000000000000000000000000000000000000000000000000f486570000000000000000000000000000000000000000000000000000000000000001c000000000000000000000000000000000000000000000000000000000000001000000000000000000000000009858effd232b4033e47d90003d41ec34ecaeda940000000000000000000000000000000000000000000000000000000003c2670011111111111111111111111111111111111111111111111111111111111111110000000000000000000000002279b7a0a67db372996a5fab50d91eaa73d2ebe6000000000000000000000000000000000000000000000000000000000000014000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000762616b6572793100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000419c00341dd00caef7f36d04bdc23c033b7729787f3e4cb0768f27bbaa1eb86ec7622cc03ec147bc37efb953cf2029381ec399e1c393e5aefa44f6ca5d4c6995851b00000000000000000000000000000000000000000000000000000000000000"
 
 testCommitCalldata :: IO ()
 testCommitCalldata =
-  toHex (commitCalldata $ B.replicate 32 0x22) `shouldBe` "f14fcbc82222222222222222222222222222222222222222222222222222222222222222"
+  toHex (commitCalldata $ makeCommitment knownRegistration) `shouldBe` "f14fcbc843aeb4617085160f4dc7ad495d1119f39bca441276b1990123fd3ecb8a40a360"
 
 testVerifyOtherSigner :: TVar ChaChaDRG -> IO ()
 testVerifyOtherSigner g = do
   other <- newEphemeralWallet g
-  intent <- right <$> signRegisterIntent g domain other withRecords deadline
-  (isLeft <$> verifyRegisterIntent domain beforeDeadline intent) `shouldReturn` True
+  intent <- signRegisterIntent g domain other knownRegistration deadline
+  verifyRegisterIntent domain deadline intent `shouldReturn` Left "intent is not signed by the owner"
 
 testVerifyExpired :: TVar ChaChaDRG -> IO ()
 testVerifyExpired g = do
-  intent <- knownIntent g withRecords
-  (isLeft <$> verifyRegisterIntent domain (deadline + 1) intent) `shouldReturn` True
+  intent <- knownIntent g knownRegistration
+  verifyRegisterIntent domain (deadline + 1) intent `shouldReturn` Left "intent expired"
 
 testVerifyShortSecret :: TVar ChaChaDRG -> IO ()
 testVerifyShortSecret g = do
-  intent <- knownIntent g withRecords {rSecret = B.replicate 31 0x11}
-  (isLeft <$> verifyRegisterIntent domain beforeDeadline intent) `shouldReturn` True
+  intent <- knownIntent g knownRegistration {rSecret = B.replicate 31 0x11}
+  verifyRegisterIntent domain deadline intent `shouldReturn` Left "secret: expected 32 bytes"
 
 testRevertedDryRun :: TVar ChaChaDRG -> IO ()
 testRevertedDryRun g = withFakeEthNode $ \node -> do
-  revertCalls node "reverted"
-  intent <- knownIntent g withRecords
-  sendRegister g (chainClient node) intent `shouldReturn` Left (CEReverted "reverted")
+  revertCalls node
+  intent <- knownIntent g knownRegistration
+  sendRegister g (chainClient node) intent `shouldReturn` Left (ChainError "execution reverted")
   sentTransactions node `shouldReturn` []
 
 testCommitThenRegister :: TVar ChaChaDRG -> IO ()
 testCommitThenRegister g = withFakeEthNode $ \node -> do
   w <- newEphemeralWallet g
-  (fmap ewAddress <$> walletFromCode g (redemptionCode w)) `shouldReturn` Right (ewAddress w)
-  secret <- atomically $ C.randomBytes 32 g
-  let registration = withRecords {rOwner = ewAddress w, rSecret = secret}
+  (ewAddress <$> walletFromCode g (redemptionCode w)) `shouldReturn` ewAddress w
+  let registration = knownRegistration {rOwner = ewAddress w}
       commitment = makeCommitment registration
   commitTx <- expectedTransaction g 0 controller $ commitCalldata commitment
   sendCommit g (chainClient node) commitment `shouldReturn` Right (TxHash $ C.keccak256 commitTx)
-  intent <- right <$> signRegisterIntent g domain w registration deadline
-  verifyRegisterIntent domain beforeDeadline intent `shouldReturn` Right ()
+  intent <- signRegisterIntent g domain w registration deadline
+  verifyRegisterIntent domain deadline intent `shouldReturn` Right ()
   registerTx <- expectedTransaction g 1 sponsor $ registerWithCreditCalldata intent
   sendRegister g (chainClient node) intent `shouldReturn` Right (TxHash $ C.keccak256 registerTx)
-  sentTransactions node `shouldReturn` [commitTx, registerTx]
 
 -- fixtures
 
-withRecords :: Registration
-withRecords =
+knownRegistration :: Registration
+knownRegistration =
   Registration
     { rLabel = "bakery1",
       rTLD = TLDSimplex,
@@ -116,8 +108,8 @@ withRecords =
 
 knownIntent :: TVar ChaChaDRG -> Registration -> IO RegisterIntent
 knownIntent g r = do
-  w <- right <$> walletFromCode g knownCode
-  right <$> signRegisterIntent g domain w r deadline
+  w <- walletFromCode g knownCode
+  signRegisterIntent g domain w r deadline
 
 knownCode :: Text
 knownCode = "SN-00000-00000-00000-00000-00000-0VME2"
@@ -132,9 +124,8 @@ domain = sponsorDomain chainId sponsor
 chainId :: Word64
 chainId = 31337
 
-deadline, beforeDeadline :: Word64
+deadline :: Word64
 deadline = 4102444800
-beforeDeadline = 1800000000
 
 registrarKey :: S.Secp256k1PrivateKey
 registrarKey = right $ S.mkPrivateKey $ BA.replicate 32 0x46
@@ -152,9 +143,9 @@ expectedTransaction g nonce to calldata =
       Eip1559Tx
         { txChainId = chainId,
           txNonce = nonce,
-          txMaxPriorityFeePerGas = fromInteger fakeTip,
-          txMaxFeePerGas = fromInteger $ 2 * fakeBaseFee + fakeTip,
-          txGasLimit = fromInteger fakeGas,
+          txMaxPriorityFeePerGas = fakeTip,
+          txMaxFeePerGas = 2 * fakeBaseFee + fakeTip,
+          txGasLimit = fakeGas,
           txTo = to,
           txValue = 0,
           txData = calldata

tests/Bots/BadgeService/WebUIMock.hs

@@ -12,7 +12,6 @@ where
 
 import BadgeService.Names.Registration (RegisterIntent (..), Registration, registerIntentDigest)
 import Control.Concurrent.STM (TVar)
-import Control.Monad.Except (ExceptT (..), liftEither, runExceptT)
 import Crypto.Random (ChaChaDRG)
 import Data.Text (Text)
 import Data.Word (Word64)
@@ -23,7 +22,6 @@ import Simplex.Messaging.Crypto.BIP44 (CoinType (..), bip44Path, mkAccountIndex)
 import Simplex.Messaging.Crypto.Secp256k1 (Secp256k1PrivateKey, signRecoverable)
 import Simplex.Messaging.Eth.Address (Address, deriveAddress)
 import Simplex.Messaging.Eth.EIP712 (Eip712Domain)
-import Simplex.Messaging.Util ((<$$>))
 
 data EphemeralWallet = EphemeralWallet
   { ewCode :: NameCode,
@@ -32,21 +30,21 @@ data EphemeralWallet = EphemeralWallet
   }
 
 newEphemeralWallet :: TVar ChaChaDRG -> IO EphemeralWallet
-newEphemeralWallet g = randomNameCode g >>= walletFromNameCode g >>= either fail pure
+newEphemeralWallet g = randomNameCode g >>= walletFromNameCode g
 
 redemptionCode :: EphemeralWallet -> Text
 redemptionCode = formatNameCode . ewCode
 
-walletFromCode :: TVar ChaChaDRG -> Text -> IO (Either String EphemeralWallet)
-walletFromCode g = maybe (pure $ Left "invalid name code") (walletFromNameCode g) . parseNameCode
+walletFromCode :: TVar ChaChaDRG -> Text -> IO EphemeralWallet
+walletFromCode g = maybe (fail "invalid name code") (walletFromNameCode g) . parseNameCode
 
-signRegisterIntent :: TVar ChaChaDRG -> Eip712Domain -> EphemeralWallet -> Registration -> Word64 -> IO (Either String RegisterIntent)
+signRegisterIntent :: TVar ChaChaDRG -> Eip712Domain -> EphemeralWallet -> Registration -> Word64 -> IO RegisterIntent
 signRegisterIntent g domain EphemeralWallet {ewKey} r deadline =
-  RegisterIntent r deadline <$$> signRecoverable g ewKey (registerIntentDigest domain r deadline)
+  RegisterIntent r deadline <$> (signRecoverable g ewKey (registerIntentDigest domain r deadline) >>= either fail pure)
 
-walletFromNameCode :: TVar ChaChaDRG -> NameCode -> IO (Either String EphemeralWallet)
-walletFromNameCode g ewCode = runExceptT $ do
-  master <- liftEither $ masterKey $ entropySeed (nameCodeEntropy ewCode) ""
-  account <- liftEither $ mkAccountIndex 0
-  (xk, ewAddress) <- ExceptT $ deriveAddress g master (bip44Path Ethereum account)
+walletFromNameCode :: TVar ChaChaDRG -> NameCode -> IO EphemeralWallet
+walletFromNameCode g ewCode = do
+  master <- either fail pure $ masterKey $ entropySeed (nameCodeEntropy 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}