Cleanup redundant type constraints (#853)

pull/854/head
Artur Cygan 2 years ago committed by GitHub
parent fb556c59de
commit e569b890c9
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
  1. 4
      lib/Echidna.hs
  2. 10
      lib/Echidna/Fetch.hs
  3. 5
      lib/Echidna/Mutator/Corpus.hs
  4. 40
      lib/Echidna/RPC.hs
  5. 7
      lib/Echidna/Shrink.hs
  6. 17
      lib/Echidna/Solidity.hs
  7. 6
      lib/Echidna/Test.hs
  8. 2
      lib/Echidna/UI.hs

@ -4,7 +4,6 @@ import Control.Lens (view, (^.), to)
import Data.Has (Has(..))
import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
import Control.Monad.Reader (MonadReader, MonadIO, liftIO)
import Control.Monad.Random (MonadRandom)
import Data.HashMap.Strict (toList)
import Data.Map.Strict (keys)
import Data.List (nub, find)
@ -40,8 +39,7 @@ import Echidna.RPC (loadEtheno, extractFromEtheno)
-- * A list of Echidna tests to check
-- * A prepopulated dictionary (if any)
-- * A list of transaction sequences to initialize the corpus
prepareContract :: (MonadCatch m, MonadRandom m, MonadReader x m, MonadIO m, MonadFail m,
Has TestConf x, Has TxConf x, Has SolConf x)
prepareContract :: (MonadCatch m, MonadReader x m, MonadIO m, MonadFail m, Has SolConf x)
=> EConfig -> NE.NonEmpty FilePath -> Maybe ContractName -> Seed
-> m (VM, SourceCache, [SolcContract], World, [EchidnaTest], Maybe GenDict, [[Tx]])
prepareContract cfg fs c g = do

@ -3,12 +3,10 @@ module Echidna.Fetch where
import Control.Lens
import Control.Monad.Catch (MonadThrow(..), throwM)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (MonadReader)
import Control.Monad.State.Strict (execStateT)
import Data.ByteString (ByteString, pack, append)
import Data.ByteString.Base16 qualified as BS16 (decode)
import Data.Either (fromRight)
import Data.Has (Has(..))
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
@ -16,12 +14,12 @@ import EVM
import EVM.Solidity
import EVM.Types (Addr)
import Echidna.Types.Solidity (SolConf(..), SolException(..))
import Echidna.Types.Solidity (SolException(..))
import Echidna.Types.Tx (createTx, unlimitedGasPerBlock)
import Echidna.Exec (execTx)
-- | Deploy a list of solidity contracts in certain addresses
deployBytecodes' :: (MonadIO m, MonadThrow m, MonadReader x m, Has SolConf x)
deployBytecodes' :: (MonadIO m, MonadThrow m)
=> [(Addr, ByteString)] -> Addr -> VM -> m VM
deployBytecodes' [] _ vm = return vm
deployBytecodes' ((a, bc):cs) d vm = deployBytecodes' cs d =<< loadRest
@ -31,10 +29,10 @@ deployBytecodes' ((a, bc):cs) d vm = deployBytecodes' cs d =<< loadRest
(Just (VMSuccess _)) -> return vm'
_ -> throwM $ DeploymentFailed a
deployContracts :: (MonadIO m, MonadThrow m, MonadReader x m, Has SolConf x)
deployContracts :: (MonadIO m, MonadThrow m)
=> [(Addr, SolcContract)] -> Addr -> VM -> m VM
deployContracts cs = deployBytecodes' $ map (\(a, c) -> (a, c ^. creationCode)) cs
deployBytecodes :: (MonadIO m, MonadThrow m, MonadReader x m, Has SolConf x)
deployBytecodes :: (MonadIO m, MonadThrow m)
=> [(Addr, Text)] -> Addr -> VM -> m VM
deployBytecodes cs = deployBytecodes' $ map (\(a, bc) -> (a, fromRight (error ("invalid b16 decoding of: " ++ show bc)) $ BS16.decode $ encodeUtf8 bc)) cs

@ -1,11 +1,8 @@
module Echidna.Mutator.Corpus where
import Control.Monad.State.Strict (MonadState(..))
import Control.Monad.Random.Strict (MonadRandom, getRandomR, weighted)
import Data.Has (Has(..))
import Data.Set qualified as DS
import Echidna.ABI (GenDict)
import Echidna.Mutator.Array
import Echidna.Transaction (mutateTx, shrinkTx)
import Echidna.Types.Tx (Tx)
@ -56,7 +53,7 @@ selectAndCombine f ql ctxs gtxs = do
return . take ql $ txs ++ gtxs
where selectFromCorpus = weighted $ map (\(i, txs) -> (txs, fromInteger i)) $ DS.toDescList ctxs
getCorpusMutation :: (MonadRandom m, Has GenDict x, MonadState x m)
getCorpusMutation :: MonadRandom m
=> CorpusMutation -> (Int -> Corpus -> [Tx] -> m [Tx])
getCorpusMutation (RandomAppend m) = mut (mutator m)
where mut f ql ctxs gtxs = do

@ -4,18 +4,16 @@ import Prelude hiding (Word)
import Control.Exception (Exception)
import Control.Lens
import Control.Monad (foldM, void)
import Control.Monad (void)
import Control.Monad.Catch (MonadThrow, throwM)
import Control.Monad.Fail qualified as M (MonadFail(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader.Class (MonadReader(..))
import Control.Monad.State.Strict (MonadState, runStateT, get, put)
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.Has (Has(..))
import Data.Text qualified as T (drop)
import Data.Text.Encoding (encodeUtf8)
import Data.Vector qualified as V (fromList, toList)
@ -30,7 +28,7 @@ import Echidna.Exec
import Echidna.Transaction
import Echidna.Types.Signature (SolSignature)
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
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
-- | 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)
=> FilePath -> m VM
loadEthenoBatch :: FilePath -> IO VM
loadEthenoBatch fp = do
bs <- liftIO $ eitherDecodeFileStrict fp
bs <- eitherDecodeFileStrict fp
case bs of
(Left e) -> throwM $ EthenoException e
(Right (ethenoInit :: [Etheno])) -> do
-- Execute contract creations and initial transactions,
let initVM = foldM execEthenoTxs () ethenoInit
(_, vm') <- runStateT initVM initialVM
return vm'
Left e -> throwM $ EthenoException e
Right (ethenoInit :: [Etheno]) -> do
-- Execute contract creations and initial transactions,
let initVM = mapM execEthenoTxs ethenoInit
execStateT initVM initialVM
-- | Takes a list of Etheno transactions and loads them into the VM, returning the
-- | address containing echidna tests
execEthenoTxs :: (MonadState x m, Has VM x, MonadThrow m, Has TxConf y, MonadReader y m, M.MonadFail m)
=> () -> Etheno -> m ()
execEthenoTxs _ et = do
execEthenoTxs :: (MonadState VM m, MonadFail m, MonadThrow m) => Etheno -> m ()
execEthenoTxs et = do
setupEthenoTx et
sb <- get
res <- liftSH exec
vm <- get
res <- exec
case (res, et) of
(_ , AccountCreated _) -> return ()
(Reversion, _) -> void $ put sb
(Reversion, _) -> void $ put vm
(VMFailure x, _) -> vmExcept x >> M.fail "impossible"
(VMSuccess (ConcreteBuffer bc),
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)
return ()
_ -> return ()
-- | 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 (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)

@ -16,14 +16,13 @@ import Echidna.Exec
import Echidna.Transaction
import Echidna.Events (Events)
import Echidna.Types.Solidity (SolConf(..), sender)
import Echidna.Types.Test (TestConf(..), TestValue(..))
import Echidna.Types.Tx (Tx, TxConf, TxResult, src)
import Echidna.Types.Test (TestValue(..))
import Echidna.Types.Tx (Tx, TxResult, src)
-- | Given a call sequence that solves some Echidna test, try to randomly generate a smaller one that
-- still solves that test.
shrinkSeq :: ( MonadRandom m, MonadReader x m, MonadThrow m
, Has SolConf x, Has TestConf x, Has TxConf x, MonadState y m
, Has VM y)
, Has SolConf x, MonadState y m, Has VM y)
=> m (TestValue, Events, TxResult) -> (TestValue, Events, TxResult) -> [Tx] -> m ([Tx], TestValue, Events, TxResult)
shrinkSeq f (v,es,r) xs = do
strategies <- sequence [shorten, shrunk]

@ -40,8 +40,8 @@ import Echidna.RPC (loadEthenoBatch)
import Echidna.Test (createTests, isAssertionMode, isPropertyMode, isDapptestMode)
import Echidna.Types.Signature (ContractName, FunctionHash, SolSignature, SignatureMap, getBytecodeMetadata)
import Echidna.Types.Solidity hiding (deployBytecodes, deployContracts)
import Echidna.Types.Test (TestConf(..), EchidnaTest(..))
import Echidna.Types.Tx (TxConf, basicTx, createTxWithValue, unlimitedGasPerBlock, initialTimestamp, initialBlockNumber)
import Echidna.Types.Test (EchidnaTest(..))
import Echidna.Types.Tx (basicTx, createTxWithValue, unlimitedGasPerBlock, initialTimestamp, initialBlockNumber)
import Echidna.Types.World (World(..))
-- | Given a list of source caches (SourceCaches) and an optional contract name,
@ -154,7 +154,7 @@ abiOf pref cc = fallback NE.:| filter (not . isPrefixOf pref . fst) (elems (cc ^
-- testing and extract an ABI and list of tests. Throws exceptions if anything returned doesn't look
-- usable for Echidna. NOTE: Contract names passed to this function should be prefixed by the
-- filename their code is in, plus a colon.
loadSpecified :: (MonadIO m, MonadThrow m, MonadReader x m, Has SolConf x, Has SolConf x, Has TestConf x, Has TxConf x, MonadFail m)
loadSpecified :: (MonadIO m, MonadThrow m, MonadReader x m, Has SolConf x, MonadFail m)
=> Maybe Text -> [SolcContract] -> m (VM, EventMap, NE.NonEmpty SolSignature, [Text], SignatureMap)
loadSpecified name cs = do
-- Pick contract to load
@ -167,7 +167,6 @@ loadSpecified name cs = do
-- Local variables
SolConf ca d ads bala balc mcs pref _ _ libs _ fp dpc dpb ma tm _ fs <- view hasLens
TestConf _ _ <- view hasLens
-- generate the complete abi mapping
let bc = c ^. creationCode
@ -187,9 +186,9 @@ loadSpecified name cs = do
-- Set up initial VM, either with chosen contract or Etheno initialization file
-- need to use snd to add to ABI dict
blank' <- maybe (pure (initialVM & block . gaslimit .~ fromInteger unlimitedGasPerBlock & block . maxCodeSize .~ w256 (fromInteger mcs)))
loadEthenoBatch
fp
let vm = initialVM & block . gaslimit .~ fromInteger unlimitedGasPerBlock
& block . maxCodeSize .~ w256 (fromInteger mcs)
blank' <- liftIO $ maybe (pure vm) loadEthenoBatch fp
let blank = populateAddresses (NE.toList ads |> d) bala blank'
unless (null con || isJust fp) (throwM $ ConstructorArgs (show con))
@ -241,7 +240,7 @@ loadSpecified name cs = do
-- the first contract in the file. Take said contract and return an initial VM state with it loaded,
-- its ABI (as 'SolSignature's), and the names of its Echidna tests. NOTE: unlike 'loadSpecified',
-- contract names passed here don't need the file they occur in specified.
loadWithCryticCompile :: (MonadIO m, MonadThrow m, MonadReader x m, Has SolConf x, Has TestConf x, Has TxConf x, MonadFail m)
loadWithCryticCompile :: (MonadIO m, MonadThrow m, MonadReader x m, Has SolConf x, MonadFail m)
=> NE.NonEmpty FilePath -> Maybe Text -> m (VM, EventMap, NE.NonEmpty SolSignature, [Text], SignatureMap)
loadWithCryticCompile fp name = contracts fp >>= \(cs, _) -> loadSpecified name cs
@ -293,7 +292,7 @@ prepareHashMaps cs as m =
-- | Basically loadSolidity, but prepares the results to be passed directly into
-- a testing function.
loadSolTests :: (MonadIO m, MonadThrow m, MonadReader x m, Has SolConf x, Has TestConf x, Has TxConf x, MonadFail m)
loadSolTests :: (MonadIO m, MonadThrow m, MonadReader x m, Has SolConf x, MonadFail m)
=> NE.NonEmpty FilePath -> Maybe Text -> m (VM, World, [EchidnaTest])
loadSolTests fp name = loadWithCryticCompile fp name >>= prepareForTest'

@ -170,7 +170,7 @@ checkOptimization (f,a) = do
pure (getIntFromResult (vm' ^. result), extractEvents dappInfo vm', getResultFromVM vm')
checkStatefullAssertion :: (MonadReader x m, Has TestConf x, Has TxConf x, Has DappInfo x, MonadState y m, Has VM y, MonadThrow m)
checkStatefullAssertion :: (MonadReader x m, Has DappInfo x, MonadState y m, Has VM y, MonadThrow m)
=> (SolSignature, Addr) -> m (TestValue, Events, TxResult)
checkStatefullAssertion (sig, addr) = do
dappInfo <- view hasLens
@ -196,7 +196,7 @@ checkStatefullAssertion (sig, addr) = do
assumeMagicReturnCode :: BS.ByteString
assumeMagicReturnCode = "FOUNDRY::ASSUME\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"
checkDapptestAssertion :: (MonadReader x m, Has TestConf x, Has TxConf x, Has DappInfo x, MonadState y m, Has VM y, MonadThrow m)
checkDapptestAssertion :: (MonadReader x m, Has DappInfo x, MonadState y m, Has VM y, MonadThrow m)
=> (SolSignature, Addr) -> m (TestValue, Events, TxResult)
checkDapptestAssertion (sig, addr) = do
dappInfo <- view hasLens
@ -218,7 +218,7 @@ checkDapptestAssertion (sig, addr) = do
pure (BoolValue (not isFailure), events, getResultFromVM vm)
checkCall :: (MonadReader x m, Has TestConf x, Has TxConf x, Has DappInfo x, MonadState y m, Has VM y, MonadThrow m)
checkCall :: (MonadReader x m, Has DappInfo x, MonadState y m, Has VM y, MonadThrow m)
=> (DappInfo -> VM -> TestValue) -> m (TestValue, Events, TxResult)
checkCall f = do
dappInfo <- view hasLens

@ -56,7 +56,7 @@ data CampaignEvent = CampaignUpdated Campaign | CampaignTimedout Campaign
-- print non-interactive output in desired format at the end
ui :: ( MonadCatch m, MonadRandom m, MonadReader x m, MonadUnliftIO m
, Has SolConf x, Has TestConf x, Has TxConf x, Has CampaignConf x
, Has Names x, Has TxConf x, Has UIConf x, Has DappInfo x)
, Has Names x, Has UIConf x, Has DappInfo x)
=> VM -- ^ Initial VM state
-> World -- ^ Initial world state
-> [EchidnaTest] -- ^ Tests to evaluate

Loading…
Cancel
Save