Skip to content

Commit bdbb3e2

Browse files
gustavo-griecogustavo-grieco
authored
Refactor and improve etheno support to be more useful (#615)
* first attempt * more code * CI test fixes * CI test fixes * fixes
1 parent 4a02bfb commit bdbb3e2

File tree

5 files changed

+110
-78
lines changed

5 files changed

+110
-78
lines changed

‎lib/Echidna.hs‎

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@ import Control.Monad.Catch (MonadCatch(..))
88
import Control.Monad.Reader (MonadReader, MonadIO, liftIO)
99
import Control.Monad.Random (MonadRandom)
1010
import Data.Map.Strict (keys)
11+
import Data.HashMap.Strict (toList)
12+
import Data.List (nub)
1113

1214
import EVM (env, contracts, VM)
1315
import EVM.ABI (AbiValue(AbiAddress))
@@ -23,6 +25,7 @@ import Echidna.Types.Tx
2325
import Echidna.Types.World
2426
import Echidna.Processor
2527
import Echidna.Output.Corpus
28+
import Echidna.RPC (loadEtheno, extractFromEtheno)
2629

2730
import qualified Data.List.NonEmpty as NE
2831

@@ -42,7 +45,7 @@ prepareContract :: (MonadCatch m, MonadRandom m, MonadReader x m, MonadIO m, Mon
4245
Has TxConf x, Has SolConf x)
4346
=> EConfig -> NE.NonEmpty FilePath -> Maybe ContractName -> Seed -> m (VM, SourceCache, [SolcContract], World, [SolTest], Maybe GenDict, [[Tx]])
4447
prepareContract cfg fs c g = do
45-
txs <- liftIO $ loadTxs cd
48+
ctxs <- liftIO $ loadTxs cd
4649

4750
-- compile and load contracts
4851
(cs, sc) <- Echidna.Solidity.contracts fs
@@ -56,9 +59,16 @@ prepareContract cfg fs c g = do
5659
-- load tests
5760
(v, w, ts) <- prepareForTest p c si
5861
let ads' = AbiAddress <$> v ^. env . EVM.contracts . to keys
62+
-- get signatures
63+
let sigs = nub $ concatMap (NE.toList . snd) (toList $ w ^. highSignatureMap)
64+
65+
-- load transactions from init sequence (if any)
66+
es' <- liftIO $ maybe (return []) loadEtheno it
5967
let constants' = enhanceConstants si ++ timeConstants ++ largeConstants ++ NE.toList ads ++ ads'
68+
let txs = ctxs ++ maybe [] (const [extractFromEtheno es' sigs]) it
6069

6170
-- start ui and run tests
6271
return (v, sc, cs, w, ts, Just $ mkGenDict df constants' [] g (returnTypes cs), txs)
6372
where cd = cfg ^. cConf . corpusDir
6473
df = cfg ^. cConf . dictFreq
74+
it = cfg ^. sConf . initialize

‎lib/Echidna/RPC.hs‎

Lines changed: 62 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,3 @@
1-
{-# LANGUAGE LambdaCase #-}
21
{-# LANGUAGE FlexibleContexts #-}
32
{-# LANGUAGE OverloadedStrings #-}
43
{-# LANGUAGE ScopedTypeVariables #-}
@@ -9,43 +8,53 @@ import Prelude hiding (Word)
98

109
import Control.Exception (Exception)
1110
import Control.Lens
12-
import Control.Monad (foldM)
11+
import Control.Monad (foldM, void)
1312
import Control.Monad.Catch (MonadThrow, throwM)
1413
import Control.Monad.IO.Class (MonadIO(..))
1514
import Control.Monad.Reader.Class (MonadReader(..))
16-
import Control.Monad.State.Strict (MonadState, execStateT, runStateT, get, put)
15+
import Control.Monad.State.Strict (MonadState, runStateT, get, put)
1716
import Data.Aeson (FromJSON(..), (.:), withObject, eitherDecodeFileStrict)
18-
import Data.Binary.Get (runGetOrFail)
1917
import Data.ByteString.Char8 (ByteString)
2018
import Data.Has (Has(..))
2119
import Data.Text.Encoding (encodeUtf8)
20+
2221
import EVM
23-
import EVM.ABI (AbiType(..), getAbi)
22+
import EVM.ABI (AbiType(..), AbiValue(..), decodeAbiValue, selector)
2423
import EVM.Concrete (w256)
2524
import EVM.Exec (exec)
2625
import EVM.Types (Addr, Buffer(..), W256)
2726
import Text.Read (readMaybe)
2827

2928
import qualified Control.Monad.Fail as M (MonadFail(..))
3029
import qualified Data.ByteString.Base16 as BS16 (decode)
31-
import qualified Data.Text as T (Text, drop, unpack)
32-
import qualified Data.Vector as V (fromList)
30+
import qualified Data.Text as T (drop, unpack)
31+
import qualified Data.Vector as V (fromList, toList)
32+
import qualified Data.ByteString.Char8 as BS
33+
import qualified Data.ByteString.Lazy as LBS
3334

3435
import Echidna.Exec
3536
import Echidna.Transaction
36-
import Echidna.Types.Tx (TxCall(..), Tx(..), TxConf, basicTx, createTxWithValue, propGas, unlimitedGasPerBlock)
37+
--import Echidna.Types.Tx (TxCall(..), Tx(Tx), TxConf, propGas, makeSingleTx)
38+
import Echidna.Types.Signature (SolSignature)
39+
import Echidna.ABI (encodeSig)
40+
41+
import Echidna.Types.Tx (TxCall(..), Tx(..), TxConf, makeSingleTx, createTxWithValue, unlimitedGasPerBlock)
3742

3843
-- | During initialization we can either call a function or create an account or contract
3944
data Etheno = AccountCreated Addr -- ^ Registers an address with the echidna runtime
4045
| ContractCreated Addr Addr Integer Integer ByteString W256 -- ^ A contract was constructed on the blockchain
4146
| FunctionCall Addr Addr Integer Integer ByteString W256 -- ^ A contract function was executed
47+
| BlockMined Integer Integer -- ^ A new block was mined contract
48+
4249
deriving (Eq, Show)
4350

4451
instance FromJSON Etheno where
4552
parseJSON = withObject "Etheno" $ \v -> do
4653
(ev :: String) <- v .: "event"
4754
let gu = maybe (M.fail "could not parse gas_used") pure . readMaybe =<< v .: "gas_used"
4855
gp = maybe (M.fail "could not parse gas_price") pure . readMaybe =<< v .: "gas_price"
56+
ni = maybe (M.fail "could not parse number_increase") pure . readMaybe =<< v .: "number_increment"
57+
ti = maybe (M.fail "could not parse timestamp_increase") pure . readMaybe =<< v .: "timestamp_increment"
4958
case ev of
5059
"AccountCreated" -> AccountCreated <$> v .: "address"
5160
"ContractCreated" -> ContractCreated <$> v .: "from"
@@ -60,6 +69,9 @@ instance FromJSON Etheno where
6069
<*> gp
6170
<*> (decode =<< (v .: "data"))
6271
<*> v .: "value"
72+
"BlockMined" -> BlockMined <$> ni
73+
<*> ti
74+
6375
_ -> M.fail "event should be one of \"AccountCreated\", \"ContractCreated\", or \"FunctionCall\""
6476
where decode x = case BS16.decode . encodeUtf8 . T.drop 2 $ x of
6577
(a, "") -> pure a
@@ -75,68 +87,70 @@ instance Show EthenoException where
7587

7688
instance Exception EthenoException
7789

90+
loadEtheno :: (MonadThrow m, MonadIO m, M.MonadFail m)
91+
=> FilePath -> m [Etheno]
92+
loadEtheno fp = do
93+
bs <- liftIO $ eitherDecodeFileStrict fp
94+
95+
case bs of
96+
(Left e) -> throwM $ EthenoException e
97+
(Right (ethenoInit :: [Etheno])) -> return ethenoInit
98+
99+
extractFromEtheno :: [Etheno] -> [SolSignature] -> [Tx]
100+
extractFromEtheno ess ss = case ess of
101+
(BlockMined ni ti :es) -> Tx NoCall 0 0 0 0 0 (fromInteger ti, fromInteger ni) : extractFromEtheno es ss
102+
(c@FunctionCall{} :es) -> concatMap (`matchSignatureAndCreateTx` c) ss ++ extractFromEtheno es ss
103+
(_:es) -> extractFromEtheno es ss
104+
_ -> []
105+
106+
matchSignatureAndCreateTx :: SolSignature -> Etheno -> [Tx]
107+
matchSignatureAndCreateTx ("", []) _ = [] -- Not sure if we should match this.
108+
matchSignatureAndCreateTx (s,ts) (FunctionCall a d _ _ bs v) =
109+
if BS.take 4 bs == selector (encodeSig (s,ts))
110+
then makeSingleTx a d v $ SolCall (s, fromTuple $ decodeAbiValue t (LBS.fromStrict $ BS.drop 4 bs))
111+
else []
112+
where t = AbiTupleType (V.fromList ts)
113+
fromTuple (AbiTuple xs) = V.toList xs
114+
fromTuple _ = []
115+
matchSignatureAndCreateTx _ _ = []
116+
78117
-- | Main function: takes a filepath where the initialization sequence lives and returns
79118
-- | the initialized VM along with a list of Addr's to put in GenConf
80119
loadEthenoBatch :: (MonadThrow m, MonadIO m, Has TxConf y, MonadReader y m, M.MonadFail m)
81-
=> [T.Text] -> FilePath -> m VM
82-
loadEthenoBatch ts fp = do
120+
=> FilePath -> m VM
121+
loadEthenoBatch fp = do
83122
bs <- liftIO $ eitherDecodeFileStrict fp
84123

85124
case bs of
86125
(Left e) -> throwM $ EthenoException e
87126
(Right (ethenoInit :: [Etheno])) -> do
88127
-- Execute contract creations and initial transactions,
89-
let initVM = foldM (execEthenoTxs ts) Nothing ethenoInit
90-
91-
(addr, vm') <- runStateT initVM initialVM
92-
case addr of
93-
Nothing -> throwM $ EthenoException "Could not find a contract with echidna tests"
94-
Just a -> execStateT (liftSH . loadContract $ a) vm'
128+
let initVM = foldM execEthenoTxs () ethenoInit
129+
(_, vm') <- runStateT initVM initialVM
130+
return vm'
95131

96132
-- | Takes a list of Etheno transactions and loads them into the VM, returning the
97133
-- | address containing echidna tests
98134
execEthenoTxs :: (MonadState x m, Has VM x, MonadThrow m, Has TxConf y, MonadReader y m, M.MonadFail m)
99-
=> [T.Text] -> Maybe Addr -> Etheno -> m (Maybe Addr)
100-
execEthenoTxs ts addr et = do
135+
=> () -> Etheno -> m ()
136+
execEthenoTxs _ et = do
101137
setupEthenoTx et
138+
sb <- get
102139
res <- liftSH exec
103-
g <- view (hasLens . propGas)
104140
case (res, et) of
105-
(Reversion, _) -> throwM $ EthenoException "Encountered reversion while setting up Etheno transactions"
141+
(_ , AccountCreated _) -> return ()
142+
(Reversion, _) -> void $ put sb
106143
(VMFailure x, _) -> vmExcept x >> M.fail "impossible"
107144
(VMSuccess (ConcreteBuffer bc),
108145
ContractCreated _ ca _ _ _ _) -> do
109146
hasLens . env . contracts . at ca . _Just . contractcode .= InitCode ""
110147
liftSH (replaceCodeOfSelf (RuntimeCode bc) >> loadContract ca)
111-
og <- get
112-
-- See if current contract is the same as echidna test
113-
case addr of
114-
-- found the tests, so just return the contract
115-
Just m -> return $ Just m
116-
-- try to see if this is the contract we wish to test
117-
Nothing -> let txs = ts <&> \t -> basicTx t [] ca ca g
118-
-- every test was executed successfully
119-
go [] = return (Just ca)
120-
-- execute x and check if it returned something of the correct type
121-
go (x:xs) = setupTx x >> liftSH exec >>= \case
122-
-- executing the test function succeeded
123-
VMSuccess (ConcreteBuffer r) -> do
124-
put og
125-
case runGetOrFail (getAbi . AbiTupleType . V.fromList $ [AbiBoolType]) (r ^. lazy) ^? _Right . _3 of
126-
-- correct type ==> check the rest of the tests
127-
Just _ -> go xs
128-
-- incorrect type ==> bad ABI, this is not the contract we wish to test
129-
Nothing -> return Nothing
130-
-- some vm failure or reversion, not what we want
131-
-- TODO: this breaks any test that is supposed to revert, maybe add a check here?
132-
_ -> put og >> return Nothing in
133-
-- actually test everything
134-
go txs
135-
_ -> return addr
136-
148+
return ()
149+
_ -> return ()
137150

138151
-- | For an etheno txn, set up VM to execute txn
139152
setupEthenoTx :: (MonadState x m, Has VM x) => Etheno -> m ()
140153
setupEthenoTx (AccountCreated _) = pure ()
141-
setupEthenoTx (ContractCreated f c _ _ d v) = setupTx $ createTxWithValue d f c (fromInteger unlimitedGasPerBlock) (w256 v)
142-
setupEthenoTx (FunctionCall f t _ _ d v) = setupTx $ Tx (SolCalldata d) f t (fromInteger unlimitedGasPerBlock) 0 (w256 v) (0, 0)
154+
setupEthenoTx (ContractCreated f c _ _ d v) = setupTx $ createTxWithValue d f c (fromInteger unlimitedGasPerBlock) (w256 v) (1, 1)
155+
setupEthenoTx (FunctionCall f t _ _ d v) = setupTx $ Tx (SolCalldata d) f t (fromInteger unlimitedGasPerBlock) 0 (w256 v) (1, 1)
156+
setupEthenoTx (BlockMined n t) = setupTx $ Tx NoCall 0 0 0 0 0 (fromInteger t, fromInteger n)

‎lib/Echidna/Solidity.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ module Echidna.Solidity where
1010
import Control.Lens
1111
import Control.Exception (Exception)
1212
import Control.Arrow (first)
13-
import Control.Monad (liftM2, when, unless, void)
13+
import Control.Monad (liftM2, when, unless)
1414
import Control.Monad.Catch (MonadThrow(..))
1515
import Control.Monad.IO.Class (MonadIO(..))
1616
import Control.Monad.Reader (MonadReader)
@@ -162,7 +162,7 @@ loadLibraries :: (MonadIO m, MonadThrow m, MonadReader x m, Has SolConf x)
162162
=> [SolcContract] -> Addr -> Addr -> VM -> m VM
163163
loadLibraries [] _ _ vm = return vm
164164
loadLibraries (l:ls) la d vm = loadLibraries ls (la + 1) d =<< loadRest
165-
where loadRest = execStateT (execTx $ createTx (l ^. creationCode) d la (fromInteger unlimitedGasPerBlock)) vm
165+
where loadRest = execStateT (execTx $ createTx (l ^. creationCode) d la (fromInteger unlimitedGasPerBlock) (0, 0)) vm
166166

167167
-- | Generate a string to use as argument in solc to link libraries starting from addrLibrary
168168
linkLibraries :: [String] -> String
@@ -220,7 +220,7 @@ loadSpecified name cs = do
220220
-- Set up initial VM, either with chosen contract or Etheno initialization file
221221
-- need to use snd to add to ABI dict
222222
blank' <- maybe (pure (initialVM & block . gaslimit .~ fromInteger unlimitedGasPerBlock & block . maxCodeSize .~ w256 (fromInteger mcs)))
223-
(loadEthenoBatch $ fst <$> tests)
223+
loadEthenoBatch
224224
fp
225225
let blank = populateAddresses (NE.toList ads |> d) bala blank'
226226

@@ -236,7 +236,7 @@ loadSpecified name cs = do
236236
Just (t,_) -> throwM $ TestArgsFound t -- Test args check
237237
Nothing -> do
238238
vm <- loadLibraries ls addrLibrary d blank
239-
let transaction = unless (isJust fp) $ void . execTx $ createTxWithValue bc d ca (fromInteger unlimitedGasPerBlock) (w256 $ fromInteger balc)
239+
let transaction = execTx $ createTxWithValue bc d ca (fromInteger unlimitedGasPerBlock) (w256 $ fromInteger balc) (0, 0)
240240
vm' <- execStateT transaction vm
241241
case currentContract vm' of
242242
Just _ -> return (vm', c ^. eventMap, neFuns, fst <$> tests, abiMapping)

‎lib/Echidna/Test.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -80,7 +80,7 @@ checkETest' em t = do
8080
Left (f, a) -> do
8181
g <- view (hasLens . propGas)
8282
sd <- hasSelfdestructed a
83-
_ <- execTx $ basicTx f [] (s a) a g
83+
_ <- execTx $ basicTx f [] (s a) a g (0, 0)
8484
b <- gets $ p f . getter
8585
put vm -- restore EVM state
8686
pure $ not sd && b

‎lib/Echidna/Types/Tx.hs‎

Lines changed: 32 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -9,9 +9,9 @@ import Data.Aeson.TH (deriveJSON, defaultOptions)
99
import Data.ByteString (ByteString)
1010
import Data.Text (Text)
1111
import EVM (VMResult(..), Error(..))
12+
import EVM.Concrete (Word, w256)
13+
import EVM.Types (Addr, W256)
1214
import EVM.ABI (AbiValue)
13-
import EVM.Concrete (Word)
14-
import EVM.Types (Addr)
1515

1616
import Echidna.Orphans.JSON ()
1717
import Echidna.Types.Signature (SolCall)
@@ -57,37 +57,41 @@ data Tx = Tx { _call :: TxCall -- | Call
5757
makeLenses ''Tx
5858
$(deriveJSON defaultOptions ''Tx)
5959

60-
basicTx :: Text -- | Function name
61-
-> [AbiValue] -- | Function args
62-
-> Addr -- | msg.sender
63-
-> Addr -- | Destination contract
64-
-> Word -- | Gas limit
60+
basicTx :: Text -- | Function name
61+
-> [AbiValue] -- | Function args
62+
-> Addr -- | Sender
63+
-> Addr -- | Destination contract
64+
-> Word -- | Gas limit
65+
-> (Word, Word) -- | Block increment
6566
-> Tx
6667
basicTx f a s d g = basicTxWithValue f a s d g 0
6768

68-
basicTxWithValue :: Text -- | Function name
69-
-> [AbiValue] -- | Function args
70-
-> Addr -- | msg.sender
71-
-> Addr -- | Destination contract
72-
-> Word -- | Gas limit
73-
-> Word -- | Value
69+
basicTxWithValue :: Text -- | Function name
70+
-> [AbiValue] -- | Function args
71+
-> Addr -- | Sender
72+
-> Addr -- | Destination contract
73+
-> Word -- | Gas limit
74+
-> Word -- | Value
75+
-> (Word, Word) -- | Block increment
7476
-> Tx
75-
basicTxWithValue f a s d g v = Tx (SolCall (f, a)) s d g 0 v (0, 0)
77+
basicTxWithValue f a s d g = Tx (SolCall (f, a)) s d g 0
7678

77-
createTx :: ByteString -- | Constructor bytecode
78-
-> Addr -- | Creator
79-
-> Addr -- | Destination address
80-
-> Word -- | Gas limit
79+
createTx :: ByteString -- | Constructor bytecode
80+
-> Addr -- | Creator
81+
-> Addr -- | Destination address
82+
-> Word -- | Gas limit
83+
-> (Word, Word) -- | Block increment
8184
-> Tx
8285
createTx bc s d g = createTxWithValue bc s d g 0
8386

84-
createTxWithValue :: ByteString -- | Constructor bytecode
85-
-> Addr -- | Creator
86-
-> Addr -- | Destination address
87-
-> Word -- | Gas limit
88-
-> Word -- | Value
87+
createTxWithValue :: ByteString -- | Constructor bytecode
88+
-> Addr -- | Creator
89+
-> Addr -- | Destination address
90+
-> Word -- | Gas limit
91+
-> Word -- | Value
92+
-> (Word, Word) -- | Block increment
8993
-> Tx
90-
createTxWithValue bc s d g v = Tx (SolCreate bc) s d g 0 v (0, 0)
94+
createTxWithValue bc s d g = Tx (SolCreate bc) s d g 0
9195

9296
data TxResult = Success
9397
| ErrorBalanceTooLow
@@ -150,3 +154,7 @@ getResult (VMFailure PrecompileFailure) = ErrorPrecompileFailure
150154
getResult (VMFailure UnexpectedSymbolicArg) = ErrorUnexpectedSymbolic
151155
getResult (VMFailure DeadPath) = ErrorDeadPath
152156
getResult (VMFailure (Choose _)) = ErrorChoose -- not entirely sure what this is
157+
158+
makeSingleTx :: Addr -> Addr -> W256 -> TxCall -> [Tx]
159+
makeSingleTx a d v (SolCall c) = [Tx (SolCall c) a d (fromInteger maxGasPerBlock) 0 (w256 v) (0, 0)]
160+
makeSingleTx _ _ _ _ = error "invalid usage of makeSingleTx"

0 commit comments

Comments
 (0)