mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-11-04 08:37:30 +00:00
2 rounds of goal iter
This commit is contained in:
Alain Brenzikofer committed
1 parent
1cee07dd9f
commit
2356e00e33
7 files changed
+107
-343
No files matched your search
@@ -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)
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
+7
-56
@@ -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
|
||||
|
||||
@@ -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
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in new issue
Block a user