From ede63f2b992930ece2597a32420768e1ebc8beb4 Mon Sep 17 00:00:00 2001 From: Artur Cygan Date: Tue, 14 Feb 2023 17:05:54 +0100 Subject: [PATCH] Fix W256 values parsing from config --- lib/Echidna/Config.hs | 21 ++++++++++++++------- lib/Echidna/Fetch.hs | 2 +- lib/Echidna/RPC.hs | 4 ++-- lib/Echidna/Solidity.hs | 6 +++--- lib/Echidna/Types/Tx.hs | 10 +++++----- src/test/Tests/Config.hs | 14 +++++++++++++- 6 files changed, 38 insertions(+), 19 deletions(-) diff --git a/lib/Echidna/Config.hs b/lib/Echidna/Config.hs index 91bafd4fd..efe7fa705 100644 --- a/lib/Echidna/Config.hs +++ b/lib/Echidna/Config.hs @@ -16,6 +16,7 @@ import Data.Text (isPrefixOf) import Data.Yaml qualified as Y import EVM (VM(..)) +import EVM.Types (W256) import Echidna.Test import Echidna.Types.Campaign @@ -51,15 +52,21 @@ instance FromJSON EConfigWithUsage where let useKey k = modify' $ insert k x ..:? k = useKey k >> lift (x .:? k) x ..!= y = fromMaybe y <$> x - getWord s d = fromIntegral <$> v ..:? s ..!= (d :: Integer) + -- Parse as unbounded Integer and see if it fits into W256 + getWord256 k def = do + value :: Integer <- fromMaybe (fromIntegral (def :: W256)) <$> v ..:? k + if value > fromIntegral (maxBound :: W256) then + fail $ show k <> ": value does not fit in 256 bits" + else + pure $ fromIntegral value -- TxConf - xc = TxConf <$> getWord "propMaxGas" maxGasPerBlock - <*> getWord "testMaxGas" maxGasPerBlock - <*> getWord "maxGasprice" 0 - <*> getWord "maxTimeDelay" defaultTimeDelay - <*> getWord "maxBlockDelay" defaultBlockDelay - <*> getWord "maxValue" 100000000000000000000 -- 100 eth + xc = TxConf <$> v ..:? "propMaxGas" ..!= maxGasPerBlock + <*> v ..:? "testMaxGas" ..!= maxGasPerBlock + <*> getWord256 "maxGasprice" 0 + <*> getWord256 "maxTimeDelay" defaultTimeDelay + <*> getWord256 "maxBlockDelay" defaultBlockDelay + <*> getWord256 "maxValue" 100000000000000000000 -- 100 eth -- TestConf tc = do diff --git a/lib/Echidna/Fetch.hs b/lib/Echidna/Fetch.hs index 38f894c60..da6251374 100644 --- a/lib/Echidna/Fetch.hs +++ b/lib/Echidna/Fetch.hs @@ -33,7 +33,7 @@ deployBytecodes' di ((a, bc):cs) d vm = where zeros = pack $ replicate 320 0 -- This will initialize with zero a large number of possible constructor parameters loadRest = do - vm' <- execStateT (execTx $ createTx (bc `append` zeros) d a (fromInteger unlimitedGasPerBlock) (0, 0)) vm + vm' <- execStateT (execTx $ createTx (bc `append` zeros) d a unlimitedGasPerBlock (0, 0)) vm case vm'._result of (Just (VMSuccess _)) -> return vm' _ -> throwM $ DeploymentFailed a (Data.Text.unlines $ extractEvents True di vm') diff --git a/lib/Echidna/RPC.hs b/lib/Echidna/RPC.hs index 797c22284..c824cd776 100644 --- a/lib/Echidna/RPC.hs +++ b/lib/Echidna/RPC.hs @@ -160,6 +160,6 @@ execEthenoTxs et = do -- | For an etheno txn, set up VM to execute txn setupEthenoTx :: MonadState VM m => Etheno -> m () setupEthenoTx (AccountCreated f) = initAddress f -- TODO: improve etheno to include initial balance -setupEthenoTx (ContractCreated f c _ _ d v) = setupTx $ createTxWithValue d f c (fromInteger unlimitedGasPerBlock) v (1, 1) -setupEthenoTx (FunctionCall f t _ _ d v) = setupTx $ Tx (SolCalldata d) f t (fromInteger unlimitedGasPerBlock) 0 v (1, 1) +setupEthenoTx (ContractCreated f c _ _ d v) = setupTx $ createTxWithValue d f c unlimitedGasPerBlock v (1, 1) +setupEthenoTx (FunctionCall f t _ _ d v) = setupTx $ Tx (SolCalldata d) f t unlimitedGasPerBlock 0 v (1, 1) setupEthenoTx (BlockMined n t) = setupTx $ Tx NoCall 0 0 0 0 0 (fromInteger t, fromInteger n) diff --git a/lib/Echidna/Solidity.hs b/lib/Echidna/Solidity.hs index f0fc8aaef..deaa4e9be 100644 --- a/lib/Echidna/Solidity.hs +++ b/lib/Echidna/Solidity.hs @@ -184,7 +184,7 @@ loadSpecified solConf name cs = do -- Set up initial VM, either with chosen contract or Etheno initialization file -- need to use snd to add to ABI dict - let vm = initialVM ffi & block . gaslimit .~ fromInteger unlimitedGasPerBlock + let vm = initialVM ffi & block . gaslimit .~ unlimitedGasPerBlock & block . maxCodeSize .~ fromInteger mcs blank' <- maybe (pure vm) (loadEthenoBatch ffi) fp let blank = populateAddresses (Set.insert d ads) bala blank' @@ -218,12 +218,12 @@ loadSpecified solConf name cs = do vm2 <- deployBytecodes di dpb d vm1 -- main contract deployment - let deployment = execTx $ createTxWithValue bc d ca (fromInteger unlimitedGasPerBlock) (fromInteger balc) (0, 0) + let deployment = execTx $ createTxWithValue bc d ca unlimitedGasPerBlock (fromInteger balc) (0, 0) vm3 <- execStateT deployment vm2 when (isNothing $ currentContract vm3) (throwM $ DeploymentFailed ca $ T.unlines $ extractEvents True di vm3) -- Run - let transaction = execTx $ uncurry basicTx setUpFunction d ca (fromInteger unlimitedGasPerBlock) (0, 0) + let transaction = execTx $ uncurry basicTx setUpFunction d ca unlimitedGasPerBlock (0, 0) vm4 <- if isDapptestMode tm && setUpFunction `elem` abi then execStateT transaction vm3 else return vm3 case vm4._result of diff --git a/lib/Echidna/Types/Tx.hs b/lib/Echidna/Types/Tx.hs index 0973a250b..ef3ee98dc 100644 --- a/lib/Echidna/Types/Tx.hs +++ b/lib/Echidna/Types/Tx.hs @@ -31,16 +31,16 @@ data TxCall = SolCreate ByteString deriving (Show, Ord, Eq) $(deriveJSON defaultOptions ''TxCall) -maxGasPerBlock :: Integer +maxGasPerBlock :: Word64 maxGasPerBlock = 12500000 -- https://cointelegraph.com/news/ethereum-miners-vote-to-increase-gas-limit-causing-community-debate -unlimitedGasPerBlock :: Integer +unlimitedGasPerBlock :: Word64 unlimitedGasPerBlock = 0xffffffff -defaultTimeDelay :: Integer +defaultTimeDelay :: W256 defaultTimeDelay = 604800 -defaultBlockDelay :: Integer +defaultBlockDelay :: W256 defaultBlockDelay = 60480 initialTimestamp :: W256 @@ -207,5 +207,5 @@ getResult (VMFailure (FFI _)) = ErrorFFI getResult (VMFailure NonceOverflow) = ErrorNonceOverflow makeSingleTx :: Addr -> Addr -> W256 -> TxCall -> [Tx] -makeSingleTx a d v (SolCall c) = [Tx (SolCall c) a d (fromInteger maxGasPerBlock) 0 v (0, 0)] +makeSingleTx a d v (SolCall c) = [Tx (SolCall c) a d maxGasPerBlock 0 v (0, 0)] makeSingleTx _ _ _ _ = error "invalid usage of makeSingleTx" diff --git a/src/test/Tests/Config.hs b/src/test/Tests/Config.hs index f1aad7f66..74bcc53e5 100644 --- a/src/test/Tests/Config.hs +++ b/src/test/Tests/Config.hs @@ -1,14 +1,16 @@ module Tests.Config (configTests) where import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (testCase, assertBool, (@?=)) +import Test.Tasty.HUnit (testCase, assertBool, (@?=), assertFailure) import Control.Lens (sans) import Control.Monad (void) import Data.Function ((&)) +import Data.Yaml qualified as Y import Echidna.Types.Config (EConfigWithUsage(..), EConfig(..)) import Echidna.Types.Campaign (CampaignConf(..)) +import Echidna.Types.Tx (TxConf(..)) import Echidna.Config (defaultConfig, parseConfig) configTests :: TestTree @@ -24,6 +26,16 @@ configTests = testGroup "Configuration tests" $ assertBool ("unused options: " ++ show bad) $ null bad let unset' = unset & sans "seed" assertBool ("unset options: " ++ show unset') $ null unset' + , testCase "W256 decoding" $ do + let maxW256 = "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff" + overW256 = "0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff0" + case Y.decodeEither' ("maxGasprice: " <> maxW256) of + Right (c :: EConfigWithUsage) | c.econfig.txConf.maxGasprice == maxBound -> pure () + Right _ -> assertFailure "wrong value decoded" + Left e -> assertFailure $ "unexpected decoding error: " <> show e + case Y.decodeEither' ("maxGasprice: " <> overW256) of + Right (_ :: EConfigWithUsage) -> assertFailure "should not decode" + Left _ -> pure () ] where files = ["basic/config.yaml", "basic/default.yaml"] assertCoverage config value = config.campaignConf.knownCoverage @?= value