From efbdadd2ccb86600136c83507e60e4c2e8c09c7d Mon Sep 17 00:00:00 2001 From: Artur Cygan Date: Thu, 6 Apr 2023 22:06:30 +0200 Subject: [PATCH] RPC improvements (chain id, config options) --- lib/Echidna.hs | 2 +- lib/Echidna/Config.hs | 15 +- lib/Echidna/{Fetch.hs => Deploy.hs} | 2 +- lib/Echidna/Etheno.hs | 179 ++++++++++++++++++++ lib/Echidna/Exec.hs | 52 ++---- lib/Echidna/RPC.hs | 242 +++++++++------------------- lib/Echidna/Solidity.hs | 6 +- lib/Echidna/Types.hs | 5 +- lib/Echidna/Types/Campaign.hs | 3 + lib/Echidna/Types/Config.hs | 6 + package.yaml | 1 + src/Main.hs | 126 ++++++--------- src/test/Common.hs | 6 +- src/test/Tests/Compile.hs | 4 +- src/test/Tests/Seed.hs | 28 +++- tests/solidity/basic/default.yaml | 6 + 16 files changed, 385 insertions(+), 298 deletions(-) rename lib/Echidna/{Fetch.hs => Deploy.hs} (98%) create mode 100644 lib/Echidna/Etheno.hs diff --git a/lib/Echidna.hs b/lib/Echidna.hs index bc3bec136..61f5a12e7 100644 --- a/lib/Echidna.hs +++ b/lib/Echidna.hs @@ -13,9 +13,9 @@ import EVM.ABI (AbiValue(AbiAddress)) import EVM.Solidity (SolcContract(..)) import Echidna.ABI +import Echidna.Etheno (loadEtheno, extractFromEtheno) import Echidna.Output.Corpus import Echidna.Processor -import Echidna.RPC (loadEtheno, extractFromEtheno) import Echidna.Solidity import Echidna.Test (createTests) import Echidna.Types.Campaign hiding (corpus) diff --git a/lib/Echidna/Config.hs b/lib/Echidna/Config.hs index d5a265ee3..ef4694bf5 100644 --- a/lib/Echidna/Config.hs +++ b/lib/Echidna/Config.hs @@ -56,6 +56,8 @@ instance FromJSON EConfigWithUsage where <*> testConfParser <*> txConfParser <*> (UIConf <$> v ..:? "timeout" <*> formatParser) + <*> v ..:? "rpcUrl" + <*> v ..:? "rpcBlock" where useKey k = modify' $ insert k x ..:? k = useKey k >> lift (x .:? k) @@ -84,16 +86,17 @@ instance FromJSON EConfigWithUsage where pure $ TestConf classify (const psender) campaignConfParser = CampaignConf - <$> v ..:? "testLimit" ..!= defaultTestLimit - <*> v ..:? "stopOnFail" ..!= False + <$> v ..:? "testLimit" ..!= defaultTestLimit + <*> v ..:? "stopOnFail" ..!= False <*> v ..:? "estimateGas" ..!= False - <*> v ..:? "seqLen" ..!= defaultSequenceLength + <*> v ..:? "seqLen" ..!= defaultSequenceLength <*> v ..:? "shrinkLimit" ..!= defaultShrinkLimit <*> (v ..:? "coverage" <&> \case Just False -> Nothing; _ -> Just mempty) <*> v ..:? "seed" - <*> v ..:? "dictFreq" ..!= 0.40 - <*> v ..:? "corpusDir" ..!= Nothing - <*> v ..:? "mutConsts" ..!= defaultMutationConsts + <*> v ..:? "dictFreq" ..!= 0.40 + <*> v ..:? "corpusDir" ..!= Nothing + <*> v ..:? "mutConsts" ..!= defaultMutationConsts + <*> v ..:? "coverageReport" ..!= True solConfParser = SolConf <$> v ..:? "contractAddr" ..!= defaultContractAddr diff --git a/lib/Echidna/Fetch.hs b/lib/Echidna/Deploy.hs similarity index 98% rename from lib/Echidna/Fetch.hs rename to lib/Echidna/Deploy.hs index 17ac5b21f..48d2340af 100644 --- a/lib/Echidna/Fetch.hs +++ b/lib/Echidna/Deploy.hs @@ -1,4 +1,4 @@ -module Echidna.Fetch where +module Echidna.Deploy where import Control.Monad.Catch (MonadThrow(..), throwM) import Control.Monad.State.Strict (execStateT, MonadIO) diff --git a/lib/Echidna/Etheno.hs b/lib/Echidna/Etheno.hs new file mode 100644 index 000000000..9d471f679 --- /dev/null +++ b/lib/Echidna/Etheno.hs @@ -0,0 +1,179 @@ +{-# LANGUAGE GADTs #-} + +module Echidna.Etheno where + +import Prelude hiding (Word) + +import Control.Exception (Exception) +import Control.Lens +import Control.Monad (void) +import Control.Monad.Catch (MonadThrow, throwM) +import Control.Monad.Fail qualified as M (MonadFail(..)) +import Control.Monad.State.Strict (MonadState, get, put, execStateT) +import Data.Aeson (FromJSON(..), (.:), withObject, eitherDecodeFileStrict) +import Data.ByteString.Base16 qualified as BS16 (decode) +import Data.ByteString.Char8 (ByteString) +import Data.ByteString.Char8 qualified as BS +import Data.ByteString.Lazy qualified as LBS +import Data.Text qualified as T (drop) +import Data.Text.Encoding (encodeUtf8) +import Data.Map (member) +import Data.Vector qualified as V (fromList, toList) +import Text.Read (readMaybe) + +import EVM +import EVM.ABI (AbiType(..), AbiValue(..), decodeAbiValue, selector) +import EVM.Exec (exec) +import EVM.Types (Addr, W256, Expr(ConcreteBuf)) + +import Echidna.Exec +import Echidna.Transaction +import Echidna.Types.Signature (SolSignature) +import Echidna.ABI (encodeSig) +import Echidna.Types (fromEVM) +import Echidna.Types.Tx (TxCall(..), Tx(..), makeSingleTx, createTxWithValue, unlimitedGasPerBlock) +import Data.Set (Set) + +-- | During initialization we can either call a function or create an account or contract +data Etheno + -- | Registers an address with the echidna runtime + = AccountCreated Addr + -- | A contract was constructed on the blockchain + | ContractCreated Addr Addr Integer Integer ByteString W256 + -- | A contract function was executed + | FunctionCall Addr Addr Integer Integer ByteString W256 + -- | A new block was mined contract + | BlockMined Integer Integer + deriving (Eq, Show) + +instance FromJSON Etheno where + parseJSON = withObject "Etheno" $ \v -> do + (ev :: String) <- v .: "event" + let gu = maybe (M.fail "could not parse gas_used") pure . readMaybe =<< v .: "gas_used" + gp = maybe (M.fail "could not parse gas_price") pure . readMaybe =<< v .: "gas_price" + ni = maybe (M.fail "could not parse number_increase") pure . readMaybe =<< v .: "number_increment" + ti = maybe (M.fail "could not parse timestamp_increase") pure . readMaybe =<< v .: "timestamp_increment" + case ev of + "AccountCreated" -> AccountCreated <$> v .: "address" + "ContractCreated" -> ContractCreated <$> v .: "from" + <*> v .: "contract_address" + <*> gu + <*> gp + <*> (decode =<< (v .: "data")) + <*> v .: "value" + "FunctionCall" -> FunctionCall <$> v .: "from" + <*> v .: "to" + <*> gu + <*> gp + <*> (decode =<< (v .: "data")) + <*> v .: "value" + "BlockMined" -> BlockMined <$> ni + <*> ti + + _ -> M.fail "event should be one of \"AccountCreated\", \"ContractCreated\", or \"FunctionCall\"" + where decode x = case BS16.decode . encodeUtf8 . T.drop 2 $ x of + Right a -> pure a + Left e -> M.fail $ "could not decode hexstring: " <> e + + +-- | Handler for parsing errors +-- TODO: make this a better sum type +newtype EthenoException = EthenoException String + +instance Show EthenoException where + show (EthenoException e) = "Error parsing Etheno initialization file: " ++ e + +instance Exception EthenoException + +loadEtheno :: FilePath -> IO [Etheno] +loadEtheno fp = do + bs <- eitherDecodeFileStrict fp + case bs of + (Left e) -> throwM $ EthenoException e + (Right (ethenoInit :: [Etheno])) -> return ethenoInit + +extractFromEtheno :: [Etheno] -> Set SolSignature -> [Tx] +extractFromEtheno ess ss = case ess of + (BlockMined ni ti :es) -> + Tx NoCall 0 0 0 0 0 (fromInteger ti, fromInteger ni) : extractFromEtheno es ss + (c@FunctionCall{} :es) -> + concatMap (`matchSignatureAndCreateTx` c) ss ++ extractFromEtheno es ss + (_:es) -> extractFromEtheno es ss + _ -> [] + +matchSignatureAndCreateTx :: SolSignature -> Etheno -> [Tx] +matchSignatureAndCreateTx ("", []) _ = [] -- Not sure if we should match this. +matchSignatureAndCreateTx (s,ts) (FunctionCall a d _ _ bs v) = + if BS.take 4 bs == selector (encodeSig (s,ts)) + then makeSingleTx a d v $ SolCall (s, fromTuple $ decodeAbiValue t (LBS.fromStrict $ BS.drop 4 bs)) + else [] + where t = AbiTupleType (V.fromList ts) + fromTuple (AbiTuple xs) = V.toList xs + fromTuple _ = [] +matchSignatureAndCreateTx _ _ = [] + +-- | Main function: takes a filepath where the initialization sequence lives and returns +-- | the initialized VM along with a list of Addr's to put in GenConf +loadEthenoBatch :: Bool -> FilePath -> IO VM +loadEthenoBatch ffi fp = do + bs <- eitherDecodeFileStrict fp + case bs of + Left e -> throwM $ EthenoException e + Right (ethenoInit :: [Etheno]) -> do + -- Execute contract creations and initial transactions, + let initVM = mapM execEthenoTxs ethenoInit + execStateT initVM (initialVM ffi) + +initAddress :: MonadState VM m => Addr -> m () +initAddress addr = do + cs <- use (env . EVM.contracts) + if addr `member` cs then pure () + else env . EVM.contracts . at addr .= Just account + where + account = + initialContract (RuntimeCode (ConcreteRuntimeCode mempty)) + & set nonce 0 + & set balance 100000000000000000000 -- default balance for EOAs in etheno + +crashWithQueryError :: (MonadState VM m, MonadFail m, MonadThrow m) => Query -> Etheno -> m () +crashWithQueryError q et = + case (q, et) of + (PleaseFetchContract addr _, FunctionCall f t _ _ _ _) -> + error ("Address " ++ show addr ++ " was used during function call from " ++ show f ++ " to " ++ show t ++ " but it was never defined as EOA or deployed as a contract") + (PleaseFetchContract addr _, ContractCreated f t _ _ _ _) -> + error ("Address " ++ show addr ++ " was used during the contract creation of " ++ show t ++ " from " ++ show f ++ " but it was never defined as EOA or deployed as a contract") + (PleaseFetchSlot slot _ _, FunctionCall f t _ _ _ _) -> + error ("Slot " ++ show slot ++ " was used during function call from " ++ show f ++ " to " ++ show t ++ " but it was never loaded") + (PleaseFetchSlot slot _ _, ContractCreated f t _ _ _ _) -> + error ("Slot " ++ show slot ++ " was used during the contract creation of " ++ show t ++ " from " ++ show f ++ " but it was never loaded") + _ -> error $ show (q, et) + +-- | Takes a list of Etheno transactions and loads them into the VM, returning the +-- | address containing echidna tests +execEthenoTxs :: (MonadState VM m, MonadFail m, MonadThrow m) => Etheno -> m () +execEthenoTxs et = do + setupEthenoTx et + vm <- get + res <- fromEVM exec + case (res, et) of + (_ , AccountCreated _) -> return () + (Reversion, _) -> void $ put vm + (VMFailure (Query q), _) -> crashWithQueryError q et + (VMFailure x, _) -> vmExcept x >> M.fail "impossible" + (VMSuccess (ConcreteBuf bc), + ContractCreated _ ca _ _ _ _) -> do + env . contracts . at ca . _Just . contractcode .= InitCode mempty mempty + fromEVM (replaceCodeOfSelf (RuntimeCode (ConcreteRuntimeCode bc)) >> loadContract ca) + pure () + _ -> pure () + +-- | 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 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/Exec.hs b/lib/Echidna/Exec.hs index 2df0a6b99..a34a7226b 100644 --- a/lib/Echidna/Exec.hs +++ b/lib/Echidna/Exec.hs @@ -5,8 +5,8 @@ module Echidna.Exec where import Control.Lens -import Control.Monad (when) -import Control.Monad.Catch (MonadThrow(..), catchAll, SomeException) +import Control.Monad (unless) +import Control.Monad.Catch (MonadThrow(..)) import Control.Monad.State.Strict (MonadState(get, put), execState, runStateT, MonadIO(liftIO)) import Control.Monad.Reader (MonadReader, asks) import Data.IORef (readIORef, atomicWriteIORef) @@ -14,11 +14,8 @@ import Data.Map qualified as M import Data.Map qualified as Map import Data.Maybe (fromMaybe) import Data.Set qualified as S -import Data.Text qualified as Text import Data.Text qualified as T import Data.Vector qualified as V -import Text.Read (readMaybe) -import System.Environment (lookupEnv) import System.Process (readProcessWithExitCode) import EVM hiding (Env, cache, contract, tx, value) @@ -28,13 +25,14 @@ import EVM.Fetch qualified import EVM.Types (Expr(ConcreteBuf, Lit), hexText) import Echidna.Events (emptyEvents) +import Echidna.RPC (safeFetchContractFrom, safeFetchSlotFrom) import Echidna.Transaction -import Echidna.Types (ExecException(..), Gas, fromEVM) +import Echidna.Types (ExecException(..), Gas, fromEVM, emptyAccount) import Echidna.Types.Buffer (forceBuf) import Echidna.Types.Coverage (CoverageMap) import Echidna.Types.Signature (MetadataCache, getBytecodeMetadata, lookupBytecodeMetadata) import Echidna.Types.Tx (TxCall(..), Tx, TxResult(..), call, dst, initialTimestamp, initialBlockNumber) -import Echidna.Types.Config (Env(..), EConfig(..), UIConf(..), OperationMode(..), OutputFormat(Text)) +import Echidna.Types.Config (Env(..), EConfig(..)) import Echidna.Types.Solidity (SolConf(..)) import Echidna.Utility (timePrefix) @@ -57,9 +55,6 @@ getQuery :: VMResult -> Maybe Query getQuery (VMFailure (Query q)) = Just q getQuery _ = Nothing -emptyAccount :: Contract -emptyAccount = initialContract (RuntimeCode (ConcreteRuntimeCode mempty)) - -- | Matches execution errors that just cause a reversion. pattern Reversion :: VMResult pattern Reversion <- VMFailure (classifyError -> RevertE) @@ -91,6 +86,10 @@ execTxWith l onErr executeTx tx = do pure (vmResult, gasLeftBeforeTx - gasLeftAfterTx) where runFully = do + config <- asks (.cfg) + -- TODO: Is the latest block a good default? It makes fuzzing hard to reproduce. Rethink this. + let rpcBlock = maybe EVM.Fetch.Latest (EVM.Fetch.BlockNumber . fromIntegral) config.rpcBlock + vmResult <- executeTx -- For queries, we halt execution because the VM needs some additional -- information from the outside. We provide this information and resume @@ -106,9 +105,8 @@ execTxWith l onErr executeTx tx = do l %= execState (continuation emptyAccount) Nothing -> do logMsg $ "INFO: Performing RPC: " <> show q - getRpcUrl >>= \case + case config.rpcUrl of Just rpcUrl -> do - rpcBlock <- getRpcBlock ret <- liftIO $ safeFetchContractFrom rpcBlock rpcUrl addr case ret of -- TODO: fix hevm to not return an empty contract in case of an error @@ -145,9 +143,8 @@ execTxWith l onErr executeTx tx = do Just Nothing -> l %= execState (continuation 0) Nothing -> do logMsg $ "INFO: Performing RPC: " <> show q - getRpcUrl >>= \case + case config.rpcUrl of Just rpcUrl -> do - rpcBlock <- getRpcBlock ret <- liftIO $ safeFetchSlotFrom rpcBlock rpcUrl addr slot case ret of Just value -> do @@ -177,30 +174,6 @@ execTxWith l onErr executeTx tx = do -- No queries to answer, the tx is fully executed and the result is final _ -> pure vmResult - where - -- TODO: Currently, for simplicity we get those values from env vars. - -- Make it posible to pass through the config file and CLI - getRpcUrl = liftIO $ do - val <- lookupEnv "ECHIDNA_RPC_URL" - pure (Text.pack <$> val) - - getRpcBlock = liftIO $ do - -- TODO: Is the latest block a good default? It makes fuzzing hard to - -- reproduce. Rethink this. - val <- lookupEnv "ECHIDNA_RPC_BLOCK" - pure $ maybe EVM.Fetch.Latest EVM.Fetch.BlockNumber (val >>= readMaybe) - - -- TODO: temporary solution, handle errors gracefully - safeFetchContractFrom rpcBlock rpcUrl addr = - catchAll - (EVM.Fetch.fetchContractFrom rpcBlock rpcUrl addr) - (\(_e :: SomeException) -> pure $ Just emptyAccount) - - -- TODO: temporary solution, handle errors gracefully - safeFetchSlotFrom rpcBlock rpcUrl addr slot = - catchAll - (EVM.Fetch.fetchSlotFrom rpcBlock rpcUrl addr slot) - (\(_e :: SomeException) -> pure $ Just 0) -- | Handles reverts, failures and contract creations that might be the result -- (`vmResult`) of executing transaction `tx`. @@ -233,8 +206,7 @@ execTxWith l onErr executeTx tx = do logMsg :: (MonadIO m, MonadReader Env m) => String -> m () logMsg msg = do cfg <- asks (.cfg) - operationMode <- asks (.cfg.uiConf.operationMode) - when (operationMode == NonInteractive Text && not cfg.solConf.quiet) $ liftIO $ do + unless (cfg.solConf.quiet) $ liftIO $ do time <- timePrefix putStrLn $ time <> msg diff --git a/lib/Echidna/RPC.hs b/lib/Echidna/RPC.hs index 37183adef..429ebc24f 100644 --- a/lib/Echidna/RPC.hs +++ b/lib/Echidna/RPC.hs @@ -1,167 +1,85 @@ -{-# LANGUAGE GADTs #-} +{-# LANGUAGE DeriveAnyClass #-} module Echidna.RPC where -import Prelude hiding (Word) - -import Control.Exception (Exception) -import Control.Lens -import Control.Monad (void) -import Control.Monad.Catch (MonadThrow, throwM) -import Control.Monad.Fail qualified as M (MonadFail(..)) -import Control.Monad.State.Strict (MonadState, get, put, execStateT) -import Data.Aeson (FromJSON(..), (.:), withObject, eitherDecodeFileStrict) -import Data.ByteString.Base16 qualified as BS16 (decode) -import Data.ByteString.Char8 (ByteString) -import Data.ByteString.Char8 qualified as BS -import Data.ByteString.Lazy qualified as LBS -import Data.Text qualified as T (drop) -import Data.Text.Encoding (encodeUtf8) -import Data.Map (member) -import Data.Vector qualified as V (fromList, toList) +import Control.Exception (SomeException) +import Control.Monad.Catch (catchAll) +import Data.Aeson (ToJSON, FromJSON, ToJSONKey(toJSONKey)) +import Data.Aeson.Types (toJSONKeyText) +import Data.ByteString (ByteString) +import Data.Text qualified as Text +import Data.Text (Text) +import Data.Word (Word64) +import GHC.Generics (Generic) +import Network.Wreq.Session qualified as Session +import System.Environment import Text.Read (readMaybe) -import EVM -import EVM.ABI (AbiType(..), AbiValue(..), decodeAbiValue, selector) -import EVM.Exec (exec) -import EVM.Types (Addr, W256, Expr(ConcreteBuf)) - -import Echidna.Exec -import Echidna.Transaction -import Echidna.Types.Signature (SolSignature) -import Echidna.ABI (encodeSig) -import Echidna.Types (fromEVM) -import Echidna.Types.Tx (TxCall(..), Tx(..), makeSingleTx, createTxWithValue, unlimitedGasPerBlock) -import Data.Set (Set) - --- | During initialization we can either call a function or create an account or contract -data Etheno = AccountCreated Addr -- ^ Registers an address with the echidna runtime - | ContractCreated Addr Addr Integer Integer ByteString W256 -- ^ A contract was constructed on the blockchain - | FunctionCall Addr Addr Integer Integer ByteString W256 -- ^ A contract function was executed - | BlockMined Integer Integer -- ^ A new block was mined contract - - deriving (Eq, Show) - -instance FromJSON Etheno where - parseJSON = withObject "Etheno" $ \v -> do - (ev :: String) <- v .: "event" - let gu = maybe (M.fail "could not parse gas_used") pure . readMaybe =<< v .: "gas_used" - gp = maybe (M.fail "could not parse gas_price") pure . readMaybe =<< v .: "gas_price" - ni = maybe (M.fail "could not parse number_increase") pure . readMaybe =<< v .: "number_increment" - ti = maybe (M.fail "could not parse timestamp_increase") pure . readMaybe =<< v .: "timestamp_increment" - case ev of - "AccountCreated" -> AccountCreated <$> v .: "address" - "ContractCreated" -> ContractCreated <$> v .: "from" - <*> v .: "contract_address" - <*> gu - <*> gp - <*> (decode =<< (v .: "data")) - <*> v .: "value" - "FunctionCall" -> FunctionCall <$> v .: "from" - <*> v .: "to" - <*> gu - <*> gp - <*> (decode =<< (v .: "data")) - <*> v .: "value" - "BlockMined" -> BlockMined <$> ni - <*> ti - - _ -> M.fail "event should be one of \"AccountCreated\", \"ContractCreated\", or \"FunctionCall\"" - where decode x = case BS16.decode . encodeUtf8 . T.drop 2 $ x of - Right a -> pure a - Left e -> M.fail $ "could not decode hexstring: " <> e - - --- | Handler for parsing errors --- TODO: make this a better sum type -newtype EthenoException = EthenoException String - -instance Show EthenoException where - show (EthenoException e) = "Error parsing Etheno initialization file: " ++ e - -instance Exception EthenoException - -loadEtheno :: FilePath -> IO [Etheno] -loadEtheno fp = do - bs <- eitherDecodeFileStrict fp - case bs of - (Left e) -> throwM $ EthenoException e - (Right (ethenoInit :: [Etheno])) -> return ethenoInit - -extractFromEtheno :: [Etheno] -> Set SolSignature -> [Tx] -extractFromEtheno ess ss = case ess of - (BlockMined ni ti :es) -> - Tx NoCall 0 0 0 0 0 (fromInteger ti, fromInteger ni) : extractFromEtheno es ss - (c@FunctionCall{} :es) -> - concatMap (`matchSignatureAndCreateTx` c) ss ++ extractFromEtheno es ss - (_:es) -> extractFromEtheno es ss - _ -> [] - -matchSignatureAndCreateTx :: SolSignature -> Etheno -> [Tx] -matchSignatureAndCreateTx ("", []) _ = [] -- Not sure if we should match this. -matchSignatureAndCreateTx (s,ts) (FunctionCall a d _ _ bs v) = - if BS.take 4 bs == selector (encodeSig (s,ts)) - then makeSingleTx a d v $ SolCall (s, fromTuple $ decodeAbiValue t (LBS.fromStrict $ BS.drop 4 bs)) - else [] - where t = AbiTupleType (V.fromList ts) - fromTuple (AbiTuple xs) = V.toList xs - fromTuple _ = [] -matchSignatureAndCreateTx _ _ = [] - --- | Main function: takes a filepath where the initialization sequence lives and returns --- | the initialized VM along with a list of Addr's to put in GenConf -loadEthenoBatch :: Bool -> FilePath -> IO VM -loadEthenoBatch ffi fp = do - bs <- eitherDecodeFileStrict fp - case bs of - Left e -> throwM $ EthenoException e - Right (ethenoInit :: [Etheno]) -> do - -- Execute contract creations and initial transactions, - let initVM = mapM execEthenoTxs ethenoInit - execStateT initVM (initialVM ffi) - -initAddress :: MonadState VM m => Addr -> m () -initAddress addr = do - cs <- use (env . EVM.contracts) - if addr `member` cs then pure () - else env . EVM.contracts . at addr .= Just account - where account = initialContract (RuntimeCode (ConcreteRuntimeCode mempty)) & set nonce 0 & set balance 100000000000000000000 -- default balance for EOAs in etheno - -crashWithQueryError :: (MonadState VM m, MonadFail m, MonadThrow m) => Query -> Etheno -> m () -crashWithQueryError q et = - case (q, et) of - (PleaseFetchContract addr _, FunctionCall f t _ _ _ _) -> - error ("Address " ++ show addr ++ " was used during function call from " ++ show f ++ " to " ++ show t ++ " but it was never defined as EOA or deployed as a contract") - (PleaseFetchContract addr _, ContractCreated f t _ _ _ _) -> - error ("Address " ++ show addr ++ " was used during the contract creation of " ++ show t ++ " from " ++ show f ++ " but it was never defined as EOA or deployed as a contract") - (PleaseFetchSlot slot _ _, FunctionCall f t _ _ _ _) -> - error ("Slot " ++ show slot ++ " was used during function call from " ++ show f ++ " to " ++ show t ++ " but it was never loaded") - (PleaseFetchSlot slot _ _, ContractCreated f t _ _ _ _) -> - error ("Slot " ++ show slot ++ " was used during the contract creation of " ++ show t ++ " from " ++ show f ++ " but it was never loaded") - _ -> error $ show (q, et) - --- | Takes a list of Etheno transactions and loads them into the VM, returning the --- | address containing echidna tests -execEthenoTxs :: (MonadState VM m, MonadFail m, MonadThrow m) => Etheno -> m () -execEthenoTxs et = do - setupEthenoTx et - vm <- get - res <- fromEVM exec - case (res, et) of - (_ , AccountCreated _) -> return () - (Reversion, _) -> void $ put vm - (VMFailure (Query q), _) -> crashWithQueryError q et - (VMFailure x, _) -> vmExcept x >> M.fail "impossible" - (VMSuccess (ConcreteBuf bc), - ContractCreated _ ca _ _ _ _) -> do - env . contracts . at ca . _Just . contractcode .= InitCode mempty mempty - fromEVM (replaceCodeOfSelf (RuntimeCode (ConcreteRuntimeCode bc)) >> loadContract ca) - return () - _ -> return () - --- | 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 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) +import EVM (Contract(..), ContractCode(RuntimeCode), RuntimeCode (..), initialContract) +import EVM.Fetch qualified +import EVM.Types (Addr, W256) + +import Echidna.Types (emptyAccount) +import Echidna.Orphans.JSON () + +rpcUrlEnv :: IO (Maybe Text) +rpcUrlEnv = do + val <- lookupEnv "ECHIDNA_RPC_URL" + pure (Text.pack <$> val) + +rpcBlockEnv :: IO (Maybe Word64) +rpcBlockEnv = do + val <- lookupEnv "ECHIDNA_RPC_BLOCK" + pure (val >>= readMaybe) + +-- TODO: temporary solution, handle errors gracefully +safeFetchContractFrom :: EVM.Fetch.BlockNumber -> Text -> Addr -> IO (Maybe Contract) +safeFetchContractFrom rpcBlock rpcUrl addr = + catchAll + (EVM.Fetch.fetchContractFrom rpcBlock rpcUrl addr) + (\(_e :: SomeException) -> pure $ Just emptyAccount) + +-- TODO: temporary solution, handle errors gracefully +safeFetchSlotFrom :: EVM.Fetch.BlockNumber -> Text -> Addr -> W256 -> IO (Maybe W256) +safeFetchSlotFrom rpcBlock rpcUrl addr slot = + catchAll + (EVM.Fetch.fetchSlotFrom rpcBlock rpcUrl addr slot) + (\(_e :: SomeException) -> pure $ Just 0) + +fetchChainId :: Maybe Text -> IO (Maybe W256) +fetchChainId (Just url) = do + sess <- Session.newAPISession + EVM.Fetch.fetchQuery + EVM.Fetch.Latest -- this shouldn't matter + (EVM.Fetch.fetchWithSession url sess) + EVM.Fetch.QueryChainId +fetchChainId Nothing = pure Nothing + +data FetchedContractData = FetchedContractData + { runtimeCode :: ByteString + , nonce :: W256 + , balance :: W256 + } + deriving (Generic, ToJSON, FromJSON, Show) + +instance ToJSONKey W256 where + toJSONKey = toJSONKeyText (Text.pack . show) + +fromFetchedContractData :: FetchedContractData -> Contract +fromFetchedContractData contractData = + (initialContract (RuntimeCode (ConcreteRuntimeCode contractData.runtimeCode))) + { _nonce = contractData.nonce + , _balance = contractData.balance + , _external = True + } + +toFetchedContractData :: Contract -> FetchedContractData +toFetchedContractData contract = + let code = case contract._contractcode of + RuntimeCode (ConcreteRuntimeCode c) -> c + _ -> error "unexpected code" + in FetchedContractData + { runtimeCode = code + , nonce = contract._nonce + , balance = contract._balance + } diff --git a/lib/Echidna/Solidity.hs b/lib/Echidna/Solidity.hs index cb3dabf6e..542880c39 100644 --- a/lib/Echidna/Solidity.hs +++ b/lib/Echidna/Solidity.hs @@ -34,11 +34,11 @@ import EVM.Solidity import EVM.Types (Addr) import Echidna.ABI (encodeSig, encodeSigWithName, hashSig, fallback, commonTypeSizes, mkValidAbiInt, mkValidAbiUInt) -import Echidna.Exec (execTx, initialVM) +import Echidna.Deploy (deployContracts, deployBytecodes) +import Echidna.Etheno (loadEthenoBatch) import Echidna.Events (EventMap, extractEvents) -import Echidna.Fetch (deployContracts, deployBytecodes) +import Echidna.Exec (execTx, initialVM) import Echidna.Processor -import Echidna.RPC (loadEthenoBatch) import Echidna.Test (createTests, isAssertionMode, isPropertyMode, isDapptestMode) import Echidna.Types.Config (EConfig(..), Env(..)) import Echidna.Types.Signature (ContractName, FunctionHash, SolSignature, SignatureMap, getBytecodeMetadata) diff --git a/lib/Echidna/Types.hs b/lib/Echidna/Types.hs index c57725737..cec099a2d 100644 --- a/lib/Echidna/Types.hs +++ b/lib/Echidna/Types.hs @@ -1,6 +1,6 @@ module Echidna.Types where -import EVM (Error, EVM, VM) +import EVM (Error, EVM, VM, Contract, initialContract, ContractCode (RuntimeCode), RuntimeCode (ConcreteRuntimeCode)) import Control.Exception (Exception) import Control.Monad.State.Strict (MonadState, runState, get, put) import Data.Word (Word64) @@ -26,3 +26,6 @@ fromEVM evmAction = do let (r, vm') = runState evmAction vm put vm' pure r + +emptyAccount :: Contract +emptyAccount = initialContract (RuntimeCode (ConcreteRuntimeCode mempty)) diff --git a/lib/Echidna/Types/Campaign.hs b/lib/Echidna/Types/Campaign.hs index 659d01347..e3ec2e276 100644 --- a/lib/Echidna/Types/Campaign.hs +++ b/lib/Echidna/Types/Campaign.hs @@ -33,6 +33,9 @@ data CampaignConf = CampaignConf , corpusDir :: Maybe FilePath -- ^ Directory to load and save lists of transactions , mutConsts :: MutationConsts Integer + -- ^ Directory to load and save lists of transactions + , coverageReport :: Bool + -- ^ Whether or not to generate a coverage report } -- | The state of a fuzzing campaign. diff --git a/lib/Echidna/Types/Config.hs b/lib/Echidna/Types/Config.hs index bffbbf24c..cc5e645b9 100644 --- a/lib/Echidna/Types/Config.hs +++ b/lib/Echidna/Types/Config.hs @@ -4,6 +4,8 @@ import Data.Aeson.Key (Key) import Data.HashSet (HashSet) import Data.IORef (IORef) import Data.Map (Map) +import Data.Text (Text) +import Data.Word (Word64) import EVM (Contract) import EVM.Dapp (DappInfo) @@ -35,6 +37,9 @@ data EConfig = EConfig , testConf :: TestConf , txConf :: TxConf , uiConf :: UIConf + + , rpcUrl :: Maybe Text + , rpcBlock :: Maybe Word64 } instance Read OutputFormat where @@ -57,4 +62,5 @@ data Env = Env , metadataCache :: IORef MetadataCache , fetchContractCache :: IORef (Map Addr (Maybe Contract)) , fetchSlotCache :: IORef (Map Addr (Map W256 (Maybe W256))) + , chainId :: Maybe W256 } diff --git a/package.yaml b/package.yaml index 0866033c0..40dd022b9 100644 --- a/package.yaml +++ b/package.yaml @@ -50,6 +50,7 @@ dependencies: - http-conduit - html-conduit - xml-conduit + - wreq language: GHC2021 diff --git a/src/Main.hs b/src/Main.hs index f235abe6e..f546d79cc 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,16 +1,13 @@ {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveAnyClass #-} module Main where import Control.Lens (view) -import Control.Monad (unless, forM_) +import Control.Monad (unless, forM_, when) import Control.Monad.Reader (runReaderT) import Control.Monad.Random (getRandomR) -import Data.Aeson (ToJSON, FromJSON, ToJSONKey) import Data.Aeson qualified as JSON import Data.Aeson.Key qualified as Aeson.Key -import Data.Aeson.Types (toJSONKeyText) import Data.ByteString qualified as BS import Data.ByteString.UTF8 qualified as UTF8 import Data.Function ((&)) @@ -26,19 +23,16 @@ import Data.Text qualified as Text import Data.Time.Clock.System (getSystemTime, systemSeconds) import Data.Vector qualified as Vector import Data.Version (showVersion) -import GHC.Generics (Generic) import Main.Utf8 (withUtf8) import Options.Applicative import Paths_echidna (version) import System.Directory (createDirectoryIfMissing, doesFileExist) -import System.Environment (lookupEnv) import System.Exit (exitWith, exitSuccess, ExitCode(..)) import System.FilePath (()) import System.IO (hPutStrLn, stderr) import System.IO.CodePage (withCP65001) -import Text.Read (readMaybe) -import EVM (Contract(..), bytecode, ContractCode (RuntimeCode), RuntimeCode (ConcreteRuntimeCode), initialContract) +import EVM (Contract(..), bytecode) import EVM.Dapp (dappInfo) import EVM.Solidity (SolcContract(..), SourceCache(..)) import EVM.Types (Addr, keccak', W256) @@ -55,6 +49,7 @@ import Echidna.Campaign (isSuccessful) import Echidna.UI import Echidna.Output.Source import Echidna.Output.Corpus +import Echidna.RPC qualified as RPC import Echidna.Solidity (compileContracts, selectSourceCache) import Echidna.Utility (measureIO) import Etherscan qualified @@ -62,31 +57,30 @@ import Etherscan qualified main :: IO () main = withUtf8 $ withCP65001 $ do opts@Options{..} <- execParser optsParser - seed <- getRandomR (0, maxBound) EConfigWithUsage loadedCfg ks _ <- maybe (pure (EConfigWithUsage defaultConfig mempty mempty)) parseConfig cliConfigFilepath - let cfg = overrideConfig loadedCfg opts + cfg <- overrideConfig loadedCfg opts + unless cfg.solConf.quiet $ forM_ ks $ hPutStrLn stderr . ("Warning: unused option: " ++) . Aeson.Key.toString -- Try to load the persisted RPC cache. TODO: we use the corpus dir for now, -- think where to place it - maybeBlock :: Maybe Int <- lookupEnv "ECHIDNA_RPC_BLOCK" <&> (>>= readMaybe) (loadedContractsCache, loadedSlotsCache) <- case cfg.campaignConf.corpusDir of Nothing -> pure (Nothing, Nothing) Just dir -> do let cache_dir = dir "cache" createDirectoryIfMissing True cache_dir - case maybeBlock of + case cfg.rpcBlock of Just block -> do - parsedContracts :: Maybe (Map Addr FetchedContractData) <- + parsedContracts :: Maybe (Map Addr RPC.FetchedContractData) <- readFileIfExists (cache_dir "block_" <> show block <> "_fetch_cache_contracts.json") <&> (>>= JSON.decodeStrict) parsedSlots :: Maybe (Map Addr (Map W256 (Maybe W256))) <- readFileIfExists (cache_dir "block_" <> show block <> "_fetch_cache_slots.json") <&> (>>= JSON.decodeStrict) - pure (Map.map (Just . fromFetchedContractData) <$> parsedContracts, parsedSlots) + pure (Map.map (Just . RPC.fromFetchedContractData) <$> parsedContracts, parsedSlots) Nothing -> pure (Nothing, Nothing) @@ -97,13 +91,18 @@ main = withUtf8 $ withCP65001 $ do cacheContractsRef <- newIORef $ fromMaybe mempty loadedContractsCache cacheSlotsRef <- newIORef $ fromMaybe mempty loadedSlotsCache cacheMetaRef <- newIORef mempty + chainId <- RPC.fetchChainId cfg.rpcUrl + let env = Env { cfg = cfg -- TODO put in real path , dapp = dappInfo "/" solcByName sourceCache , metadataCache = cacheMetaRef , fetchContractCache = cacheContractsRef - , fetchSlotCache = cacheSlotsRef } + , fetchSlotCache = cacheSlotsRef + , chainId = chainId + } + seed <- getRandomR (0, maxBound) (vm, world, echidnaTests, dict) <- prepareContract env contracts cliFilePath cliSelectedContract seed initialCorpus <- loadInitialCorpus env world @@ -118,11 +117,11 @@ main = withUtf8 $ withCP65001 $ do Nothing -> pure () Just dir -> do let cache_dir = dir "cache" - case maybeBlock of + case cfg.rpcBlock of Just block -> do -- Save fetched data, it's okay to override as the cache only grows JSON.encodeFile (cache_dir "block_" <> show block <> "_fetch_cache_contracts.json") - (toFetchedContractData <$> Map.mapMaybe id contractsCache) + (RPC.toFetchedContractData <$> Map.mapMaybe id contractsCache) JSON.encodeFile (cache_dir "block_" <> show block <> "_fetch_cache_slots.json") slotsCache Nothing -> @@ -133,28 +132,31 @@ main = withUtf8 $ withCP65001 $ do measureIO cfg.solConf.quiet "Saving corpus" $ saveTxs (dir "coverage") (snd <$> Set.toList campaign.corpus) - -- TODO: Add another option to config for saving coverage report - - -- We need runId to have a unique directory to save files under so they - -- don't collide with the next runs. We use the current time for this - -- as it orders the runs chronologically. - runId <- fromIntegral . systemSeconds <$> getSystemTime - - forM_ (Map.toList contractsCache) $ \(addr, mc) -> - case mc of - Just contract -> do - r <- externalSolcContract addr contract - case r of - Just (externalSourceCache, solcContract) -> do - let dir' = dir show addr - saveCoverage False runId dir' externalSourceCache [solcContract] campaign.coverage - saveCoverage True runId dir' externalSourceCache [solcContract] campaign.coverage - Nothing -> pure () - Nothing -> pure () - - -- save source coverage reports - saveCoverage False runId dir sourceCache contracts campaign.coverage - saveCoverage True runId dir sourceCache contracts campaign.coverage + -- TODO: We use the corpus dir to save coverage reports which is confusing. + -- Add config option to pass dir for saving coverage report and decouple it + -- from corpusDir. + when cfg.campaignConf.coverageReport $ do + -- We need runId to have a unique directory to save files under so they + -- don't collide with the next runs. We use the current time for this + -- as it orders the runs chronologically. + runId <- fromIntegral . systemSeconds <$> getSystemTime + + -- coverage reports for external contracts + forM_ (Map.toList contractsCache) $ \(addr, mc) -> + case mc of + Just contract -> do + r <- externalSolcContract addr contract + case r of + Just (externalSourceCache, solcContract) -> do + let dir' = dir show addr + saveCoverage False runId dir' externalSourceCache [solcContract] campaign.coverage + saveCoverage True runId dir' externalSourceCache [solcContract] campaign.coverage + Nothing -> pure () + Nothing -> pure () + + -- save source coverage reports + saveCoverage False runId dir sourceCache contracts campaign.coverage + saveCoverage True runId dir sourceCache contracts campaign.coverage if isSuccessful campaign then exitSuccess else exitWith (ExitFailure 1) @@ -196,35 +198,6 @@ main = withUtf8 $ withCP65001 $ do } pure (sourceCache, solcContract) -data FetchedContractData = FetchedContractData - { runtimeCode :: BS.ByteString - , nonce :: W256 - , balance :: W256 - } - deriving (Generic, ToJSON, FromJSON, Show) - -fromFetchedContractData :: FetchedContractData -> Contract -fromFetchedContractData contractData = - (initialContract (EVM.RuntimeCode (EVM.ConcreteRuntimeCode contractData.runtimeCode))) - { _nonce = contractData.nonce - , _balance = contractData.balance - , _external = True - } - -toFetchedContractData :: Contract -> FetchedContractData -toFetchedContractData contract = - let code = case contract._contractcode of - RuntimeCode (ConcreteRuntimeCode c) -> c - _ -> error "unexpected code" - in FetchedContractData - { runtimeCode = code - , nonce = contract._nonce - , balance = contract._balance - } - -instance ToJSONKey W256 where - toJSONKey = toJSONKeyText (Text.pack . show) - readFileIfExists :: FilePath -> IO (Maybe BS.ByteString) readFileIfExists path = do exists <- doesFileExist path @@ -307,12 +280,17 @@ versionOption = infoOption ("Echidna " ++ showVersion version) (long "version" <> help "Show version") -overrideConfig :: EConfig -> Options -> EConfig -overrideConfig config Options{..} = - config { solConf = overrideSolConf config.solConf - , campaignConf = overrideCampaignConf config.campaignConf - } - & overrideFormat +overrideConfig :: EConfig -> Options -> IO EConfig +overrideConfig config Options{..} = do + rpcUrl <- RPC.rpcUrlEnv + rpcBlock <- RPC.rpcBlockEnv + pure $ + config { solConf = overrideSolConf config.solConf + , campaignConf = overrideCampaignConf config.campaignConf + , rpcUrl = rpcUrl <|> config.rpcUrl + , rpcBlock = rpcBlock <|> config.rpcBlock + } + & overrideFormat where overrideFormat cfg = case maybe cfg.uiConf.operationMode NonInteractive cliOutputFormat of diff --git a/src/test/Common.hs b/src/test/Common.hs index 3871aa389..a01a61c12 100644 --- a/src/test/Common.hs +++ b/src/test/Common.hs @@ -103,7 +103,8 @@ runContract f selectedContract cfg = do , dapp = dappInfo "/" solcByName sourceCache , metadataCache = cacheMeta , fetchContractCache = cacheContracts - , fetchSlotCache = cacheSlots } + , fetchSlotCache = cacheSlots + , chainId = Nothing } (vm, world, echidnaTests, dict) <- prepareContract env contracts (f :| []) selectedContract seed let corpus = [] -- start ui and run tests @@ -136,7 +137,8 @@ checkConstructorConditions fp as = testCase fp $ do , dapp = emptyDapp , metadataCache = cacheMeta , fetchContractCache = cacheContracts - , fetchSlotCache = cacheSlots } + , fetchSlotCache = cacheSlots + , chainId = Nothing } (v, _, t) <- loadSolTests env (fp :| []) Nothing r <- flip runReaderT env $ mapM (\u -> evalStateT (checkETest u) v) t diff --git a/src/test/Tests/Compile.hs b/src/test/Tests/Compile.hs index 2e414e1c4..f704e4083 100644 --- a/src/test/Tests/Compile.hs +++ b/src/test/Tests/Compile.hs @@ -46,5 +46,7 @@ loadFails fp c e p = testCase fp . catch tryLoad $ assertBool e . p where , dapp = emptyDapp , metadataCache = cacheMeta , fetchContractCache = cacheContracts - , fetchSlotCache = cacheSlots } + , fetchSlotCache = cacheSlots + , chainId = Nothing + } void $ loadSolTests env (fp :| []) c diff --git a/src/test/Tests/Seed.hs b/src/test/Tests/Seed.hs index b4a5b0af8..fd7560a2d 100644 --- a/src/test/Tests/Seed.hs +++ b/src/test/Tests/Seed.hs @@ -16,10 +16,24 @@ seedTests = [ testCase "different seeds" $ assertBool "results are the same" . not =<< same 0 2 , testCase "same seeds" $ assertBool "results differ" =<< same 0 0 ] - where cfg s = defaultConfig - { campaignConf = CampaignConf 600 False False 20 0 Nothing (Just s) 0.15 Nothing defaultMutationConsts } - & overrideQuiet - gen s = do - camp <- runContract "basic/flags.sol" Nothing (cfg s) - pure camp.tests - same s t = (==) <$> gen s <*> gen t + where + cfg s = defaultConfig + { campaignConf = CampaignConf + { testLimit = 600 + , stopOnFail = False + , estimateGas = False + , seqLen = 20 + , shrinkLimit = 0 + , knownCoverage = Nothing + , seed = Just s + , dictFreq = 0.15 + , corpusDir = Nothing + , mutConsts = defaultMutationConsts + , coverageReport = False + } + } + & overrideQuiet + gen s = do + camp <- runContract "basic/flags.sol" Nothing (cfg s) + pure camp.tests + same s t = (==) <$> gen s <*> gen t diff --git a/tests/solidity/basic/default.yaml b/tests/solidity/basic/default.yaml index 5d31933de..a87dfb868 100644 --- a/tests/solidity/basic/default.yaml +++ b/tests/solidity/basic/default.yaml @@ -81,3 +81,9 @@ corpusDir: null mutConsts: [1, 1, 1, 1] # maximum value to send to payable functions maxValue: 100000000000000000000 # 100 eth +# URL to fetch contracts over RPC +rpcUrl: null +# block number to use when fetching over RPC +rpcBlock: null +# whether or not to generate a coverage report +coverageReport: false