mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-11-04 12:57:45 +00:00
store: merge names contract reads
# Conflicts: # simplex-chat.cabal # tests/Test.hs
This commit is contained in:
shum committed
commit
ffeddbcea3
10 files changed
+679
-59
No files matched your search
@@ -13,6 +13,7 @@ module StoreService.Names.Abi
|
||||
selector,
|
||||
hex,
|
||||
decodeUint256,
|
||||
decodeWord64,
|
||||
decodeAddress,
|
||||
decodeBool,
|
||||
decodeBytes32,
|
||||
@@ -31,6 +32,7 @@ import qualified Data.ByteString as B
|
||||
import Data.List (mapAccumL)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (decodeLatin1, decodeUtf8')
|
||||
import Data.Word (Word64)
|
||||
import Simplex.Messaging.Crypto (keccak256)
|
||||
import Simplex.Messaging.Encoding.String (strDecode)
|
||||
import Simplex.Messaging.Eth.Address (Address, unAddress)
|
||||
@@ -43,6 +45,7 @@ data AbiError
|
||||
| AENotAddress
|
||||
| AENotBool
|
||||
| AENotUtf8
|
||||
| AERange
|
||||
deriving (Eq, Show)
|
||||
|
||||
abiWordSize :: Int
|
||||
@@ -80,6 +83,11 @@ hex bs = "0x" <> decodeLatin1 (convertToBase Base16 bs)
|
||||
decodeUint256 :: ByteString -> Either AbiError Integer
|
||||
decodeUint256 = uintAt 0
|
||||
|
||||
decodeWord64 :: ByteString -> Either AbiError Word64
|
||||
decodeWord64 ret = do
|
||||
n <- decodeUint256 ret
|
||||
if n <= toInteger (maxBound :: Word64) then Right (fromInteger n) else Left AERange
|
||||
|
||||
decodeAddress :: ByteString -> Either AbiError Address
|
||||
decodeAddress ret = do
|
||||
(padding, a) <- B.splitAt addressPadding <$> wordAt 0 ret
|
||||
|
||||
@@ -30,7 +30,7 @@ where
|
||||
|
||||
import Control.Concurrent.STM (TVar)
|
||||
import Control.Exception (evaluate, try)
|
||||
import Control.Monad ((>=>))
|
||||
import Control.Monad ((<=<), (>=>))
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.Aeson ((.:), (.:?), (.=))
|
||||
import qualified Data.Aeson as J
|
||||
@@ -55,7 +55,7 @@ import Simplex.Messaging.Util (tshow)
|
||||
import StoreService.Config (ChainConfig (..))
|
||||
import StoreService.Log (logWarn)
|
||||
import StoreService.Names.Abi (hex)
|
||||
import StoreService.Names.Revert (RevertName, decodeRevert)
|
||||
import StoreService.Names.Revert (RevertName (..), decodeRevert)
|
||||
import System.Timeout (timeout)
|
||||
|
||||
data ChainClient = ChainClient
|
||||
@@ -227,7 +227,7 @@ rpc ChainClient {ccManager, ccConfig = ChainConfig {cRpcUrl}, ccTimeout} method
|
||||
revertData <- e .:? "data"
|
||||
pure $
|
||||
if code == revertCode || "execution reverted" `T.isPrefixOf` message
|
||||
then ChainReverted $ decodeRevert =<< (JT.parseMaybe bytes =<< revertData)
|
||||
then ChainReverted $ maybe (Just RNWithoutData) (decodeRevert <=< JT.parseMaybe bytes) revertData
|
||||
else unavailable $ "error " <> tshow code <> ": " <> T.take maxNodeMessageLength message
|
||||
unavailable reason = ChainUnavailable $ method <> ": " <> reason
|
||||
|
||||
|
||||
@@ -0,0 +1,220 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module StoreService.Names.Contracts
|
||||
( Contracts (ctDeadline),
|
||||
NameStatus (..),
|
||||
RegisteredName (..),
|
||||
NameRecords (..),
|
||||
CommitmentAges (..),
|
||||
newContracts,
|
||||
secondsPerYear,
|
||||
nameStatus,
|
||||
nameRecords,
|
||||
chainPriceCents,
|
||||
codeLengthFor,
|
||||
sponsorNonce,
|
||||
resolverNonce,
|
||||
ownerOfToken,
|
||||
nameExpires,
|
||||
commitmentTime,
|
||||
controllerAvailable,
|
||||
commitmentAges,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Concurrent.Async (Concurrently (..))
|
||||
import Control.Monad.Except (ExceptT (..), runExceptT)
|
||||
import Data.Bifunctor (first)
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.IORef (IORef, atomicWriteIORef, newIORef, readIORef)
|
||||
import Data.Functor.Compose (Compose (..))
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
|
||||
import Data.Word (Word64)
|
||||
import Simplex.Chat.Badges.Code (maxNameLength, minNameLength)
|
||||
import Simplex.Messaging.Eth.Address (Address)
|
||||
import Simplex.Messaging.SimplexName (LabelHash (..), SimplexTLD)
|
||||
import Simplex.Messaging.Util (tshow)
|
||||
import StoreService.Config (ChainConfig (..))
|
||||
import StoreService.Names.Abi
|
||||
import StoreService.Names.Chain (Block (..), ChainClient (..), ChainError (..), ethCall, latestBlock)
|
||||
import StoreService.Names.Registration (channelRecordKey, contactRecordKey, labelNode, nodeBytes)
|
||||
import StoreService.Names.Revert (RevertName (..))
|
||||
import System.Timeout (timeout)
|
||||
|
||||
data Contracts = Contracts
|
||||
{ ctChain :: ChainClient,
|
||||
ctTLD :: SimplexTLD,
|
||||
ctRegistrar :: IORef (Maybe RegistrarConstants),
|
||||
ctCommitmentAges :: IORef (Maybe CommitmentAges),
|
||||
-- | microseconds for all the reads of one name status or of one name's records
|
||||
ctDeadline :: Int
|
||||
}
|
||||
|
||||
data RegistrarConstants = RegistrarConstants {rcRegistry :: Address, rcGracePeriod :: Integer}
|
||||
|
||||
data NameStatus = NSAvailable | NSReserved | NSRegistered RegisteredName
|
||||
deriving (Eq, Show)
|
||||
|
||||
data RegisteredName = RegisteredName
|
||||
{ rnOwner :: Address,
|
||||
rnResolver :: Address,
|
||||
rnExpiresAt :: Word64,
|
||||
rnGracePeriod :: Integer
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | The default resolver's records ("" when unset) and the owner's nonce for the next edit.
|
||||
data NameRecords = NameRecords {rdContact :: Text, rdChannel :: Text, rdNonce :: Word64}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data CommitmentAges = CommitmentAges {caMin :: Integer, caMax :: Integer}
|
||||
deriving (Eq, Show)
|
||||
|
||||
secondsPerYear :: Integer
|
||||
secondsPerYear = 31536000
|
||||
|
||||
attoUsdPerCent :: Integer
|
||||
attoUsdPerCent = 10 ^ (16 :: Int)
|
||||
|
||||
-- | One call's timeout, so a node that hangs fails a status or a records read once, not once per read.
|
||||
nameReadsDeadline :: Int
|
||||
nameReadsDeadline = 10000000
|
||||
|
||||
-- | Reads nothing: the registrar's constants and the commitment ages are read on first use and kept once read.
|
||||
newContracts :: SimplexTLD -> ChainClient -> IO Contracts
|
||||
newContracts ctTLD ctChain = do
|
||||
ctRegistrar <- newIORef Nothing
|
||||
ctCommitmentAges <- newIORef Nothing
|
||||
pure Contracts {ctChain, ctTLD, ctRegistrar, ctCommitmentAges, ctDeadline = nameReadsDeadline}
|
||||
|
||||
-- | Registered while @nameExpires + GRACE_PERIOD@ is not before the latest block's time.
|
||||
nameStatus :: Contracts -> LabelHash -> IO (Either ChainError NameStatus)
|
||||
nameStatus ct@Contracts {ctChain} lh = withinDeadline ct "name status" $ runExceptT $ do
|
||||
(RegistrarConstants {rcRegistry, rcGracePeriod}, expires, Block {blockTimestamp}) <-
|
||||
ExceptT $ together $ (,,) <$> concurrent (registrarConstants ct) <*> concurrent (nameExpires ct lh) <*> concurrent (latestBlock ctChain)
|
||||
if toInteger expires + rcGracePeriod >= toInteger blockTimestamp
|
||||
then do
|
||||
let node = nodeArg ct lh
|
||||
registryRead signature = concurrent $ call ct rcRegistry (signature, node) decodeAddress
|
||||
(rnOwner, rnResolver) <- ExceptT $ together $ (,) <$> registryRead "owner(bytes32)" <*> registryRead "resolver(bytes32)"
|
||||
pure $ NSRegistered RegisteredName {rnOwner, rnResolver, rnExpiresAt = expires, rnGracePeriod = rcGracePeriod}
|
||||
else do
|
||||
reason <- ExceptT $ call ct (controller ct) ("reservedNames(bytes32)", labelHashArg lh) decodeUint256
|
||||
pure $ if reason /= 0 then NSReserved else NSAvailable
|
||||
|
||||
-- | Nothing for a name on another resolver contract, or none: the service reads no records from a contract it does not know.
|
||||
nameRecords :: Contracts -> LabelHash -> RegisteredName -> IO (Either ChainError (Maybe NameRecords))
|
||||
nameRecords ct lh RegisteredName {rnOwner, rnResolver}
|
||||
| rnResolver /= resolver ct = pure $ Right Nothing
|
||||
| otherwise =
|
||||
withinDeadline ct "name records" $ together $
|
||||
(\rdContact rdChannel rdNonce -> Just NameRecords {rdContact, rdChannel, rdNonce})
|
||||
<$> textRecord contactRecordKey
|
||||
<*> textRecord channelRecordKey
|
||||
<*> concurrent (resolverNonce ct rnOwner)
|
||||
where
|
||||
textRecord key = concurrent $ call ct (resolver ct) ("text(bytes32,string)", abiTuple [Static $ nodeArg ct lh, Dynamic $ abiBytes key]) decodeString
|
||||
|
||||
-- | Cents for a label of this length and these years. The oracle prices by length only,
|
||||
-- so a placeholder label of that length keeps the label from the RPC node.
|
||||
chainPriceCents :: Contracts -> Int -> Int -> IO (Either ChainError Int)
|
||||
chainPriceCents ct len years = call ct (controller ct) ("rentPriceUSD(string,uint256)", args) $ \ret -> do
|
||||
base <- decodeUint256 ret
|
||||
let cents = base `div` attoUsdPerCent
|
||||
if cents <= toInteger (maxBound :: Int) then Right (fromInteger cents) else Left AERange
|
||||
where
|
||||
args = abiTuple [Dynamic $ abiBytes $ B.replicate len 'a', Static $ uint256 $ toInteger years * secondsPerYear]
|
||||
|
||||
-- | The shortest length from the shortest label such that every length up to the longest costs at most these cents
|
||||
-- for these years, from one read of the oracle's whole price list, which need not fall with the length.
|
||||
codeLengthFor :: Contracts -> Int -> Int -> IO (Either ChainError (Maybe Int))
|
||||
codeLengthFor ct cents years = runExceptT $ do
|
||||
oracle <- ExceptT $ call ct (controller ct) ("prices()", "") decodeAddress
|
||||
(basePerYear, exceptions) <- ExceptT $ call ct oracle ("prices()", "") decodePrices
|
||||
let perYear len = M.findWithDefault basePerYear (toInteger len) $ M.fromList exceptions
|
||||
covered len = perYear len * toInteger years <= toInteger cents
|
||||
pure $ case takeWhile covered [maxNameLength, maxNameLength - 1 .. minNameLength] of
|
||||
[] -> Nothing
|
||||
lens -> Just $ last lens
|
||||
|
||||
sponsorNonce :: Contracts -> Address -> IO (Either ChainError Word64)
|
||||
sponsorNonce ct owner = call ct (cSponsor $ chainConfig ct) ("nonces(address)", addressWord owner) decodeWord64
|
||||
|
||||
resolverNonce :: Contracts -> Address -> IO (Either ChainError Word64)
|
||||
resolverNonce ct owner = call ct (resolver ct) ("nonces(address)", addressWord owner) decodeWord64
|
||||
|
||||
-- | Nothing when nobody holds the name: @ownerOf@ then fails the registrar's bare @require@ on the expiry,
|
||||
-- a revert without data. Any other revert is a failed read.
|
||||
ownerOfToken :: Contracts -> LabelHash -> IO (Either ChainError (Maybe Address))
|
||||
ownerOfToken ct lh =
|
||||
call ct (baseRegistrar ct) ("ownerOf(uint256)", labelHashArg lh) decodeAddress >>= \case
|
||||
Left (ChainReverted (Just RNWithoutData)) -> pure $ Right Nothing
|
||||
r -> pure $ Just <$> r
|
||||
|
||||
nameExpires :: Contracts -> LabelHash -> IO (Either ChainError Word64)
|
||||
nameExpires ct lh = call ct (baseRegistrar ct) ("nameExpires(uint256)", labelHashArg lh) decodeWord64
|
||||
|
||||
-- | The block time of the commitment, Nothing when the controller holds none.
|
||||
commitmentTime :: Contracts -> ByteString -> IO (Either ChainError (Maybe Word64))
|
||||
commitmentTime ct commitment = fmap nonZero <$> call ct (controller ct) ("commitments(bytes32)", commitment) decodeWord64
|
||||
where
|
||||
nonZero t = if t == 0 then Nothing else Just t
|
||||
|
||||
controllerAvailable :: Contracts -> Text -> IO (Either ChainError Bool)
|
||||
controllerAvailable ct label = call ct (controller ct) ("available(string)", abiTuple [Dynamic $ abiBytes $ encodeUtf8 label]) decodeBool
|
||||
|
||||
commitmentAges :: Contracts -> IO (Either ChainError CommitmentAges)
|
||||
commitmentAges ct@Contracts {ctCommitmentAges} = readOnce ctCommitmentAges $ runExceptT $ do
|
||||
caMin <- ExceptT $ call ct (controller ct) ("minCommitmentAge()", "") decodeUint256
|
||||
caMax <- ExceptT $ call ct (controller ct) ("maxCommitmentAge()", "") decodeUint256
|
||||
pure CommitmentAges {caMin, caMax}
|
||||
|
||||
registrarConstants :: Contracts -> IO (Either ChainError RegistrarConstants)
|
||||
registrarConstants ct@Contracts {ctRegistrar} = readOnce ctRegistrar $ runExceptT $ do
|
||||
rcRegistry <- ExceptT $ call ct (baseRegistrar ct) ("ens()", "") decodeAddress
|
||||
rcGracePeriod <- ExceptT $ call ct (baseRegistrar ct) ("GRACE_PERIOD()", "") decodeUint256
|
||||
pure RegistrarConstants {rcRegistry, rcGracePeriod}
|
||||
|
||||
-- | Concurrent first uses may each read; they read the same immutable values.
|
||||
readOnce :: IORef (Maybe a) -> IO (Either ChainError a) -> IO (Either ChainError a)
|
||||
readOnce ref readChain =
|
||||
readIORef ref >>= \case
|
||||
Just a -> pure $ Right a
|
||||
Nothing -> readChain >>= either (pure . Left) (\a -> Right a <$ atomicWriteIORef ref (Just a))
|
||||
|
||||
-- | Reads run at once; the first failure in argument order is the answer.
|
||||
together :: Compose Concurrently (Either ChainError) a -> IO (Either ChainError a)
|
||||
together = runConcurrently . getCompose
|
||||
|
||||
concurrent :: IO (Either ChainError a) -> Compose Concurrently (Either ChainError) a
|
||||
concurrent = Compose . Concurrently
|
||||
|
||||
withinDeadline :: Contracts -> Text -> IO (Either ChainError a) -> IO (Either ChainError a)
|
||||
withinDeadline Contracts {ctDeadline} what action = fromMaybe (Left $ ChainUnavailable $ what <> ": timed out") <$> timeout ctDeadline action
|
||||
|
||||
-- | An answer that does not decode is a node failure, as an RPC error is.
|
||||
call :: Contracts -> Address -> (ByteString, ByteString) -> (ByteString -> Either AbiError a) -> IO (Either ChainError a)
|
||||
call Contracts {ctChain} to (signature, args) decode =
|
||||
(>>= first malformed . decode) <$> ethCall ctChain to (selector signature <> args)
|
||||
where
|
||||
malformed e = ChainUnavailable $ "eth_call: " <> decodeLatin1 signature <> " answered " <> tshow e
|
||||
|
||||
labelHashArg :: LabelHash -> ByteString
|
||||
labelHashArg (LabelHash h) = h
|
||||
|
||||
nodeArg :: Contracts -> LabelHash -> ByteString
|
||||
nodeArg Contracts {ctTLD} = nodeBytes . labelNode ctTLD
|
||||
|
||||
chainConfig :: Contracts -> ChainConfig
|
||||
chainConfig = ccConfig . ctChain
|
||||
|
||||
controller, resolver, baseRegistrar :: Contracts -> Address
|
||||
controller = cController . chainConfig
|
||||
resolver = cResolver . chainConfig
|
||||
baseRegistrar = cBaseRegistrar . chainConfig
|
||||
@@ -7,6 +7,7 @@ import Simplex.Messaging.Agent.Protocol (UserId)
|
||||
import Simplex.Messaging.Agent.Store.Common (DBStore)
|
||||
import StoreService.Config (NamesConfig (..))
|
||||
import StoreService.Names.Chain (ChainClient, newChainClient)
|
||||
import StoreService.Names.Contracts (Contracts, newContracts)
|
||||
import StoreService.Names.Phases (Phases, newPhases)
|
||||
import StoreService.Names.Profiles (Profiles, chatProfile, defaultProfileLimits, monotonicSeconds, newProfiles, systemResolver)
|
||||
import StoreService.Names.Turns (Turns, newTurns)
|
||||
@@ -19,13 +20,15 @@ data NamesEnv = NamesEnv
|
||||
nePhases :: Phases,
|
||||
neTurns :: Turns,
|
||||
neChain :: ChainClient,
|
||||
neContracts :: Contracts,
|
||||
neProfiles :: Profiles
|
||||
}
|
||||
|
||||
newNamesEnv :: ChatController -> UserId -> NamesConfig -> DBStore -> IO NamesEnv
|
||||
newNamesEnv neChat@ChatController {random} neUserId neConfig@NamesConfig {nChain} neStore = do
|
||||
newNamesEnv neChat@ChatController {random} neUserId neConfig@NamesConfig {nTLD, nChain} neStore = do
|
||||
nePhases <- newPhases
|
||||
neTurns <- newTurns
|
||||
neChain <- newChainClient random nChain
|
||||
neContracts <- newContracts nTLD neChain
|
||||
neProfiles <- newProfiles defaultProfileLimits monotonicSeconds (chatProfile neChat neUserId) systemResolver
|
||||
pure NamesEnv {neChat, neUserId, neConfig, neStore, nePhases, neTurns, neChain, neProfiles}
|
||||
pure NamesEnv {neChat, neUserId, neConfig, neStore, nePhases, neTurns, neChain, neContracts, neProfiles}
|
||||
@@ -5,7 +5,11 @@ module StoreService.Names.Registration
|
||||
( Registration (..),
|
||||
RegisterIntent (..),
|
||||
Node,
|
||||
nodeBytes,
|
||||
namehash,
|
||||
labelNode,
|
||||
contactRecordKey,
|
||||
channelRecordKey,
|
||||
sponsorDomain,
|
||||
resolverDomain,
|
||||
makeCommitment,
|
||||
@@ -32,7 +36,7 @@ import Simplex.Messaging.Crypto.Secp256k1 (RecoverableSignature)
|
||||
import Simplex.Messaging.Encoding.String (strEncode)
|
||||
import Simplex.Messaging.Eth.Address (Address, recoverAddress)
|
||||
import Simplex.Messaging.Eth.EIP712 (Eip712Domain (..), Eip712Value (..), hashTypedData, serializeSignature)
|
||||
import Simplex.Messaging.SimplexName (SimplexTLD)
|
||||
import Simplex.Messaging.SimplexName (LabelHash (..), SimplexTLD)
|
||||
import StoreService.Names.Abi (AbiValue (..), abiArray, abiBytes, abiTuple, addressWord, selector, uint256)
|
||||
|
||||
data Registration = Registration
|
||||
@@ -46,9 +50,16 @@ data Registration = Registration
|
||||
rChannelLink :: Maybe Text
|
||||
}
|
||||
|
||||
-- | Only built by 'namehash', so it always holds 32 bytes.
|
||||
-- | Only built by 'labelNode', so it always holds 32 bytes.
|
||||
newtype Node = Node ByteString
|
||||
|
||||
nodeBytes :: Node -> ByteString
|
||||
nodeBytes (Node node) = node
|
||||
|
||||
contactRecordKey, channelRecordKey :: ByteString
|
||||
contactRecordKey = "simplex.contact"
|
||||
channelRecordKey = "simplex.channel"
|
||||
|
||||
data RegisterIntent = RegisterIntent
|
||||
{ riRegistration :: Registration,
|
||||
riNonce :: Word64,
|
||||
@@ -134,7 +145,7 @@ registrationTuple r@Registration {rLabel, rOwner, rDuration, rSecret, rResolver}
|
||||
|
||||
recordCalls :: Registration -> [ByteString]
|
||||
recordCalls Registration {rLabel, rTLD, rContactLink, rChannelLink} =
|
||||
catMaybes [setText "simplex.contact" <$> rContactLink, setText "simplex.channel" <$> rChannelLink]
|
||||
catMaybes [setText contactRecordKey <$> rContactLink, setText channelRecordKey <$> rChannelLink]
|
||||
where
|
||||
setText key link =
|
||||
selector "setText(bytes32,string,string)"
|
||||
@@ -142,6 +153,9 @@ recordCalls Registration {rLabel, rTLD, rContactLink, rChannelLink} =
|
||||
Node node = namehash rTLD rLabel
|
||||
|
||||
namehash :: SimplexTLD -> Text -> Node
|
||||
namehash tld label = Node $ keccak256 $ tldNode <> keccak256 (encodeUtf8 label)
|
||||
namehash tld = labelNode tld . LabelHash . keccak256 . encodeUtf8
|
||||
|
||||
labelNode :: SimplexTLD -> LabelHash -> Node
|
||||
labelNode tld (LabelHash h) = Node $ keccak256 $ tldNode <> h
|
||||
where
|
||||
tldNode = keccak256 $ B.replicate 32 0 <> keccak256 (B.drop 1 $ strEncode tld)
|
||||
@@ -55,59 +55,65 @@ data RevertName
|
||||
| RNTransferToSelf
|
||||
| RNUnexpiredCommitmentExists
|
||||
| RNZeroAddress
|
||||
| -- | a revert with empty or no data, as a bare @require@ or @revert()@ gives
|
||||
RNWithoutData
|
||||
deriving (Eq, Show, Enum, Bounded)
|
||||
|
||||
revertSignature :: RevertName -> ByteString
|
||||
-- | Nothing for a revert without data, which has no selector.
|
||||
revertSignature :: RevertName -> Maybe ByteString
|
||||
revertSignature = \case
|
||||
RNAlreadyFrozen -> "AlreadyFrozen()"
|
||||
RNCommitmentNotFound -> "CommitmentNotFound(bytes32)"
|
||||
RNCommitmentTooNew -> "CommitmentTooNew(bytes32,uint256,uint256)"
|
||||
RNCommitmentTooOld -> "CommitmentTooOld(bytes32,uint256,uint256)"
|
||||
RNDurationTooShort -> "DurationTooShort(uint256)"
|
||||
RNFrozen -> "Frozen()"
|
||||
RNInsufficientAllowance -> "InsufficientAllowance(uint256,uint256)"
|
||||
RNInsufficientValue -> "InsufficientValue()"
|
||||
RNInvalidEVMAddress -> "InvalidEVMAddress(bytes)"
|
||||
RNInvalidNonce -> "InvalidNonce()"
|
||||
RNInvalidSignature -> "InvalidSignature()"
|
||||
RNLabelTooLong -> "LabelTooLong(uint256,uint256)"
|
||||
RNMaxCommitmentAgeTooHigh -> "MaxCommitmentAgeTooHigh()"
|
||||
RNMaxCommitmentAgeTooLow -> "MaxCommitmentAgeTooLow()"
|
||||
RNMinCharLengthCanOnlyDecrease -> "MinCharLengthCanOnlyDecrease()"
|
||||
RNMinCharLengthZero -> "MinCharLengthZero()"
|
||||
RNMinCommitmentAgeZero -> "MinCommitmentAgeZero()"
|
||||
RNNameNotAvailable -> "NameNotAvailable(string)"
|
||||
RNNameNotReserved -> "NameNotReserved(string)"
|
||||
RNNameReserved -> "NameReserved(string)"
|
||||
RNNameTooShort -> "NameTooShort(string,uint8)"
|
||||
RNNftGateCanOnlyBeDisabled -> "NftGateCanOnlyBeDisabled()"
|
||||
RNNftRequired -> "NftRequired()"
|
||||
RNNodeNotOwnedByRegistrar -> "NodeNotOwnedByRegistrar()"
|
||||
RNNotBeneficiary -> "NotBeneficiary()"
|
||||
RNNotNameOwner -> "NotNameOwner()"
|
||||
RNNotOffered -> "NotOffered()"
|
||||
RNNotOwnerOrBeneficiary -> "NotOwnerOrBeneficiary()"
|
||||
RNNotSponsor -> "NotSponsor()"
|
||||
RNNotSubnameRegistrar -> "NotSubnameRegistrar()"
|
||||
RNOffsetOutOfBoundsError -> "OffsetOutOfBoundsError(uint256,uint256)"
|
||||
RNOwnerMustBeCaller -> "OwnerMustBeCaller()"
|
||||
RNPublicSalesClosed -> "PublicSalesClosed()"
|
||||
RNReasonRequired -> "ReasonRequired()"
|
||||
RNRecipientMustBeCaller -> "RecipientMustBeCaller()"
|
||||
RNReentrantCall -> "ReentrantCall()"
|
||||
RNResolverRequiredWhenDataSupplied -> "ResolverRequiredWhenDataSupplied()"
|
||||
RNReverseRecordNotSupported -> "ReverseRecordNotSupported()"
|
||||
RNSignatureExpired -> "SignatureExpired()"
|
||||
RNTransferFailed -> "TransferFailed()"
|
||||
RNTransferToSelf -> "TransferToSelf()"
|
||||
RNUnexpiredCommitmentExists -> "UnexpiredCommitmentExists(bytes32)"
|
||||
RNZeroAddress -> "ZeroAddress()"
|
||||
RNAlreadyFrozen -> Just "AlreadyFrozen()"
|
||||
RNCommitmentNotFound -> Just "CommitmentNotFound(bytes32)"
|
||||
RNCommitmentTooNew -> Just "CommitmentTooNew(bytes32,uint256,uint256)"
|
||||
RNCommitmentTooOld -> Just "CommitmentTooOld(bytes32,uint256,uint256)"
|
||||
RNDurationTooShort -> Just "DurationTooShort(uint256)"
|
||||
RNFrozen -> Just "Frozen()"
|
||||
RNInsufficientAllowance -> Just "InsufficientAllowance(uint256,uint256)"
|
||||
RNInsufficientValue -> Just "InsufficientValue()"
|
||||
RNInvalidEVMAddress -> Just "InvalidEVMAddress(bytes)"
|
||||
RNInvalidNonce -> Just "InvalidNonce()"
|
||||
RNInvalidSignature -> Just "InvalidSignature()"
|
||||
RNLabelTooLong -> Just "LabelTooLong(uint256,uint256)"
|
||||
RNMaxCommitmentAgeTooHigh -> Just "MaxCommitmentAgeTooHigh()"
|
||||
RNMaxCommitmentAgeTooLow -> Just "MaxCommitmentAgeTooLow()"
|
||||
RNMinCharLengthCanOnlyDecrease -> Just "MinCharLengthCanOnlyDecrease()"
|
||||
RNMinCharLengthZero -> Just "MinCharLengthZero()"
|
||||
RNMinCommitmentAgeZero -> Just "MinCommitmentAgeZero()"
|
||||
RNNameNotAvailable -> Just "NameNotAvailable(string)"
|
||||
RNNameNotReserved -> Just "NameNotReserved(string)"
|
||||
RNNameReserved -> Just "NameReserved(string)"
|
||||
RNNameTooShort -> Just "NameTooShort(string,uint8)"
|
||||
RNNftGateCanOnlyBeDisabled -> Just "NftGateCanOnlyBeDisabled()"
|
||||
RNNftRequired -> Just "NftRequired()"
|
||||
RNNodeNotOwnedByRegistrar -> Just "NodeNotOwnedByRegistrar()"
|
||||
RNNotBeneficiary -> Just "NotBeneficiary()"
|
||||
RNNotNameOwner -> Just "NotNameOwner()"
|
||||
RNNotOffered -> Just "NotOffered()"
|
||||
RNNotOwnerOrBeneficiary -> Just "NotOwnerOrBeneficiary()"
|
||||
RNNotSponsor -> Just "NotSponsor()"
|
||||
RNNotSubnameRegistrar -> Just "NotSubnameRegistrar()"
|
||||
RNOffsetOutOfBoundsError -> Just "OffsetOutOfBoundsError(uint256,uint256)"
|
||||
RNOwnerMustBeCaller -> Just "OwnerMustBeCaller()"
|
||||
RNPublicSalesClosed -> Just "PublicSalesClosed()"
|
||||
RNReasonRequired -> Just "ReasonRequired()"
|
||||
RNRecipientMustBeCaller -> Just "RecipientMustBeCaller()"
|
||||
RNReentrantCall -> Just "ReentrantCall()"
|
||||
RNResolverRequiredWhenDataSupplied -> Just "ResolverRequiredWhenDataSupplied()"
|
||||
RNReverseRecordNotSupported -> Just "ReverseRecordNotSupported()"
|
||||
RNSignatureExpired -> Just "SignatureExpired()"
|
||||
RNTransferFailed -> Just "TransferFailed()"
|
||||
RNTransferToSelf -> Just "TransferToSelf()"
|
||||
RNUnexpiredCommitmentExists -> Just "UnexpiredCommitmentExists(bytes32)"
|
||||
RNZeroAddress -> Just "ZeroAddress()"
|
||||
RNWithoutData -> Nothing
|
||||
|
||||
revertSelectors :: Map ByteString RevertName
|
||||
revertSelectors = M.fromList [(selector $ revertSignature n, n) | n <- [minBound .. maxBound]]
|
||||
revertSelectors = M.fromList [(selector signature, n) | n <- [minBound .. maxBound], Just signature <- [revertSignature n]]
|
||||
|
||||
-- | The error a revert's data names by its selector, if it is one of the contracts' errors.
|
||||
decodeRevert :: ByteString -> Maybe RevertName
|
||||
decodeRevert revertData = M.lookup (B.take selectorSize revertData) revertSelectors
|
||||
decodeRevert revertData
|
||||
| B.null revertData = Just RNWithoutData
|
||||
| otherwise = M.lookup (B.take selectorSize revertData) revertSelectors
|
||||
where
|
||||
selectorSize = 4
|
||||
@@ -445,6 +445,7 @@ executable simplex-store-service
|
||||
StoreService.Names.Abi
|
||||
StoreService.Names.Chain
|
||||
StoreService.Names.Codes
|
||||
StoreService.Names.Contracts
|
||||
StoreService.Names.Env
|
||||
StoreService.Names.Label
|
||||
StoreService.Names.Links
|
||||
@@ -474,6 +475,7 @@ executable simplex-store-service
|
||||
ghc-options: -O2 -Weverything -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-safe -Wno-missing-local-signatures -Wno-missing-kind-signatures -Wno-missing-deriving-strategies -Wno-monomorphism-restriction -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-implicit-prelude -Wno-missing-safe-haskell-mode -Wno-missing-export-lists -Wno-partial-fields -Wcompat -Werror=incomplete-record-updates -Werror=incomplete-patterns -Werror=missing-methods -Werror=incomplete-uni-patterns -Werror=tabs -Wredundant-constraints -Wincomplete-record-updates -Wunused-type-patterns -Werror=name-shadowing -threaded -rtsopts
|
||||
build-depends:
|
||||
aeson ==2.2.*
|
||||
, async ==2.2.*
|
||||
, attoparsec ==0.14.*
|
||||
, base >=4.7 && <5
|
||||
, base64-bytestring >=1.0 && <1.3
|
||||
@@ -756,6 +758,7 @@ test-suite simplex-chat-test
|
||||
Bots.StoreService.NameRegistrationTests
|
||||
Bots.StoreService.NamesChainTests
|
||||
Bots.StoreService.NamesCodesTests
|
||||
Bots.StoreService.NamesContractsTests
|
||||
Bots.StoreService.NamesLabelTests
|
||||
Bots.StoreService.NamesLinksTests
|
||||
Bots.StoreService.NamesProfilesTests
|
||||
@@ -786,6 +789,7 @@ test-suite simplex-chat-test
|
||||
StoreService.Names.Abi
|
||||
StoreService.Names.Chain
|
||||
StoreService.Names.Codes
|
||||
StoreService.Names.Contracts
|
||||
StoreService.Names.Env
|
||||
StoreService.Names.Label
|
||||
StoreService.Names.Links
|
||||
|
||||
@@ -31,7 +31,7 @@ namesChainTests = describe "StoreService names: chain" $ do
|
||||
it "reads a dry run's revert with data by its name" $ testDryRunRevertNamed g
|
||||
it "reads an eth_call revert with data by its name" $ testCallRevertNamed g
|
||||
it "reads ownerOf of a name nobody holds as a revert" $ testOwnerOfRevert g
|
||||
it "reads a revert without code 3 or data as a revert" $ testRevertWithoutData g
|
||||
it "reads a revert without code 3 or data as a revert without data" $ testRevertWithoutData g
|
||||
it "reads a revert of an unknown error as an unnamed revert" $ testUnknownRevert g
|
||||
describe "failures" $ do
|
||||
it "reads an RPC error as unavailable, without the URL" $ testRpcError g
|
||||
@@ -101,9 +101,10 @@ viemSelectors =
|
||||
|
||||
testRevertSelectors :: IO ()
|
||||
testRevertSelectors = do
|
||||
map snd viemSelectors `shouldBe` [minBound .. maxBound]
|
||||
map snd viemSelectors `shouldBe` filter (/= RNWithoutData) [minBound .. maxBound]
|
||||
[(n, decodeRevert $ unhex sel <> uint256 (0 :: Int)) | (sel, n) <- viemSelectors] `shouldBe` [(n, Just n) | (_, n) <- viemSelectors]
|
||||
decodeRevert (B.take 3 $ unhex "74480cc9") `shouldBe` Nothing
|
||||
decodeRevert "" `shouldBe` Just RNWithoutData
|
||||
|
||||
testDryRunRevertNamed :: TVar ChaChaDRG -> IO ()
|
||||
testDryRunRevertNamed g = withChain g $ \node c -> do
|
||||
@@ -120,12 +121,12 @@ testOwnerOfRevert :: TVar ChaChaDRG -> IO ()
|
||||
testOwnerOfRevert g = withChain g $ \node c@ChainClient {ccConfig = ChainConfig {cBaseRegistrar}} -> do
|
||||
let ownerOf = selector "ownerOf(uint256)" <> C.keccak256 "bakery1"
|
||||
answerCall node cBaseRegistrar ownerOf $ Reverts ""
|
||||
ethCall c cBaseRegistrar ownerOf `shouldReturn` Left (ChainReverted Nothing)
|
||||
ethCall c cBaseRegistrar ownerOf `shouldReturn` Left (ChainReverted $ Just RNWithoutData)
|
||||
|
||||
testRevertWithoutData :: TVar ChaChaDRG -> IO ()
|
||||
testRevertWithoutData g = withChain g $ \node c -> do
|
||||
setFault node "eth_call" $ RpcError (-32000) "execution reverted" Nothing
|
||||
ethCall c fakeController availableCall `shouldReturn` Left (ChainReverted Nothing)
|
||||
ethCall c fakeController availableCall `shouldReturn` Left (ChainReverted $ Just RNWithoutData)
|
||||
|
||||
testUnknownRevert :: TVar ChaChaDRG -> IO ()
|
||||
testUnknownRevert g = withChain g $ \node c -> do
|
||||
|
||||
@@ -0,0 +1,362 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Bots.StoreService.NamesContractsTests (namesContractsTests) where
|
||||
|
||||
import Bots.StoreService.FakeEthNode
|
||||
import Control.Concurrent.STM (TVar)
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import Data.ByteArray.Encoding (Base (Base16), convertFromBase)
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime)
|
||||
import Data.Word (Word64)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding.String (strDecode)
|
||||
import Simplex.Messaging.Eth.Address (Address)
|
||||
import Simplex.Messaging.SimplexName (LabelHash, SimplexTLD (..), labelHash)
|
||||
import StoreService.Config (ChainConfig (..))
|
||||
import StoreService.Names.Abi
|
||||
import StoreService.Names.Chain
|
||||
import StoreService.Names.Contracts
|
||||
import StoreService.Names.Registration (labelNode, namehash, nodeBytes)
|
||||
import StoreService.Names.Revert (RevertName (..))
|
||||
import Test.Hspec
|
||||
|
||||
namesContractsTests :: Spec
|
||||
namesContractsTests = describe "StoreService names: contracts" $ do
|
||||
-- the calldata and answers marked viem are viem 2.33.3's encodeFunctionData and encodeFunctionResult
|
||||
-- with the ABIs of ens-contracts PR #36, so a read the fake node answers sends viem's calldata
|
||||
g <- runIO C.newRandom
|
||||
it "builds a name's node from its label hash as viem's namehash" testNode
|
||||
describe "status" $ do
|
||||
it "reads a name nobody holds or reserved as available" $ testAvailable g
|
||||
it "reads a reserved name" $ testReserved g
|
||||
it "reads a registered name with the registry's owner and resolver" $ testRegistered g
|
||||
it "keeps a name registered to the last second of its grace period" $ testGracePeriod g
|
||||
it "reads the registry and the grace period once, and again after a failed read" $ testRegistrarOnce g
|
||||
describe "records" $ do
|
||||
it "reads the default resolver's records and the owner's nonce" $ testRecords g
|
||||
it "reads no records from another resolver" $ testOtherResolver g
|
||||
describe "prices" $ do
|
||||
it "quotes 6, 7 and 12 letters at the launch list for 2 years" $ testLaunchPrices g
|
||||
it "finds the code length for each launch price" $ testLaunchCodeLengths g
|
||||
it "requires every longer length to be covered when the list is not monotone" $ testNonMonotone g
|
||||
it "reads the oracle from the controller on each call" $ testOracleReplaced g
|
||||
describe "other reads" $ do
|
||||
it "reads the sponsor's and the resolver's nonces from their own contracts" $ testNonces g
|
||||
it "reads ownerOf's revert without data as nobody" $ testOwnerOfNobody g
|
||||
it "reads any other ownerOf revert or failure as a failed read" $ testOwnerOfFailed g
|
||||
it "reads a commitment's time, none as Nothing" $ testCommitmentTime g
|
||||
it "reads the controller's availability and the name's expiry" $ testAvailability g
|
||||
it "reads the commitment ages once" $ testCommitmentAges g
|
||||
describe "failures" $ do
|
||||
it "fails a status on a failed read, never reading it as available" $ testFailedRead g
|
||||
it "fails a read whose answer does not decode or does not fit" $ testMalformed g
|
||||
it "fails a status within its deadline when one method hangs" $ testStatusDeadline g
|
||||
it "fails records within their deadline when the calls hang" $ testRecordsDeadline g
|
||||
|
||||
testNode :: IO ()
|
||||
testNode = do
|
||||
nodeBytes (labelNode TLDSimplex $ labelHash "alicebakery") `shouldBe` aliceNode
|
||||
nodeBytes (namehash TLDSimplex "alicebakery") `shouldBe` aliceNode
|
||||
|
||||
testAvailable :: TVar ChaChaDRG -> IO ()
|
||||
testAvailable g = withContracts g $ \node ct -> do
|
||||
answerRegistrar node
|
||||
setBlock node 100 now
|
||||
answerCall node (registrarOf node) nameExpiresCall $ Returns $ uint256 (0 :: Int)
|
||||
answerCall node fakeController reservedNamesCall $ Returns $ uint256 (0 :: Int)
|
||||
nameStatus ct alice `shouldReturn` Right NSAvailable
|
||||
|
||||
testReserved :: TVar ChaChaDRG -> IO ()
|
||||
testReserved g = withContracts g $ \node ct -> do
|
||||
answerRegistrar node
|
||||
setBlock node 100 now
|
||||
answerCall node (registrarOf node) nameExpiresCall $ Returns $ uint256 (0 :: Int)
|
||||
-- viem: reservedNames answering Reason 1
|
||||
answerCall node fakeController reservedNamesCall $ Returns $ unhex "0000000000000000000000000000000000000000000000000000000000000001"
|
||||
nameStatus ct alice `shouldReturn` Right NSReserved
|
||||
|
||||
testRegistered :: TVar ChaChaDRG -> IO ()
|
||||
testRegistered g = withContracts g $ \node ct -> do
|
||||
answerRegistrar node
|
||||
answerRegistered node (resolverOf node)
|
||||
setBlock node 100 now
|
||||
answerCall node (registrarOf node) nameExpiresCall $ Returns $ uint256 (now + year)
|
||||
nameStatus ct alice `shouldReturn` Right (NSRegistered $ registeredAlice (resolverOf node) (now + year))
|
||||
|
||||
testGracePeriod :: TVar ChaChaDRG -> IO ()
|
||||
testGracePeriod g = withContracts g $ \node ct -> do
|
||||
answerRegistrar node
|
||||
answerRegistered node (resolverOf node)
|
||||
answerCall node fakeController reservedNamesCall $ Returns $ uint256 (0 :: Int)
|
||||
let expired = now - year
|
||||
answerCall node (registrarOf node) nameExpiresCall $ Returns $ uint256 expired
|
||||
setBlock node 100 $ expired + gracePeriod
|
||||
nameStatus ct alice `shouldReturn` Right (NSRegistered $ registeredAlice (resolverOf node) expired)
|
||||
setBlock node 101 $ expired + gracePeriod + 1
|
||||
nameStatus ct alice `shouldReturn` Right NSAvailable
|
||||
|
||||
testRegistrarOnce :: TVar ChaChaDRG -> IO ()
|
||||
testRegistrarOnce g = withContracts g $ \node ct -> do
|
||||
setBlock node 100 now
|
||||
answerCall node (registrarOf node) nameExpiresCall $ Returns $ uint256 (0 :: Int)
|
||||
answerCall node fakeController reservedNamesCall $ Returns $ uint256 (0 :: Int)
|
||||
nameStatus ct alice `shouldReturn` Left (ChainUnavailable "eth_call: error -32000: no fake answer for this call")
|
||||
answerRegistrar node
|
||||
nameStatus ct alice `shouldReturn` Right NSAvailable
|
||||
answerCall node (registrarOf node) ensCall $ Reverts ""
|
||||
answerCall node (registrarOf node) gracePeriodCall $ Reverts ""
|
||||
nameStatus ct alice `shouldReturn` Right NSAvailable
|
||||
|
||||
testRecords :: TVar ChaChaDRG -> IO ()
|
||||
testRecords g = withContracts g $ \node ct -> do
|
||||
let resolver = resolverOf node
|
||||
answerCall node resolver contactTextCall $ Returns contactTextAnswer
|
||||
-- an unset record is the empty string
|
||||
answerCall node resolver channelTextCall $ Returns $ abiTuple [Dynamic $ abiBytes ""]
|
||||
answerCall node resolver noncesCall $ Returns $ uint256 (3 :: Int)
|
||||
nameRecords ct alice (registeredAlice resolver $ now + year)
|
||||
`shouldReturn` Right (Just NameRecords {rdContact = "https://smp8.simplex.im/a#Y8m3", rdChannel = "", rdNonce = 3})
|
||||
|
||||
testOtherResolver :: TVar ChaChaDRG -> IO ()
|
||||
testOtherResolver g = withContracts g $ \_ ct -> do
|
||||
nameRecords ct alice (registeredAlice otherResolver $ now + year) `shouldReturn` Right Nothing
|
||||
|
||||
testLaunchPrices :: TVar ChaChaDRG -> IO ()
|
||||
testLaunchPrices g = withContracts g $ \node ct -> do
|
||||
-- viem: rentPriceUSD answering {base: 40000 * 10^16, premium: 0}
|
||||
answerCall node fakeController (rentPriceCall 6) $ Returns $ unhex "000000000000000000000000000000000000000000000015af1d78b58c4000000000000000000000000000000000000000000000000000000000000000000000"
|
||||
answerCall node fakeController (rentPriceCall 7) $ Returns $ rentPriceAnswer 20000
|
||||
answerCall node fakeController (rentPriceCall 12) $ Returns $ rentPriceAnswer 10000
|
||||
mapM (\len -> chainPriceCents ct len 2) [6, 7, 12] `shouldReturn` [Right 40000, Right 20000, Right 10000]
|
||||
|
||||
testLaunchCodeLengths :: TVar ChaChaDRG -> IO ()
|
||||
testLaunchCodeLengths g = withContracts g $ \node ct -> do
|
||||
answerCall node fakeController pricesCall $ Returns $ addressWord oracle
|
||||
answerCall node oracle pricesCall $ Returns launchPricesAnswer
|
||||
mapM (\cents -> codeLengthFor ct cents 2) [40000, 20000, 10000, 9999]
|
||||
`shouldReturn` [Right (Just 6), Right (Just 7), Right (Just 8), Right Nothing]
|
||||
codeLengthFor ct 20000 4 `shouldReturn` Right (Just 8)
|
||||
|
||||
testNonMonotone :: TVar ChaChaDRG -> IO ()
|
||||
testNonMonotone g = withContracts g $ \node ct -> do
|
||||
answerCall node fakeController pricesCall $ Returns $ addressWord oracle
|
||||
answerCall node oracle pricesCall $ Returns $ pricesAnswer 5000 [(6, 15000), (7, 20000)]
|
||||
mapM (\cents -> codeLengthFor ct cents 2) [30000, 40000] `shouldReturn` [Right (Just 8), Right (Just 6)]
|
||||
answerCall node oracle pricesCall $ Returns $ pricesAnswer 5000 [(63, 30000)]
|
||||
mapM (\cents -> codeLengthFor ct cents 2) [59999, 60000] `shouldReturn` [Right Nothing, Right (Just 6)]
|
||||
|
||||
testOracleReplaced :: TVar ChaChaDRG -> IO ()
|
||||
testOracleReplaced g = withContracts g $ \node ct -> do
|
||||
let newOracle = address "0x8a791620dd6260079bf849dc5567adc3f2fdc318"
|
||||
answerCall node fakeController pricesCall $ Returns $ addressWord oracle
|
||||
answerCall node oracle pricesCall $ Returns launchPricesAnswer
|
||||
answerCall node newOracle pricesCall $ Returns $ pricesAnswer 10000 []
|
||||
codeLengthFor ct 20000 2 `shouldReturn` Right (Just 7)
|
||||
answerCall node fakeController pricesCall $ Returns $ addressWord newOracle
|
||||
codeLengthFor ct 20000 2 `shouldReturn` Right (Just 6)
|
||||
|
||||
testNonces :: TVar ChaChaDRG -> IO ()
|
||||
testNonces g = withContracts g $ \node ct -> do
|
||||
answerCall node fakeSponsor noncesCall $ Returns $ uint256 (5 :: Int)
|
||||
answerCall node (resolverOf node) noncesCall $ Returns $ uint256 (3 :: Int)
|
||||
sponsorNonce ct owner `shouldReturn` Right 5
|
||||
resolverNonce ct owner `shouldReturn` Right 3
|
||||
|
||||
testOwnerOfNobody :: TVar ChaChaDRG -> IO ()
|
||||
testOwnerOfNobody g = withContracts g $ \node ct -> do
|
||||
answerCall node (registrarOf node) ownerOfCall $ Returns $ addressWord owner
|
||||
ownerOfToken ct alice `shouldReturn` Right (Just owner)
|
||||
-- the registrar's require(expiries[tokenId] > block.timestamp), as anvil answers it with "0x" and reth without data
|
||||
answerCall node (registrarOf node) ownerOfCall $ Reverts ""
|
||||
ownerOfToken ct alice `shouldReturn` Right Nothing
|
||||
setFault node "eth_call" $ RpcError 3 "execution reverted" Nothing
|
||||
ownerOfToken ct alice `shouldReturn` Right Nothing
|
||||
|
||||
testOwnerOfFailed :: TVar ChaChaDRG -> IO ()
|
||||
testOwnerOfFailed g = withContracts g $ \node ct -> do
|
||||
-- viem's encodeErrorResult of Error("ERC721: invalid token ID")
|
||||
answerCall node (registrarOf node) ownerOfCall $ Reverts $ unhex "08c379a0000000000000000000000000000000000000000000000000000000000000002000000000000000000000000000000000000000000000000000000000000000184552433732313a20696e76616c696420746f6b656e2049440000000000000000"
|
||||
ownerOfToken ct alice `shouldReturn` Left (ChainReverted Nothing)
|
||||
-- viem's encodeErrorResult of ReentrantCall()
|
||||
answerCall node (registrarOf node) ownerOfCall $ Reverts $ unhex "37ed32e8"
|
||||
ownerOfToken ct alice `shouldReturn` Left (ChainReverted $ Just RNReentrantCall)
|
||||
setFault node "eth_call" HttpFailure
|
||||
ownerOfToken ct alice `shouldReturn` Left (ChainUnavailable "eth_call: HTTP 502")
|
||||
|
||||
testCommitmentTime :: TVar ChaChaDRG -> IO ()
|
||||
testCommitmentTime g = withContracts g $ \node ct -> do
|
||||
answerCall node fakeController commitmentsCall $ Returns $ uint256 (0 :: Int)
|
||||
commitmentTime ct commitment `shouldReturn` Right Nothing
|
||||
answerCall node fakeController commitmentsCall $ Returns $ uint256 now
|
||||
commitmentTime ct commitment `shouldReturn` Right (Just now)
|
||||
|
||||
testAvailability :: TVar ChaChaDRG -> IO ()
|
||||
testAvailability g = withContracts g $ \node ct -> do
|
||||
answerCall node fakeController availableCall $ Returns $ uint256 (1 :: Int)
|
||||
controllerAvailable ct "alicebakery" `shouldReturn` Right True
|
||||
answerCall node fakeController availableCall $ Returns $ uint256 (0 :: Int)
|
||||
controllerAvailable ct "alicebakery" `shouldReturn` Right False
|
||||
answerCall node (registrarOf node) nameExpiresCall $ Returns $ uint256 (now + year)
|
||||
nameExpires ct alice `shouldReturn` Right (now + year)
|
||||
|
||||
testCommitmentAges :: TVar ChaChaDRG -> IO ()
|
||||
testCommitmentAges g = withContracts g $ \node ct -> do
|
||||
answerCall node fakeController minCommitmentAgeCall $ Returns $ uint256 (60 :: Int)
|
||||
answerCall node fakeController maxCommitmentAgeCall $ Returns $ uint256 (86400 :: Int)
|
||||
commitmentAges ct `shouldReturn` Right CommitmentAges {caMin = 60, caMax = 86400}
|
||||
answerCall node fakeController maxCommitmentAgeCall $ Returns $ uint256 (3600 :: Int)
|
||||
commitmentAges ct `shouldReturn` Right CommitmentAges {caMin = 60, caMax = 86400}
|
||||
|
||||
testFailedRead :: TVar ChaChaDRG -> IO ()
|
||||
testFailedRead g = withContracts g $ \node ct -> do
|
||||
answerRegistrar node
|
||||
setBlock node 100 now
|
||||
answerCall node fakeController reservedNamesCall $ Returns $ uint256 (0 :: Int)
|
||||
answerCall node (registrarOf node) nameExpiresCall $ Reverts ""
|
||||
nameStatus ct alice `shouldReturn` Left (ChainReverted $ Just RNWithoutData)
|
||||
answerCall node (registrarOf node) nameExpiresCall $ Returns $ uint256 (0 :: Int)
|
||||
setFault node "eth_getBlockByNumber" HttpFailure
|
||||
nameStatus ct alice `shouldReturn` Left (ChainUnavailable "eth_getBlockByNumber: HTTP 502")
|
||||
clearFault node "eth_getBlockByNumber"
|
||||
answerCall node fakeController reservedNamesCall $ Reverts ""
|
||||
nameStatus ct alice `shouldReturn` Left (ChainReverted $ Just RNWithoutData)
|
||||
|
||||
testMalformed :: TVar ChaChaDRG -> IO ()
|
||||
testMalformed g = withContracts g $ \node ct -> do
|
||||
answerCall node (registrarOf node) nameExpiresCall $ Returns $ B.replicate 31 0
|
||||
nameExpires ct alice `shouldReturn` Left (ChainUnavailable "eth_call: nameExpires(uint256) answered AEShort")
|
||||
answerCall node fakeSponsor noncesCall $ Returns $ uint256 (toInteger (maxBound :: Word64) + 1)
|
||||
sponsorNonce ct owner `shouldReturn` Left (ChainUnavailable "eth_call: nonces(address) answered AERange")
|
||||
answerCall node fakeController pricesCall $ Returns $ addressWord oracle
|
||||
answerCall node oracle pricesCall $ Returns $ B.dropEnd 32 launchPricesAnswer
|
||||
codeLengthFor ct 40000 2 `shouldReturn` Left (ChainUnavailable "eth_call: prices() answered AEShort")
|
||||
|
||||
testStatusDeadline :: TVar ChaChaDRG -> IO ()
|
||||
testStatusDeadline g = withContracts g $ \node ct -> do
|
||||
answerRegistrar node
|
||||
answerCall node (registrarOf node) nameExpiresCall $ Returns $ uint256 (0 :: Int)
|
||||
answerCall node fakeController reservedNamesCall $ Returns $ uint256 (0 :: Int)
|
||||
setFault node "eth_getBlockByNumber" Hang
|
||||
elapsed <- timed $ nameStatus ct {ctDeadline = testDeadline} alice `shouldReturn` Left (ChainUnavailable "name status: timed out")
|
||||
elapsed `shouldSatisfy` (< 2)
|
||||
clearFault node "eth_getBlockByNumber"
|
||||
nameStatus ct {ctDeadline = testDeadline} alice `shouldReturn` Right NSAvailable
|
||||
|
||||
testRecordsDeadline :: TVar ChaChaDRG -> IO ()
|
||||
testRecordsDeadline g = withContracts g $ \node ct -> do
|
||||
setFault node "eth_call" Hang
|
||||
elapsed <- timed $ nameRecords ct {ctDeadline = testDeadline} alice (registeredAlice (resolverOf node) $ now + year) `shouldReturn` Left (ChainUnavailable "name records: timed out")
|
||||
elapsed `shouldSatisfy` (< 2)
|
||||
|
||||
-- fixtures
|
||||
|
||||
-- | Far below a call's 10-second timeout, so only the deadline can end a hung read in time.
|
||||
testDeadline :: Int
|
||||
testDeadline = 300000
|
||||
|
||||
timed :: IO () -> IO NominalDiffTime
|
||||
timed action = do
|
||||
start <- getCurrentTime
|
||||
action
|
||||
(`diffUTCTime` start) <$> getCurrentTime
|
||||
|
||||
withContracts :: TVar ChaChaDRG -> (FakeEthNode -> Contracts -> IO a) -> IO a
|
||||
withContracts g action = withFakeEthNode $ \node -> do
|
||||
ct <- newContracts TLDSimplex =<< newChainClient g (fakeChainConfig node)
|
||||
action node ct
|
||||
|
||||
answerRegistrar :: FakeEthNode -> IO ()
|
||||
answerRegistrar node = do
|
||||
answerCall node (registrarOf node) ensCall $ Returns $ addressWord registry
|
||||
answerCall node (registrarOf node) gracePeriodCall $ Returns $ uint256 gracePeriod
|
||||
|
||||
answerRegistered :: FakeEthNode -> Address -> IO ()
|
||||
answerRegistered node resolver = do
|
||||
answerCall node registry registryOwnerCall $ Returns $ addressWord owner
|
||||
answerCall node registry registryResolverCall $ Returns $ addressWord resolver
|
||||
|
||||
registeredAlice :: Address -> Word64 -> RegisteredName
|
||||
registeredAlice rnResolver rnExpiresAt = RegisteredName {rnOwner = owner, rnResolver, rnExpiresAt, rnGracePeriod = toInteger gracePeriod}
|
||||
|
||||
registrarOf, resolverOf :: FakeEthNode -> Address
|
||||
registrarOf = cBaseRegistrar . fakeChainConfig
|
||||
resolverOf = cResolver . fakeChainConfig
|
||||
|
||||
rentPriceAnswer :: Integer -> ByteString
|
||||
rentPriceAnswer cents = uint256 (cents * 10 ^ (16 :: Int)) <> uint256 (0 :: Int)
|
||||
|
||||
pricesAnswer :: Integer -> [(Integer, Integer)] -> ByteString
|
||||
pricesAnswer base exceptions = abiTuple [Static $ uint256 base, Dynamic $ uint256 (length exceptions) <> B.concat [uint256 len <> uint256 cents | (len, cents) <- exceptions]]
|
||||
|
||||
-- viem: prices() answering the launch list, base 5000 and [{7, 10000}, {6, 20000}]
|
||||
launchPricesAnswer :: ByteString
|
||||
launchPricesAnswer = unhex "0000000000000000000000000000000000000000000000000000000000001388000000000000000000000000000000000000000000000000000000000000004000000000000000000000000000000000000000000000000000000000000000020000000000000000000000000000000000000000000000000000000000000007000000000000000000000000000000000000000000000000000000000000271000000000000000000000000000000000000000000000000000000000000000060000000000000000000000000000000000000000000000000000000000004e20"
|
||||
|
||||
-- viem: text answering "https://smp8.simplex.im/a#Y8m3"
|
||||
contactTextAnswer :: ByteString
|
||||
contactTextAnswer = unhex "0000000000000000000000000000000000000000000000000000000000000020000000000000000000000000000000000000000000000000000000000000001e68747470733a2f2f736d70382e73696d706c65782e696d2f612359386d330000"
|
||||
|
||||
-- 2027-01-01, the term start
|
||||
now :: Word64
|
||||
now = 1798761600
|
||||
|
||||
year, gracePeriod :: Word64
|
||||
year = 31536000
|
||||
gracePeriod = 7776000
|
||||
|
||||
alice :: LabelHash
|
||||
alice = labelHash "alicebakery"
|
||||
|
||||
-- viem: namehash("alicebakery.simplex")
|
||||
aliceNode :: ByteString
|
||||
aliceNode = unhex "0f4104919a21c22f566d9c7947c7c7d8addbf546c973851a7e449276ea54ec1a"
|
||||
|
||||
commitment :: ByteString
|
||||
commitment = unhex "f8096c3f3cfbadc9f3a108d2c586ccc816c0510711c8d6228aa4fa507324d30c"
|
||||
|
||||
owner, registry, oracle, otherResolver :: Address
|
||||
owner = address "0x014f9c09cceedef1b713110d04d3a07d5b5d9b73"
|
||||
registry = address "0x5fbdb2315678afecb367f032d93f642f64180aa3"
|
||||
oracle = address "0xa513e6e4b8f2a923d98304ec87f64353c4d5c853"
|
||||
otherResolver = address "0x4826533b4897376654bb4d4ad88b7fafd0c98528"
|
||||
|
||||
-- viem's calldata for the reads
|
||||
|
||||
ensCall, gracePeriodCall, nameExpiresCall, ownerOfCall, reservedNamesCall, registryOwnerCall, registryResolverCall :: ByteString
|
||||
ensCall = unhex "3f15457f"
|
||||
gracePeriodCall = unhex "c1a287e2"
|
||||
nameExpiresCall = unhex "d6e4fa86bcc46b7948ff6be55bc3ff4db5bc4be16638f29e818a89244dae11caaed7c9c6"
|
||||
ownerOfCall = unhex "6352211ebcc46b7948ff6be55bc3ff4db5bc4be16638f29e818a89244dae11caaed7c9c6"
|
||||
reservedNamesCall = unhex "389c0748bcc46b7948ff6be55bc3ff4db5bc4be16638f29e818a89244dae11caaed7c9c6"
|
||||
registryOwnerCall = unhex "02571be30f4104919a21c22f566d9c7947c7c7d8addbf546c973851a7e449276ea54ec1a"
|
||||
registryResolverCall = unhex "0178b8bf0f4104919a21c22f566d9c7947c7c7d8addbf546c973851a7e449276ea54ec1a"
|
||||
|
||||
contactTextCall, channelTextCall, noncesCall :: ByteString
|
||||
contactTextCall = unhex "59d1d43c0f4104919a21c22f566d9c7947c7c7d8addbf546c973851a7e449276ea54ec1a0000000000000000000000000000000000000000000000000000000000000040000000000000000000000000000000000000000000000000000000000000000f73696d706c65782e636f6e746163740000000000000000000000000000000000"
|
||||
channelTextCall = unhex "59d1d43c0f4104919a21c22f566d9c7947c7c7d8addbf546c973851a7e449276ea54ec1a0000000000000000000000000000000000000000000000000000000000000040000000000000000000000000000000000000000000000000000000000000000f73696d706c65782e6368616e6e656c0000000000000000000000000000000000"
|
||||
noncesCall = unhex "7ecebe00000000000000000000000000014f9c09cceedef1b713110d04d3a07d5b5d9b73"
|
||||
|
||||
-- | rentPriceUSD("a" × length, 2 years)
|
||||
rentPriceCall :: Int -> ByteString
|
||||
rentPriceCall = \case
|
||||
6 -> unhex "9ff7ec0900000000000000000000000000000000000000000000000000000000000000400000000000000000000000000000000000000000000000000000000003c2670000000000000000000000000000000000000000000000000000000000000000066161616161610000000000000000000000000000000000000000000000000000"
|
||||
7 -> unhex "9ff7ec0900000000000000000000000000000000000000000000000000000000000000400000000000000000000000000000000000000000000000000000000003c2670000000000000000000000000000000000000000000000000000000000000000076161616161616100000000000000000000000000000000000000000000000000"
|
||||
12 -> unhex "9ff7ec0900000000000000000000000000000000000000000000000000000000000000400000000000000000000000000000000000000000000000000000000003c26700000000000000000000000000000000000000000000000000000000000000000c6161616161616161616161610000000000000000000000000000000000000000"
|
||||
len -> error $ "no viem vector for length " <> show len
|
||||
|
||||
pricesCall, commitmentsCall, availableCall, minCommitmentAgeCall, maxCommitmentAgeCall :: ByteString
|
||||
pricesCall = unhex "d3419bf3"
|
||||
commitmentsCall = unhex "839df945f8096c3f3cfbadc9f3a108d2c586ccc816c0510711c8d6228aa4fa507324d30c"
|
||||
availableCall = unhex "aeb8ce9b0000000000000000000000000000000000000000000000000000000000000020000000000000000000000000000000000000000000000000000000000000000b616c69636562616b657279000000000000000000000000000000000000000000"
|
||||
minCommitmentAgeCall = unhex "8d839ffe"
|
||||
maxCommitmentAgeCall = unhex "ce1e09c0"
|
||||
|
||||
unhex :: ByteString -> ByteString
|
||||
unhex = either error id . convertFromBase Base16
|
||||
|
||||
address :: ByteString -> Address
|
||||
address = either error id . strDecode
|
||||
@@ -12,6 +12,7 @@ import Bots.StoreService.GroupTests
|
||||
import Bots.StoreService.NameRegistrationTests
|
||||
import Bots.StoreService.NamesChainTests
|
||||
import Bots.StoreService.NamesCodesTests
|
||||
import Bots.StoreService.NamesContractsTests
|
||||
import Bots.StoreService.NamesLabelTests
|
||||
import Bots.StoreService.NamesLinksTests
|
||||
import Bots.StoreService.NamesProfilesTests
|
||||
@@ -97,6 +98,7 @@ main = do
|
||||
namesConfigTests
|
||||
namesChainTests
|
||||
namesCodesTests
|
||||
namesContractsTests
|
||||
namesLabelTests
|
||||
namesLinksTests
|
||||
namesProfilesTests
|
||||
|
||||
Reference in new issue
Block a user