diff --git a/lib/Echidna/RPC.hs b/lib/Echidna/RPC.hs index 37183ade..4a515df4 100644 --- a/lib/Echidna/RPC.hs +++ b/lib/Echidna/RPC.hs @@ -9,15 +9,16 @@ 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 Control.Monad.State.Strict (MonadState, get, put, execStateT, gets) 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.Map (member) +import Data.Set (Set) 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) @@ -26,20 +27,23 @@ import EVM.ABI (AbiType(..), AbiValue(..), decodeAbiValue, selector) import EVM.Exec (exec) import EVM.Types (Addr, W256, Expr(ConcreteBuf)) +import Echidna.ABI (encodeSig) 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 - +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 @@ -50,23 +54,23 @@ instance FromJSON Etheno where 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\"" + "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 @@ -100,13 +104,13 @@ extractFromEtheno ess ss = case ess of 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)) + 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 _ _ = [] + 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 @@ -122,10 +126,12 @@ loadEthenoBatch ffi fp = do initAddress :: MonadState VM m => Addr -> m () initAddress addr = do - cs <- use (env . EVM.contracts) + cs <- gets (._env._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 + where + account = (initialContract (RuntimeCode (ConcreteRuntimeCode mempty))) + { _nonce = 0, _balance = 100000000000000000000 } -- default balance for EOAs in etheno crashWithQueryError :: (MonadState VM m, MonadFail m, MonadThrow m) => Query -> Etheno -> m () crashWithQueryError q et = @@ -148,20 +154,28 @@ execEthenoTxs et = do 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 () + (_, AccountCreated _) -> + pure () + (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 $ do + replaceCodeOfSelf (RuntimeCode (ConcreteRuntimeCode bc)) + loadContract ca + _ -> 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) +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)