diff --git a/apps/simplex-badge-service/src/BadgeService/Names/Chain.hs b/apps/simplex-badge-service/src/BadgeService/Names/Chain.hs index 7e8f53dba6..bfbe8562ab 100644 --- a/apps/simplex-badge-service/src/BadgeService/Names/Chain.hs +++ b/apps/simplex-badge-service/src/BadgeService/Names/Chain.hs @@ -1,46 +1,39 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} module BadgeService.Names.Chain ( ChainClient (..), ChainError (..), - ContractError (..), TxHash (..), sendCommit, sendRegister, ) where -import BadgeService.Names.Registration (RegisterIntent, commitCalldata, registerWithCreditCalldata, selector) +import BadgeService.Names.Registration (RegisterIntent, commitCalldata, registerWithCreditCalldata) import Control.Concurrent.STM (TVar) import Control.Exception (try) -import Control.Monad.Except (ExceptT (..), liftEither, runExceptT, throwError, withExceptT) +import Control.Monad.Except (ExceptT (..), liftEither, runExceptT, withExceptT) import Control.Monad.IO.Class (liftIO) import Crypto.Random (ChaChaDRG) import Data.Aeson ((.:), (.:?), (.=)) import qualified Data.Aeson as J -import qualified Data.Aeson.Key as JK import qualified Data.Aeson.Types as JT -import Data.Bifunctor (first) import Data.ByteArray.Encoding (Base (Base16), convertFromBase, convertToBase) import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1, encodeUtf8) import Data.Word (Word64) -import Network.HTTP.Client (HttpException, Manager) +import Network.HTTP.Client (Manager) import qualified Network.HTTP.Client as HTTP import Network.HTTP.Types (hContentType) 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.SimplexName (SimplexTLD) -import Simplex.Messaging.Util (tshow) +import Simplex.Messaging.Util (eitherToMaybe, tshow) data ChainClient = ChainClient { ccManager :: Manager, @@ -53,39 +46,26 @@ data ChainClient = ChainClient data ChainError = CERpc Text - | CEReverted ContractError + | CEReverted ByteString | CEInternal Text deriving (Eq, Show) -data ContractError - = NameNotAvailable - | CommitmentTooNew - | CommitmentTooOld - | UnexpiredCommitmentExists - | InsufficientAllowance - | SignatureExpired - | InvalidSignature - | UnknownRevert ByteString - deriving (Eq, Show) - newtype TxHash = TxHash ByteString deriving (Eq, Show) sendCommit :: TVar ChaChaDRG -> ChainClient -> ByteString -> IO (Either ChainError TxHash) sendCommit g c@ChainClient {ccController} = sendTransaction g c ccController . commitCalldata -sendRegister :: TVar ChaChaDRG -> ChainClient -> SimplexTLD -> RegisterIntent -> IO (Either ChainError TxHash) -sendRegister g c@ChainClient {ccSponsor} tld = sendTransaction g c ccSponsor . registerWithCreditCalldata tld +sendRegister :: TVar ChaChaDRG -> ChainClient -> RegisterIntent -> IO (Either ChainError TxHash) +sendRegister g c@ChainClient {ccSponsor} = sendTransaction g c ccSponsor . registerWithCreditCalldata sendTransaction :: TVar ChaChaDRG -> ChainClient -> Address -> ByteString -> IO (Either ChainError TxHash) sendTransaction g c@ChainClient {ccChainId, ccRegistrarKey} to calldata = runExceptT $ do from <- liftIO $ addressFromPrivateKey g ccRegistrarKey - let call = J.object ["from" .= from, "to" .= to, "data" .= hex calldata] - _ <- rpc c "eth_call" [call, "pending"] - gas <- quantity =<< rpc c "eth_estimateGas" [call, "pending"] - nonce <- quantity =<< rpc c "eth_getTransactionCount" [J.toJSON from, "pending"] - tip <- quantity =<< rpc c "eth_maxPriorityFeePerGas" [] - baseFee <- quantity =<< field "baseFeePerGas" =<< rpc c "eth_getBlockByNumber" ["latest", J.Bool False] + gas <- rpc c "eth_estimateGas" [J.object ["from" .= from, "to" .= to, "data" .= hex calldata], "pending"] quantity + nonce <- rpc c "eth_getTransactionCount" [J.toJSON from, "pending"] quantity + tip <- rpc c "eth_maxPriorityFeePerGas" [] quantity + baseFee <- rpc c "eth_getBlockByNumber" ["latest", J.Bool False] $ J.withObject "block" $ \b -> quantity =<< b .: "baseFeePerGas" let tx = Eip1559Tx { txChainId = ccChainId, @@ -98,56 +78,39 @@ sendTransaction g c@ChainClient {ccChainId, ccRegistrarKey} to calldata = runExc txData = calldata } raw <- withExceptT (CEInternal . T.pack) $ ExceptT $ signEip1559Tx g ccRegistrarKey tx - TxHash <$> (bytes =<< rpc c "eth_sendRawTransaction" [J.String $ hex raw]) + TxHash <$> rpc c "eth_sendRawTransaction" [J.String $ hex raw] bytes -rpc :: ChainClient -> Text -> [J.Value] -> ExceptT ChainError IO J.Value -rpc ChainClient {ccManager, ccRpcUrl} method params = do - req <- either (throwError . CERpc . tshow) pure $ HTTP.parseRequest ccRpcUrl - let req' = req {HTTP.method = "POST", HTTP.requestHeaders = [(hContentType, "application/json")], HTTP.requestBody = HTTP.RequestBodyLBS body} - resp <- liftIO (try $ HTTP.httpLbs req' ccManager) >>= either (\(e :: HttpException) -> throwError $ CERpc $ tshow e) pure - liftEither $ rpcResult =<< first (CERpc . T.pack) (J.eitherDecode $ HTTP.responseBody resp) +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 + 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) where body = J.encode $ J.object ["jsonrpc" .= ("2.0" :: Text), "id" .= (1 :: Int), "method" .= method, "params" .= params] - -rpcResult :: J.Value -> Either ChainError J.Value -rpcResult v = either (Left . CERpc . T.pack) id $ JT.parseEither response v - where - response = J.withObject "JSON-RPC response" $ \o -> o .:? "error" >>= maybe (Right <$> o .: "result") rpcError + 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 $ contractError bs + Just (J.String d) | Just bs <- fromHex d -> CEReverted bs _ -> CERpc message -contractError :: ByteString -> ContractError -contractError revert = fromMaybe (UnknownRevert revert) $ lookup (B.take 4 revert) [(selector s, e) | (s, e) <- errorSignatures] - where - errorSignatures = - [ ("NameNotAvailable(string)", NameNotAvailable), - ("CommitmentTooNew(bytes32,uint256,uint256)", CommitmentTooNew), - ("CommitmentTooOld(bytes32,uint256,uint256)", CommitmentTooOld), - ("UnexpiredCommitmentExists(bytes32)", UnexpiredCommitmentExists), - ("InsufficientAllowance(uint256,uint256)", InsufficientAllowance), - ("SignatureExpired()", SignatureExpired), - ("InvalidSignature()", InvalidSignature) - ] +httpError :: HTTP.HttpException -> Text +httpError = \case + HTTP.HttpExceptionRequest _ content -> tshow content + e -> tshow e -field :: Text -> J.Value -> ExceptT ChainError IO J.Value -field name = liftEither . first (CERpc . T.pack) . JT.parseEither (J.withObject "object" (.: JK.fromText name)) +quantity :: J.Value -> JT.Parser Integer +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 -quantity :: J.Value -> ExceptT ChainError IO Integer -quantity = \case - J.String t | Just h <- T.stripPrefix "0x" t, [(n, "")] <- readHex (T.unpack h) -> pure n - v -> throwError $ CERpc $ "not a quantity: " <> tshow v - -bytes :: J.Value -> ExceptT ChainError IO ByteString -bytes = \case - J.String t | Just bs <- fromHex t -> pure bs - v -> throwError $ CERpc $ "not hex data: " <> tshow v +bytes :: J.Value -> JT.Parser ByteString +bytes = J.withText "data" $ maybe (fail "not hex data") pure . fromHex fromHex :: Text -> Maybe ByteString -fromHex t = T.stripPrefix "0x" t >>= either (const Nothing) Just . convertFromBase Base16 . encodeUtf8 +fromHex t = T.stripPrefix "0x" t >>= eitherToMaybe . convertFromBase Base16 . encodeUtf8 hex :: ByteString -> Text hex bs = "0x" <> decodeLatin1 (convertToBase Base16 bs) diff --git a/apps/simplex-badge-service/src/BadgeService/Names/Registration.hs b/apps/simplex-badge-service/src/BadgeService/Names/Registration.hs index 2224c316b5..545438275c 100644 --- a/apps/simplex-badge-service/src/BadgeService/Names/Registration.hs +++ b/apps/simplex-badge-service/src/BadgeService/Names/Registration.hs @@ -11,12 +11,11 @@ module BadgeService.Names.Registration registerWithCreditCalldata, registerIntentDigest, verifyRegisterIntent, - selector, ) where import Control.Monad (unless, when) -import Control.Monad.Except (ExceptT (..), liftEither, runExceptT, throwError) +import Control.Monad.Except (ExceptT (..), runExceptT, throwError) import Crypto.Number.Serialize (i2ospOf_) import Data.ByteString (ByteString) import qualified Data.ByteString as B @@ -34,6 +33,7 @@ import Simplex.Messaging.SimplexName (SimplexTLD) data Registration = Registration { rLabel :: Text, + rTLD :: SimplexTLD, rOwner :: Address, rDuration :: Word64, rSecret :: ByteString, @@ -51,51 +51,49 @@ data RegisterIntent = RegisterIntent sponsorDomain :: Word64 -> Address -> Eip712Domain sponsorDomain edChainId edVerifyingContract = Eip712Domain {edName = "SimplexSponsor", edVersion = "1", edChainId, edVerifyingContract} -makeCommitment :: SimplexTLD -> Registration -> ByteString -makeCommitment tld r = keccak256 $ abiTuple [Dynamic $ registrationTuple tld r] +makeCommitment :: Registration -> ByteString +makeCommitment r = keccak256 $ abiTuple [Dynamic $ registrationTuple r] commitCalldata :: ByteString -> ByteString commitCalldata commitment = selector "commit(bytes32)" <> commitment -registerWithCreditCalldata :: SimplexTLD -> RegisterIntent -> ByteString -registerWithCreditCalldata tld RegisterIntent {riRegistration, riDeadline, riSignature} = +registerWithCreditCalldata :: RegisterIntent -> ByteString +registerWithCreditCalldata RegisterIntent {riRegistration, riDeadline, riSignature} = selector "registerWithCredit((string,address,uint256,bytes32,address,bytes[],uint8,bytes32),uint256,bytes)" <> abiTuple - [ Dynamic $ registrationTuple tld riRegistration, + [ Dynamic $ registrationTuple riRegistration, Static $ uint256 riDeadline, Dynamic $ abiBytes $ serializeSignature riSignature ] -registerIntentDigest :: SimplexTLD -> Eip712Domain -> Registration -> Word64 -> Either String ByteString -registerIntentDigest tld domain r@Registration {rLabel, rOwner, rResolver} deadline = +registerIntentDigest :: Eip712Domain -> Registration -> Word64 -> ByteString +registerIntentDigest domain r@Registration {rLabel, rOwner, rResolver} deadline = hashTypedData domain "RegisterName(string label,address owner,address resolver,bytes[] data,uint256 deadline)" [ VString $ encodeUtf8 rLabel, VAddress rOwner, VAddress rResolver, - VArray $ map VBytes $ recordCalls tld r, - VUint $ toInteger deadline + VArray $ map VBytes $ recordCalls r, + VUint $ fromIntegral deadline ] -verifyRegisterIntent :: SimplexTLD -> Eip712Domain -> Word64 -> RegisterIntent -> IO (Either String Registration) -verifyRegisterIntent tld domain now RegisterIntent {riRegistration = r@Registration {rOwner, rSecret}, riDeadline, riSignature} = runExceptT $ do +verifyRegisterIntent :: Eip712Domain -> Word64 -> RegisterIntent -> IO (Either String ()) +verifyRegisterIntent domain now RegisterIntent {riRegistration = r@Registration {rOwner, rSecret}, riDeadline, riSignature} = runExceptT $ do unless (B.length rSecret == 32) $ throwError "secret: expected 32 bytes" when (now > riDeadline) $ throwError "intent expired" - digest <- liftEither $ registerIntentDigest tld domain r riDeadline - signer <- ExceptT $ recoverAddress riSignature digest + signer <- ExceptT $ recoverAddress riSignature $ registerIntentDigest domain r riDeadline unless (signer == rOwner) $ throwError "intent is not signed by the owner" - pure r -registrationTuple :: SimplexTLD -> Registration -> ByteString -registrationTuple tld r@Registration {rLabel, rOwner, rDuration, rSecret, rResolver} = +registrationTuple :: Registration -> ByteString +registrationTuple r@Registration {rLabel, rOwner, rDuration, rSecret, rResolver} = abiTuple [ Dynamic $ abiBytes $ encodeUtf8 rLabel, Static $ addressWord rOwner, Static $ uint256 rDuration, Static rSecret, Static $ addressWord rResolver, - Dynamic $ abiArray $ map abiBytes $ recordCalls tld r, + Dynamic $ abiArray $ map abiBytes $ recordCalls r, Static reverseRecord, Static referrer ] @@ -103,12 +101,12 @@ registrationTuple tld r@Registration {rLabel, rOwner, rDuration, rSecret, rResol reverseRecord = uint256 (0 :: Int) referrer = B.replicate 32 0 -recordCalls :: SimplexTLD -> Registration -> [ByteString] -recordCalls tld Registration {rLabel, rContactLinks, rChannelLinks} = +recordCalls :: Registration -> [ByteString] +recordCalls Registration {rLabel, rTLD, rContactLinks, rChannelLinks} = [setText key ls | (key, ls) <- [("simplex.contact", rContactLinks), ("simplex.channel", rChannelLinks)], not (null ls)] where - setText key ls = selector "setText(bytes32,string,string)" <> abiTuple [Static node, Dynamic $ abiBytes key, Dynamic $ abiBytes $ encodeUtf8 $ T.intercalate "," ls] - node = namehash tld rLabel + setText key ls = selector "setText(bytes32,string,string)" <> abiTuple [Static node, Dynamic $ abiBytes key, Dynamic $ abiBytes $ encodeUtf8 $ T.intercalate ";" ls] + node = namehash rTLD rLabel namehash :: SimplexTLD -> Text -> ByteString namehash tld label = keccak256 $ tldNode <> keccak256 (encodeUtf8 label) diff --git a/src/Simplex/Chat/Badges/Code.hs b/src/Simplex/Chat/Badges/Code.hs index 1401f0824a..5f6c4a9cef 100644 --- a/src/Simplex/Chat/Badges/Code.hs +++ b/src/Simplex/Chat/Badges/Code.hs @@ -38,7 +38,6 @@ import Control.Concurrent.STM import Control.Monad (guard) import Crypto.Number.Serialize (i2ospOf_, os2ip) import Crypto.Random (ChaChaDRG) -import qualified Data.ByteArray as BA import Data.Bits (shiftR) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B @@ -151,19 +150,18 @@ parseNameCode t = do 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) - entropy = i2ospOf_ 16 payload :: ByteString - guard $ digest == checksum entropy - NameCode <$> eitherToMaybe (mkEntropy $ BA.convert entropy) + guard $ digest == checksum 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 - entropy = BA.convert (unEntropy e) :: ByteString - n = os2ip entropy * 2 ^ checksumBits + checksum entropy + payload = os2ip $ unEntropy e + n = payload * 2 ^ checksumBits + checksum payload values = reverse $ take nameCodeLength $ map (fromInteger . (`mod` toInteger base)) $ iterate (`div` toInteger base) n nameCodeEntropy :: NameCode -> WalletEntropy nameCodeEntropy (NameCode e) = e -checksum :: ByteString -> Integer -checksum = (`shiftR` (256 - checksumBits)) . os2ip . C.sha256Hash +checksum :: Integer -> Integer +checksum = (`shiftR` (256 - checksumBits)) . os2ip . C.sha256Hash . i2ospOf_ 16 diff --git a/tests/BadgeTests.hs b/tests/BadgeTests.hs index d9049f2ace..36828323ab 100644 --- a/tests/BadgeTests.hs +++ b/tests/BadgeTests.hs @@ -12,7 +12,6 @@ module BadgeTests (badgeTests) where import BadgeService.Service (badgeErrorRetryAfter) import Control.Concurrent.STM (atomically) import Control.Monad (forM_) -import qualified Data.ByteArray as BA import Data.ByteArray.Encoding (Base (Base16), convertToBase) import Data.ByteString.Char8 (ByteString) import Data.Map.Strict (Map) @@ -65,10 +64,7 @@ badgeTests = do it "hashes the canonical form, whatever was typed" testCodeHash describe "name codes" $ do it "encodes the entropy and its checksum" testNameCodeVectors - it "a generated name code reads back" testNameCodeRoundTrip - it "reads a name code as typed - any case, separators, ambiguous characters" testNameCodeNormalisation - it "rejects every single-character substitution and adjacent transposition" testNameCodeChecksum - it "rejects a malformed name code" testNameCodeMalformed + it "rejects a name code with a wrong character" testNameCodeChecksum 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 @@ -343,66 +339,21 @@ testNameCodeVectors :: IO () testNameCodeVectors = forM_ nameCodeVectors $ \(entropy, formatted) -> do let code = parseNameCode formatted - parsedNameCode formatted `shouldBe` Just formatted - (convertToBase Base16 . (BA.convert :: BA.ScrubbedBytes -> ByteString) . unEntropy . nameCodeEntropy) <$> code `shouldBe` Just entropy - -testNameCodeRoundTrip :: IO () -testNameCodeRoundTrip = do - drg <- C.newRandom - code <- randomNameCode drg - let formatted = formatNameCode code - T.length formatted `shouldBe` 38 -- SN-XXXXX-XXXXX-XXXXX-XXXXX-XXXXX-XXXXX - T.take 3 formatted `shouldBe` "SN-" - parsedNameCode formatted `shouldBe` Just formatted - -testNameCodeNormalisation :: IO () -testNameCodeNormalisation = do - parsedNameCode (T.toLower fixedNameCode) `shouldBe` Just fixedNameCode - parsedNameCode (T.replace "-" " " fixedNameCode) `shouldBe` Just fixedNameCode - parsedNameCode (T.filter (/= '-') fixedNameCode) `shouldBe` Just fixedNameCode - parsedNameCode (T.replace "SN-00000" "SN-OOOOO" zeroNameCode) `shouldBe` Just zeroNameCode + formatNameCode <$> code `shouldBe` Just formatted + convertToBase Base16 . unEntropy . nameCodeEntropy <$> code `shouldBe` Just entropy testNameCodeChecksum :: IO () -testNameCodeChecksum = do - forM_ [3 .. T.length fixedNameCode - 1] $ \i -> - forM_ ("0123456789ABCDEFGHJKMNPQRSTVWXYZ" :: String) $ \c -> - if T.index fixedNameCode i == '-' || T.index fixedNameCode i == c - then pure () - else parsedNameCode (replaceAt i c fixedNameCode) `shouldBe` Nothing - forM_ adjacentPairs $ \i -> - parsedNameCode (swapAt i fixedNameCode) `shouldBe` Nothing - where - replaceAt i c t = T.take i t <> T.singleton c <> T.drop (i + 1) t - swapAt i t = T.take i t <> T.singleton (T.index t (i + 1)) <> T.singleton (T.index t i) <> T.drop (i + 2) t - adjacentPairs = [i | i <- [3 .. T.length fixedNameCode - 2], let a = T.index fixedNameCode i; b = T.index fixedNameCode (i + 1), a /= '-', b /= '-', a /= b] - -testNameCodeMalformed :: IO () -testNameCodeMalformed = do - parsedNameCode "" `shouldBe` Nothing - parsedNameCode (T.drop 3 fixedNameCode) `shouldBe` Nothing - parsedNameCode ("SB" <> T.drop 2 fixedNameCode) `shouldBe` Nothing - parsedNameCode (T.dropEnd 1 fixedNameCode) `shouldBe` Nothing - parsedNameCode (fixedNameCode <> "0") `shouldBe` Nothing - parsedNameCode (T.replace "KT45V" "KT45U" fixedNameCode) `shouldBe` Nothing - -parsedNameCode :: T.Text -> Maybe T.Text -parsedNameCode = fmap formatNameCode . parseNameCode +testNameCodeChecksum = + isNothing (parseNameCode "SN-KT45V-59ATD-HCNTT-EZRTA-HT8VT-8A0BV") `shouldBe` True -- entropy and its name code, computed by a separate Python implementation of the format nameCodeVectors :: [(ByteString, T.Text)] nameCodeVectors = - [ ("00000000000000000000000000000000", zeroNameCode), - ("7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f", "SN-FXZQY-ZVZFX-ZQYZV-ZFXZQ-YZVZF-Y3XSQ"), + [ ("00000000000000000000000000000000", "SN-00000-00000-00000-00000-00000-0VME2"), ("ffffffffffffffffffffffffffffffff", "SN-ZZZZZ-ZZZZZ-ZZZZZ-ZZZZZ-ZZZZZ-XDCD9"), - ("9e885d952ad362caeb4efe34a8e91bd2", fixedNameCode) + ("9e885d952ad362caeb4efe34a8e91bd2", "SN-KT45V-59ATD-HCNTT-EZRTA-HT8VT-8A0BT") ] -zeroNameCode :: T.Text -zeroNameCode = "SN-00000-00000-00000-00000-00000-0VME2" - -fixedNameCode :: T.Text -fixedNameCode = "SN-KT45V-59ATD-HCNTT-EZRTA-HT8VT-8A0BT" - -- Ledger transitions, against plans/2026-07-30-supporter-badges-v3-ux.md ยง3 at :: Integer -> Int -> Int -> UTCTime diff --git a/tests/Bots/BadgeService/FakeEthNode.hs b/tests/Bots/BadgeService/FakeEthNode.hs index 4544347910..6ec0815666 100644 --- a/tests/Bots/BadgeService/FakeEthNode.hs +++ b/tests/Bots/BadgeService/FakeEthNode.hs @@ -5,9 +5,7 @@ module Bots.BadgeService.FakeEthNode ( FakeEthNode (..), withFakeEthNode, revertCalls, - failCalls, sentTransactions, - requestedMethods, fakeGas, fakeTip, fakeBaseFee, @@ -30,6 +28,7 @@ import Network.Wai (Application, responseLBS, strictRequestBody) import qualified Network.Wai.Handler.Warp as Warp import Numeric (showHex) import Simplex.Messaging.Crypto (keccak256) +import Simplex.Messaging.Util (eitherToMaybe) data FakeEthNode = FakeEthNode { fnUrl :: String, @@ -39,8 +38,6 @@ data FakeEthNode = FakeEthNode data FakeState = FakeState { fsRevert :: Maybe ByteString, - fsFailure :: Maybe Text, - fsMethods :: [Text], fsSent :: [ByteString] } @@ -51,7 +48,7 @@ fakeBaseFee = 2000000000 withFakeEthNode :: (FakeEthNode -> IO a) -> IO a withFakeEthNode action = do - fnState <- newTVarIO FakeState {fsRevert = Nothing, fsFailure = Nothing, fsMethods = [], fsSent = []} + fnState <- newTVarIO FakeState {fsRevert = Nothing, fsSent = []} fnManager <- HTTP.newManager HTTP.defaultManagerSettings Warp.testWithApplication (pure $ fakeApp fnState) $ \port -> action FakeEthNode {fnUrl = "http://127.0.0.1:" <> show port, fnManager, fnState} @@ -59,15 +56,9 @@ withFakeEthNode action = do revertCalls :: FakeEthNode -> ByteString -> IO () revertCalls FakeEthNode {fnState} revert = atomically $ modifyTVar' fnState $ \s -> s {fsRevert = Just revert} -failCalls :: FakeEthNode -> Text -> IO () -failCalls FakeEthNode {fnState} message = atomically $ modifyTVar' fnState $ \s -> s {fsFailure = Just message} - sentTransactions :: FakeEthNode -> IO [ByteString] sentTransactions FakeEthNode {fnState} = reverse . fsSent <$> readTVarIO fnState -requestedMethods :: FakeEthNode -> IO [Text] -requestedMethods FakeEthNode {fnState} = reverse . fsMethods <$> readTVarIO fnState - fakeApp :: TVar FakeState -> Application fakeApp st req respond = do body <- strictRequestBody req @@ -81,15 +72,12 @@ fakeApp st req respond = do answer :: TVar FakeState -> Text -> [J.Value] -> STM [JT.Pair] answer st method params = do - modifyTVar' st $ \s -> s {fsMethods = method : fsMethods s} - FakeState {fsRevert, fsFailure, fsSent} <- readTVar st + FakeState {fsRevert, fsSent} <- readTVar st case (method, params) of - ("eth_call", _) | Just message <- fsFailure -> pure ["error" .= J.object ["code" .= (-32603 :: Int), "message" .= message, "data" .= J.object ["message" .= message]]] - ("eth_call", _) -> pure $ maybe (result $ hex "") reverted fsRevert ("eth_estimateGas", _) -> pure $ maybe (result $ quantity fakeGas) reverted fsRevert ("eth_getTransactionCount", _) -> pure $ result $ quantity $ toInteger $ length fsSent ("eth_maxPriorityFeePerGas", _) -> pure $ result $ quantity fakeTip - ("eth_getBlockByNumber", _) -> pure ["result" .= J.object ["baseFeePerGas" .= quantity fakeBaseFee]] + ("eth_getBlockByNumber", _) -> pure $ result $ J.object ["baseFeePerGas" .= quantity fakeBaseFee] ("eth_sendRawTransaction", [J.String raw]) | Just tx <- fromHex raw -> do modifyTVar' st $ \s -> s {fsSent = tx : fsSent} pure $ result $ hex $ keccak256 tx @@ -105,4 +93,4 @@ hex :: ByteString -> Text hex bs = "0x" <> decodeLatin1 (convertToBase Base16 bs) fromHex :: Text -> Maybe ByteString -fromHex t = T.stripPrefix "0x" t >>= either (const Nothing) Just . convertFromBase Base16 . encodeUtf8 +fromHex t = T.stripPrefix "0x" t >>= eitherToMaybe . convertFromBase Base16 . encodeUtf8 diff --git a/tests/Bots/BadgeService/NameRegistrationTests.hs b/tests/Bots/BadgeService/NameRegistrationTests.hs index 93e12f1680..a150422695 100644 --- a/tests/Bots/BadgeService/NameRegistrationTests.hs +++ b/tests/Bots/BadgeService/NameRegistrationTests.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -9,16 +8,13 @@ import BadgeService.Names.Registration import Bots.BadgeService.FakeEthNode import Bots.BadgeService.WebUIMock import Control.Concurrent.STM (TVar, atomically) -import Control.Monad (forM_) import Crypto.Random (ChaChaDRG) import qualified Data.ByteArray as BA -import Data.ByteArray.Encoding (Base (Base16), convertFromBase, convertToBase) +import Data.ByteArray.Encoding (Base (Base16), convertToBase) import Data.ByteString (ByteString) import qualified Data.ByteString as B -import Data.Either (isLeft, isRight) +import Data.Either (isLeft) import Data.Text (Text) -import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8) import Data.Word (Word64) import qualified Simplex.Messaging.Crypto as C import qualified Simplex.Messaging.Crypto.Secp256k1 as S @@ -29,193 +25,79 @@ import Simplex.Messaging.Eth.Transaction (Eip1559Tx (..), signEip1559Tx) import Simplex.Messaging.SimplexName (SimplexTLD (..)) import Test.Hspec --- expected encodings, digests and signatures are viem's, against the SimplexController, SimplexSponsor and SimplexResolver ABIs +-- expected encodings and signatures are viem's, against the SimplexController, SimplexSponsor and SimplexResolver ABIs badgeNameRegistrationTests :: Spec badgeNameRegistrationTests = describe "badge service name registration" $ do g <- runIO C.newRandom describe "encoding" $ do - it "computes the commitment of a registration with records" testCommitmentWithRecords - it "computes the commitment of a registration without records" testCommitmentWithoutRecords + 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 - describe "web UI mock" $ do - it "derives the wallet of a known redemption code" $ testKnownCode g - it "recovers a new wallet from its redemption code" $ testCodeRoundTrip g - it "refuses a malformed redemption code" $ testMalformedCode g - it "signs the register intent as viem does" $ testSignIntent g describe "verifying the register intent" $ do - it "accepts an intent signed by the owner" $ testVerifyAccepts g it "refuses an intent signed by another wallet" $ testVerifyOtherSigner g it "refuses an intent past its deadline" $ testVerifyExpired g - it "refuses an intent signed for another chain" $ testVerifyOtherChain g it "refuses a secret that is not 32 bytes" $ testVerifyShortSecret g - describe "sending transactions" $ do - it "sends a commit after a dry run" $ testSendCommit g - it "sends a registration after a dry run" $ testSendRegister g - it "takes the next nonce for the next transaction" $ testNextNonce g - it "sends nothing when the dry run reverts, and reports a taken name" $ testTakenName g - it "reports an unknown revert with its data" $ testUnknownRevert g - it "reports a node error that carries no revert data" $ testNodeError g - it "reports an unreachable node" $ testUnreachableNode g + it "sends nothing when the dry run reverts" $ testRevertedDryRun g it "registers a name the client committed to without revealing it" $ testCommitThenRegister g -testCommitmentWithRecords :: IO () -testCommitmentWithRecords = - toHex (makeCommitment TLDSimplex withRecords) `shouldBe` "3db21bcf81cbd618087a5de5663806b4183a9594de3432e99c1397baa0d42388" - -testCommitmentWithoutRecords :: IO () -testCommitmentWithoutRecords = - toHex (makeCommitment TLDSimplex withoutRecords) `shouldBe` "2ad83879b550f411f866b54e40cb295faa985452a00988a5a5a8467a5e526a56" +testCommitment :: IO () +testCommitment = + toHex (makeCommitment withRecords) `shouldBe` "43aeb4617085160f4dc7ad495d1119f39bca441276b1990123fd3ecb8a40a360" testRegisterCalldataWithRecords :: TVar ChaChaDRG -> IO () testRegisterCalldataWithRecords g = do intent <- knownIntent g withRecords - toHex (registerWithCreditCalldata TLDSimplex intent) - `shouldBe` "88596f95000000000000000000000000000000000000000000000000000000000000006000000000000000000000000000000000000000000000000000000000f4865700000000000000000000000000000000000000000000000000000000000000046000000000000000000000000000000000000000000000000000000000000001000000000000000000000000009858effd232b4033e47d90003d41ec34ecaeda940000000000000000000000000000000000000000000000000000000003c2670011111111111111111111111111111111111111111111111111111111111111110000000000000000000000002279b7a0a67db372996a5fab50d91eaa73d2ebe6000000000000000000000000000000000000000000000000000000000000014000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000762616b657279310000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000020000000000000000000000000000000000000000000000000000000000000040000000000000000000000000000000000000000000000000000000000000016000000000000000000000000000000000000000000000000000000000000000e410f13a8c58c186cadf476923d25ea4950487d1aaf21906ba5574c87f5b9435b61b994370000000000000000000000000000000000000000000000000000000000000006000000000000000000000000000000000000000000000000000000000000000a0000000000000000000000000000000000000000000000000000000000000000f73696d706c65782e636f6e746163740000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002068747470733a2f2f736d702e73696d706c65782e696d2f6123636f6e7461637400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010410f13a8c58c186cadf476923d25ea4950487d1aaf21906ba5574c87f5b9435b61b994370000000000000000000000000000000000000000000000000000000000000006000000000000000000000000000000000000000000000000000000000000000a0000000000000000000000000000000000000000000000000000000000000000f73696d706c65782e6368616e6e656c0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003b68747470733a2f2f736d70312e73696d706c65782e696d2f63236f6e652c68747470733a2f2f736d70322e73696d706c65782e696d2f632374776f00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000416f3523d47b84472a87fb202747dd95453c5c0d89257a65fd8f083da8da55c90b6ffa608c3b7365f127e2a5b3f6c3abde911976f3fb5593041a2facc6f2c8499f1c00000000000000000000000000000000000000000000000000000000000000" + toHex (registerWithCreditCalldata intent) + `shouldBe` "88596f95000000000000000000000000000000000000000000000000000000000000006000000000000000000000000000000000000000000000000000000000f4865700000000000000000000000000000000000000000000000000000000000000046000000000000000000000000000000000000000000000000000000000000001000000000000000000000000009858effd232b4033e47d90003d41ec34ecaeda940000000000000000000000000000000000000000000000000000000003c2670011111111111111111111111111111111111111111111111111111111111111110000000000000000000000002279b7a0a67db372996a5fab50d91eaa73d2ebe6000000000000000000000000000000000000000000000000000000000000014000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000762616b657279310000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000020000000000000000000000000000000000000000000000000000000000000040000000000000000000000000000000000000000000000000000000000000016000000000000000000000000000000000000000000000000000000000000000e410f13a8c58c186cadf476923d25ea4950487d1aaf21906ba5574c87f5b9435b61b994370000000000000000000000000000000000000000000000000000000000000006000000000000000000000000000000000000000000000000000000000000000a0000000000000000000000000000000000000000000000000000000000000000f73696d706c65782e636f6e746163740000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002068747470733a2f2f736d702e73696d706c65782e696d2f6123636f6e7461637400000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000010410f13a8c58c186cadf476923d25ea4950487d1aaf21906ba5574c87f5b9435b61b994370000000000000000000000000000000000000000000000000000000000000006000000000000000000000000000000000000000000000000000000000000000a0000000000000000000000000000000000000000000000000000000000000000f73696d706c65782e6368616e6e656c0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003b68747470733a2f2f736d70312e73696d706c65782e696d2f63236f6e653b68747470733a2f2f736d70322e73696d706c65782e696d2f632374776f00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000412de2e4a88b03d3f6ea59855699ac50d2c19ecf8ca705203ef407d3604bc585b5012ce66b1c22eced32a151acdfc3dab92789477caf68c9d5ea4a76923ad01b321b00000000000000000000000000000000000000000000000000000000000000" testRegisterCalldataWithoutRecords :: TVar ChaChaDRG -> IO () testRegisterCalldataWithoutRecords g = do - intent <- knownIntent g withoutRecords - toHex (registerWithCreditCalldata TLDSimplex intent) + intent <- knownIntent g withRecords {rContactLinks = [], rChannelLinks = []} + toHex (registerWithCreditCalldata intent) `shouldBe` "88596f95000000000000000000000000000000000000000000000000000000000000006000000000000000000000000000000000000000000000000000000000f486570000000000000000000000000000000000000000000000000000000000000001c000000000000000000000000000000000000000000000000000000000000001000000000000000000000000009858effd232b4033e47d90003d41ec34ecaeda940000000000000000000000000000000000000000000000000000000003c2670011111111111111111111111111111111111111111111111111111111111111110000000000000000000000002279b7a0a67db372996a5fab50d91eaa73d2ebe6000000000000000000000000000000000000000000000000000000000000014000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000762616b6572793100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000419c00341dd00caef7f36d04bdc23c033b7729787f3e4cb0768f27bbaa1eb86ec7622cc03ec147bc37efb953cf2029381ec399e1c393e5aefa44f6ca5d4c6995851b00000000000000000000000000000000000000000000000000000000000000" testCommitCalldata :: IO () testCommitCalldata = toHex (commitCalldata $ B.replicate 32 0x22) `shouldBe` "f14fcbc82222222222222222222222222222222222222222222222222222222222222222" -testKnownCode :: TVar ChaChaDRG -> IO () -testKnownCode g = do - w <- knownWallet g - ewAddress w `shouldBe` knownOwner - redemptionCode w `shouldBe` knownCode - -testCodeRoundTrip :: TVar ChaChaDRG -> IO () -testCodeRoundTrip g = do - w <- newEphemeralWallet g - (fmap ewAddress <$> walletFromCode g (redemptionCode w)) `shouldReturn` Right (ewAddress w) - -testMalformedCode :: TVar ChaChaDRG -> IO () -testMalformedCode g = - forM_ [T.replace "0VME2" "0VME3" knownCode, T.dropEnd 1 knownCode, T.drop 3 knownCode] $ \code -> - (isLeft <$> walletFromCode g code) `shouldReturn` True - -testSignIntent :: TVar ChaChaDRG -> IO () -testSignIntent g = do - w <- knownWallet g - RegisterIntent {riSignature} <- right <$> signRegisterIntent g TLDSimplex domain w withRecords deadline - riSignature - `shouldBe` S.RecoverableSignature - { S.rsR = hx "6f3523d47b84472a87fb202747dd95453c5c0d89257a65fd8f083da8da55c90b", - S.rsS = hx "6ffa608c3b7365f127e2a5b3f6c3abde911976f3fb5593041a2facc6f2c8499f", - S.rsRecId = 1 - } - -testVerifyAccepts :: TVar ChaChaDRG -> IO () -testVerifyAccepts g = do - w <- knownWallet g - intent <- right <$> signRegisterIntent g TLDSimplex domain w withRecords deadline - (fmap (makeCommitment TLDSimplex) <$> verifyRegisterIntent TLDSimplex domain beforeDeadline intent) - `shouldReturn` Right (makeCommitment TLDSimplex withRecords) - testVerifyOtherSigner :: TVar ChaChaDRG -> IO () testVerifyOtherSigner g = do other <- newEphemeralWallet g - intent <- right <$> signRegisterIntent g TLDSimplex domain other withRecords deadline - (isLeft <$> verifyRegisterIntent TLDSimplex domain beforeDeadline intent) `shouldReturn` True + intent <- right <$> signRegisterIntent g domain other withRecords deadline + (isLeft <$> verifyRegisterIntent domain beforeDeadline intent) `shouldReturn` True testVerifyExpired :: TVar ChaChaDRG -> IO () testVerifyExpired g = do - w <- knownWallet g - intent <- right <$> signRegisterIntent g TLDSimplex domain w withRecords deadline - (isLeft <$> verifyRegisterIntent TLDSimplex domain (deadline + 1) intent) `shouldReturn` True - -testVerifyOtherChain :: TVar ChaChaDRG -> IO () -testVerifyOtherChain g = do - w <- knownWallet g - intent <- right <$> signRegisterIntent g TLDSimplex (sponsorDomain 1 sponsor) w withRecords deadline - (isLeft <$> verifyRegisterIntent TLDSimplex domain beforeDeadline intent) `shouldReturn` True + intent <- knownIntent g withRecords + (isLeft <$> verifyRegisterIntent domain (deadline + 1) intent) `shouldReturn` True testVerifyShortSecret :: TVar ChaChaDRG -> IO () testVerifyShortSecret g = do - w <- knownWallet g - intent <- right <$> signRegisterIntent g TLDSimplex domain w withRecords {rSecret = B.replicate 31 0x11} deadline - (isLeft <$> verifyRegisterIntent TLDSimplex domain beforeDeadline intent) `shouldReturn` True + intent <- knownIntent g withRecords {rSecret = B.replicate 31 0x11} + (isLeft <$> verifyRegisterIntent domain beforeDeadline intent) `shouldReturn` True -testSendCommit :: TVar ChaChaDRG -> IO () -testSendCommit g = withFakeEthNode $ \node -> do - let calldata = commitCalldata commitment - raw <- expectedTransaction g 0 controller calldata - sendCommit g (chainClient node) commitment `shouldReturn` Right (TxHash $ C.keccak256 raw) - sentTransactions node `shouldReturn` [raw] - requestedMethods node `shouldReturn` sendMethods - where - commitment = makeCommitment TLDSimplex withRecords - -testSendRegister :: TVar ChaChaDRG -> IO () -testSendRegister g = withFakeEthNode $ \node -> do +testRevertedDryRun :: TVar ChaChaDRG -> IO () +testRevertedDryRun g = withFakeEthNode $ \node -> do + revertCalls node "reverted" intent <- knownIntent g withRecords - raw <- expectedTransaction g 0 sponsor $ registerWithCreditCalldata TLDSimplex intent - sendRegister g (chainClient node) TLDSimplex intent `shouldReturn` Right (TxHash $ C.keccak256 raw) - sentTransactions node `shouldReturn` [raw] - requestedMethods node `shouldReturn` sendMethods - -testNextNonce :: TVar ChaChaDRG -> IO () -testNextNonce g = withFakeEthNode $ \node -> do - let commitment = makeCommitment TLDSimplex withRecords - intent <- knownIntent g withRecords - raw0 <- expectedTransaction g 0 controller $ commitCalldata commitment - raw1 <- expectedTransaction g 1 sponsor $ registerWithCreditCalldata TLDSimplex intent - _ <- sendCommit g (chainClient node) commitment - _ <- sendRegister g (chainClient node) TLDSimplex intent - sentTransactions node `shouldReturn` [raw0, raw1] - -testTakenName :: TVar ChaChaDRG -> IO () -testTakenName g = withFakeEthNode $ \node -> do - revertCalls node $ selector "NameNotAvailable(string)" <> B.replicate 96 0 - intent <- knownIntent g withRecords - sendRegister g (chainClient node) TLDSimplex intent `shouldReturn` Left (CEReverted NameNotAvailable) - sentTransactions node `shouldReturn` [] - requestedMethods node `shouldReturn` ["eth_call"] - -testUnknownRevert :: TVar ChaChaDRG -> IO () -testUnknownRevert g = withFakeEthNode $ \node -> do - let revert = selector "NameReserved(string)" <> B.replicate 96 0 - revertCalls node revert - intent <- knownIntent g withRecords - sendRegister g (chainClient node) TLDSimplex intent `shouldReturn` Left (CEReverted $ UnknownRevert revert) - sentTransactions node `shouldReturn` [] - -testNodeError :: TVar ChaChaDRG -> IO () -testNodeError g = withFakeEthNode $ \node -> do - failCalls node "Internal error" - intent <- knownIntent g withRecords - sendRegister g (chainClient node) TLDSimplex intent `shouldReturn` Left (CERpc "Internal error") - sentTransactions node `shouldReturn` [] - -testUnreachableNode :: TVar ChaChaDRG -> IO () -testUnreachableNode g = withFakeEthNode $ \node -> do - r <- sendCommit g (chainClient node) {ccRpcUrl = "http://127.0.0.1:1"} $ B.replicate 32 0x22 - r `shouldSatisfy` \case - Left (CERpc _) -> True - _ -> False + sendRegister g (chainClient node) intent `shouldReturn` Left (CEReverted "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} - commitment = makeCommitment TLDSimplex registration - (isRight <$> sendCommit g (chainClient node) commitment) `shouldReturn` True - intent <- right <$> signRegisterIntent g TLDSimplex domain w registration deadline - verified <- right <$> verifyRegisterIntent TLDSimplex domain beforeDeadline intent - makeCommitment TLDSimplex verified `shouldBe` commitment - (isRight <$> sendRegister g (chainClient node) TLDSimplex intent) `shouldReturn` True + commitment = makeCommitment registration commitTx <- expectedTransaction g 0 controller $ commitCalldata commitment - registerTx <- expectedTransaction g 1 sponsor $ registerWithCreditCalldata TLDSimplex intent + 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 () + registerTx <- expectedTransaction g 1 sponsor $ registerWithCreditCalldata intent + sendRegister g (chainClient node) intent `shouldReturn` Right (TxHash $ C.keccak256 registerTx) sentTransactions node `shouldReturn` [commitTx, registerTx] - encodeUtf8 (rLabel registration) `B.isInfixOf` commitTx `shouldBe` False -- fixtures @@ -223,7 +105,8 @@ withRecords :: Registration withRecords = Registration { rLabel = "bakery1", - rOwner = knownOwner, + rTLD = TLDSimplex, + rOwner = address "0x9858EfFD232B4033E47d90003D41EC34EcaEda94", rDuration = 63072000, rSecret = B.replicate 32 0x11, rResolver = address "0x2279b7a0a67db372996a5fab50d91eaa73d2ebe6", @@ -231,23 +114,14 @@ withRecords = rChannelLinks = ["https://smp1.simplex.im/c#one", "https://smp2.simplex.im/c#two"] } -withoutRecords :: Registration -withoutRecords = withRecords {rContactLinks = [], rChannelLinks = []} - knownIntent :: TVar ChaChaDRG -> Registration -> IO RegisterIntent knownIntent g r = do - w <- knownWallet g - right <$> signRegisterIntent g TLDSimplex domain w r deadline - -knownWallet :: TVar ChaChaDRG -> IO EphemeralWallet -knownWallet g = right <$> walletFromCode g knownCode + w <- right <$> walletFromCode g knownCode + right <$> signRegisterIntent g domain w r deadline knownCode :: Text knownCode = "SN-00000-00000-00000-00000-00000-0VME2" -knownOwner :: Address -knownOwner = address "0x9858EfFD232B4033E47d90003D41EC34EcaEda94" - controller, sponsor :: Address controller = address "0x0165878a594ca255338adfa4d48449f69242eb8f" sponsor = address "0x9a676e781a523b5d0c0e43731313a708cb607508" @@ -269,9 +143,6 @@ chainClient :: FakeEthNode -> ChainClient chainClient FakeEthNode {fnUrl, fnManager} = ChainClient {ccManager = fnManager, ccRpcUrl = fnUrl, ccChainId = chainId, ccController = controller, ccSponsor = sponsor, ccRegistrarKey = registrarKey} -sendMethods :: [Text] -sendMethods = ["eth_call", "eth_estimateGas", "eth_getTransactionCount", "eth_maxPriorityFeePerGas", "eth_getBlockByNumber", "eth_sendRawTransaction"] - expectedTransaction :: TVar ChaChaDRG -> Word64 -> Address -> ByteString -> IO ByteString expectedTransaction g nonce to calldata = right @@ -292,9 +163,6 @@ expectedTransaction g nonce to calldata = address :: ByteString -> Address address = right . strDecode -hx :: ByteString -> ByteString -hx = right . convertFromBase Base16 - toHex :: ByteString -> ByteString toHex = convertToBase Base16 diff --git a/tests/Bots/BadgeService/WebUIMock.hs b/tests/Bots/BadgeService/WebUIMock.hs index 1103cf6ccc..688d008999 100644 --- a/tests/Bots/BadgeService/WebUIMock.hs +++ b/tests/Bots/BadgeService/WebUIMock.hs @@ -23,7 +23,7 @@ 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.SimplexName (SimplexTLD) +import Simplex.Messaging.Util ((<$$>)) data EphemeralWallet = EphemeralWallet { ewCode :: NameCode, @@ -40,11 +40,9 @@ redemptionCode = formatNameCode . ewCode walletFromCode :: TVar ChaChaDRG -> Text -> IO (Either String EphemeralWallet) walletFromCode g = maybe (pure $ Left "invalid name code") (walletFromNameCode g) . parseNameCode -signRegisterIntent :: TVar ChaChaDRG -> SimplexTLD -> Eip712Domain -> EphemeralWallet -> Registration -> Word64 -> IO (Either String RegisterIntent) -signRegisterIntent g tld domain EphemeralWallet {ewKey} riRegistration riDeadline = runExceptT $ do - digest <- liftEither $ registerIntentDigest tld domain riRegistration riDeadline - riSignature <- ExceptT $ signRecoverable g ewKey digest - pure RegisterIntent {riRegistration, riDeadline, riSignature} +signRegisterIntent :: TVar ChaChaDRG -> Eip712Domain -> EphemeralWallet -> Registration -> Word64 -> IO (Either String RegisterIntent) +signRegisterIntent g domain EphemeralWallet {ewKey} r deadline = + RegisterIntent r deadline <$$> signRecoverable g ewKey (registerIntentDigest domain r deadline) walletFromNameCode :: TVar ChaChaDRG -> NameCode -> IO (Either String EphemeralWallet) walletFromNameCode g ewCode = runExceptT $ do