|
|
@ -4,18 +4,16 @@ import Prelude hiding (Word) |
|
|
|
|
|
|
|
|
|
|
|
import Control.Exception (Exception) |
|
|
|
import Control.Exception (Exception) |
|
|
|
import Control.Lens |
|
|
|
import Control.Lens |
|
|
|
import Control.Monad (foldM, void) |
|
|
|
import Control.Monad (void) |
|
|
|
import Control.Monad.Catch (MonadThrow, throwM) |
|
|
|
import Control.Monad.Catch (MonadThrow, throwM) |
|
|
|
import Control.Monad.Fail qualified as M (MonadFail(..)) |
|
|
|
import Control.Monad.Fail qualified as M (MonadFail(..)) |
|
|
|
import Control.Monad.IO.Class (MonadIO(..)) |
|
|
|
import Control.Monad.IO.Class (MonadIO(..)) |
|
|
|
import Control.Monad.Reader.Class (MonadReader(..)) |
|
|
|
import Control.Monad.State.Strict (MonadState, get, put, execStateT) |
|
|
|
import Control.Monad.State.Strict (MonadState, runStateT, get, put) |
|
|
|
|
|
|
|
import Data.Aeson (FromJSON(..), (.:), withObject, eitherDecodeFileStrict) |
|
|
|
import Data.Aeson (FromJSON(..), (.:), withObject, eitherDecodeFileStrict) |
|
|
|
import Data.ByteString.Base16 qualified as BS16 (decode) |
|
|
|
import Data.ByteString.Base16 qualified as BS16 (decode) |
|
|
|
import Data.ByteString.Char8 (ByteString) |
|
|
|
import Data.ByteString.Char8 (ByteString) |
|
|
|
import Data.ByteString.Char8 qualified as BS |
|
|
|
import Data.ByteString.Char8 qualified as BS |
|
|
|
import Data.ByteString.Lazy qualified as LBS |
|
|
|
import Data.ByteString.Lazy qualified as LBS |
|
|
|
import Data.Has (Has(..)) |
|
|
|
|
|
|
|
import Data.Text qualified as T (drop) |
|
|
|
import Data.Text qualified as T (drop) |
|
|
|
import Data.Text.Encoding (encodeUtf8) |
|
|
|
import Data.Text.Encoding (encodeUtf8) |
|
|
|
import Data.Vector qualified as V (fromList, toList) |
|
|
|
import Data.Vector qualified as V (fromList, toList) |
|
|
@ -30,7 +28,7 @@ import Echidna.Exec |
|
|
|
import Echidna.Transaction |
|
|
|
import Echidna.Transaction |
|
|
|
import Echidna.Types.Signature (SolSignature) |
|
|
|
import Echidna.Types.Signature (SolSignature) |
|
|
|
import Echidna.ABI (encodeSig) |
|
|
|
import Echidna.ABI (encodeSig) |
|
|
|
import Echidna.Types.Tx (TxCall(..), Tx(..), TxConf, makeSingleTx, createTxWithValue, unlimitedGasPerBlock) |
|
|
|
import Echidna.Types.Tx (TxCall(..), Tx(..), makeSingleTx, createTxWithValue, unlimitedGasPerBlock) |
|
|
|
|
|
|
|
|
|
|
|
-- | During initialization we can either call a function or create an account or contract |
|
|
|
-- | 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 |
|
|
|
data Etheno = AccountCreated Addr -- ^ Registers an address with the echidna runtime |
|
|
@ -108,40 +106,36 @@ matchSignatureAndCreateTx _ _ = [] |
|
|
|
|
|
|
|
|
|
|
|
-- | Main function: takes a filepath where the initialization sequence lives and returns |
|
|
|
-- | 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 |
|
|
|
-- | the initialized VM along with a list of Addr's to put in GenConf |
|
|
|
loadEthenoBatch :: (MonadThrow m, MonadIO m, Has TxConf y, MonadReader y m, M.MonadFail m) |
|
|
|
loadEthenoBatch :: FilePath -> IO VM |
|
|
|
=> FilePath -> m VM |
|
|
|
|
|
|
|
loadEthenoBatch fp = do |
|
|
|
loadEthenoBatch fp = do |
|
|
|
bs <- liftIO $ eitherDecodeFileStrict fp |
|
|
|
bs <- eitherDecodeFileStrict fp |
|
|
|
|
|
|
|
|
|
|
|
case bs of |
|
|
|
case bs of |
|
|
|
(Left e) -> throwM $ EthenoException e |
|
|
|
Left e -> throwM $ EthenoException e |
|
|
|
(Right (ethenoInit :: [Etheno])) -> do |
|
|
|
Right (ethenoInit :: [Etheno]) -> do |
|
|
|
-- Execute contract creations and initial transactions, |
|
|
|
-- Execute contract creations and initial transactions, |
|
|
|
let initVM = foldM execEthenoTxs () ethenoInit |
|
|
|
let initVM = mapM execEthenoTxs ethenoInit |
|
|
|
(_, vm') <- runStateT initVM initialVM |
|
|
|
execStateT initVM initialVM |
|
|
|
return vm' |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- | Takes a list of Etheno transactions and loads them into the VM, returning the |
|
|
|
-- | Takes a list of Etheno transactions and loads them into the VM, returning the |
|
|
|
-- | address containing echidna tests |
|
|
|
-- | address containing echidna tests |
|
|
|
execEthenoTxs :: (MonadState x m, Has VM x, MonadThrow m, Has TxConf y, MonadReader y m, M.MonadFail m) |
|
|
|
execEthenoTxs :: (MonadState VM m, MonadFail m, MonadThrow m) => Etheno -> m () |
|
|
|
=> () -> Etheno -> m () |
|
|
|
execEthenoTxs et = do |
|
|
|
execEthenoTxs _ et = do |
|
|
|
|
|
|
|
setupEthenoTx et |
|
|
|
setupEthenoTx et |
|
|
|
sb <- get |
|
|
|
vm <- get |
|
|
|
res <- liftSH exec |
|
|
|
res <- exec |
|
|
|
case (res, et) of |
|
|
|
case (res, et) of |
|
|
|
(_ , AccountCreated _) -> return () |
|
|
|
(_ , AccountCreated _) -> return () |
|
|
|
(Reversion, _) -> void $ put sb |
|
|
|
(Reversion, _) -> void $ put vm |
|
|
|
(VMFailure x, _) -> vmExcept x >> M.fail "impossible" |
|
|
|
(VMFailure x, _) -> vmExcept x >> M.fail "impossible" |
|
|
|
(VMSuccess (ConcreteBuffer bc), |
|
|
|
(VMSuccess (ConcreteBuffer bc), |
|
|
|
ContractCreated _ ca _ _ _ _) -> do |
|
|
|
ContractCreated _ ca _ _ _ _) -> do |
|
|
|
hasLens . env . contracts . at ca . _Just . contractcode .= InitCode (ConcreteBuffer "") |
|
|
|
env . contracts . at ca . _Just . contractcode .= InitCode (ConcreteBuffer "") |
|
|
|
liftSH (replaceCodeOfSelf (RuntimeCode (ConcreteBuffer bc)) >> loadContract ca) |
|
|
|
liftSH (replaceCodeOfSelf (RuntimeCode (ConcreteBuffer bc)) >> loadContract ca) |
|
|
|
return () |
|
|
|
return () |
|
|
|
_ -> return () |
|
|
|
_ -> return () |
|
|
|
|
|
|
|
|
|
|
|
-- | For an etheno txn, set up VM to execute txn |
|
|
|
-- | For an etheno txn, set up VM to execute txn |
|
|
|
setupEthenoTx :: (MonadState x m, Has VM x) => Etheno -> m () |
|
|
|
setupEthenoTx :: MonadState VM m => Etheno -> m () |
|
|
|
setupEthenoTx (AccountCreated _) = pure () |
|
|
|
setupEthenoTx (AccountCreated _) = pure () |
|
|
|
setupEthenoTx (ContractCreated f c _ _ d v) = setupTx $ createTxWithValue d f c (fromInteger unlimitedGasPerBlock) (w256 v) (1, 1) |
|
|
|
setupEthenoTx (ContractCreated f c _ _ d v) = setupTx $ createTxWithValue d f c (fromInteger unlimitedGasPerBlock) (w256 v) (1, 1) |
|
|
|
setupEthenoTx (FunctionCall f t _ _ d v) = setupTx $ Tx (SolCalldata d) f t (fromInteger unlimitedGasPerBlock) 0 (w256 v) (1, 1) |
|
|
|
setupEthenoTx (FunctionCall f t _ _ d v) = setupTx $ Tx (SolCalldata d) f t (fromInteger unlimitedGasPerBlock) 0 (w256 v) (1, 1) |
|
|
|