Merge branch 'master' into dev-evm-config

pull/67/head
JP Smith 6 years ago committed by GitHub
commit d82ad1be36
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
  1. 4
      lib/Echidna/ABI.hs
  2. 62
      lib/Echidna/Config.hs
  3. 18
      lib/Echidna/Exec.hs
  4. 10
      lib/Echidna/Solidity.hs
  5. 19
      solidity/config.yaml
  6. 6
      src/Main.hs

@ -79,11 +79,11 @@ genAbiAddress = view addrList >>= \case (Just xs) -> fmap (AbiAddress . addressW
genAbiUInt :: MonadGen m => Int -> m AbiValue
genAbiUInt n = AbiUInt n . fromInteger <$> genUInt
where genUInt = Gen.integral $ exponential 0 $ 2^(toInteger n) - 1
where genUInt = Gen.integral $ exponential 0 $ 2 ^ toInteger n - 1
genAbiInt :: MonadGen m => Int -> m AbiValue
genAbiInt n = AbiInt n . fromInteger <$> genInt
where genInt = Gen.integral $ exponentialFrom 0 (-1 * 2 ^ (toInteger n)) (2 ^ (toInteger n - 1))
where genInt = Gen.integral $ exponentialFrom 0 (-1 * 2 ^ toInteger n) (2 ^ (toInteger n - 1))
genAbiBool :: MonadGen m => m AbiValue
genAbiBool = AbiBool <$> Gen.bool

@ -1,21 +1,19 @@
{-# LANGUAGE DeriveGeneric, FlexibleContexts, TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts, TemplateHaskell #-}
module Echidna.Config where
import Control.Monad.Catch (MonadThrow(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (ReaderT, runReaderT)
import Control.Lens
import Control.Exception (Exception)
import Control.Monad.Reader (ReaderT, runReaderT)
import Data.Aeson
import GHC.Generics
import qualified Data.ByteString.Char8 as BS
import qualified Data.Yaml as Y
import EVM.Types (Addr, W256)
data Config = Config
{ _solcArgs :: Maybe String
, _epochs :: Int
@ -25,50 +23,38 @@ data Config = Config
, _contractAddr :: Addr
, _sender :: Addr
, _addrList :: Maybe [Addr] }
deriving (Show, Generic)
deriving Show
makeLenses ''Config
instance FromJSON Config
instance FromJSON Config where
parseJSON (Object v) = Config <$> v .:? "solcArgs" .!= Nothing
<*> v .:? "epochs" .!= 2
<*> v .:? "testLimit" .!= 10000
<*> v .:? "range" .!= 10
<*> v .:? "gasLimit" .!= 0xffffffffffffffff
<*> v .:? "contractAddr" .!= 0x00a329c0648769a73afac7f9381e08fb43dbea72
<*> v .:? "sender" .!= 0x00a329c0648769a73afac7f9381e08fb43dbea70
<*> v .:? "addrList" . .!= Nothing
parseJSON _ = parseJSON (Object mempty)
------------------------------------
-- Defaults
defaultContractAddr :: Addr
defaultContractAddr = 0x00a329c0648769a73afac7f9381e08fb43dbea72
defaultSender :: Addr
defaultSender = 0x00a329c0648769a73afac7f9381e08fb43dbea70
newtype ParseException = ParseException FilePath
defaultConfig :: Config
defaultConfig = Config
{ _solcArgs = Nothing
, _epochs = 2
, _testLimit = 10000
, _range = 10
, _gasLimit = 0xffffffffffffffff
, _contractAddr = defaultContractAddr
, _sender = defaultSender
, _addrList = Nothing }
withDefaultConfig :: ReaderT Config m a -> m a
withDefaultConfig = (flip runReaderT) defaultConfig
------------------------------------
-- Parser
data ParseException = ParseException FilePath
defaultConfig = either (error "Config parser got messed up :(") id $ Y.decodeEither ""
instance Show ParseException where
show (ParseException f) = "Could not parse config file " ++ (show f)
show (ParseException f) = "Could not parse config file " ++ show f
instance Exception ParseException
parseConfig :: (MonadThrow m, MonadIO m) => FilePath -> m Config
parseConfig file = do
content <- liftIO $ BS.readFile file
let parsedContent = Y.decode content :: Maybe Config
case parsedContent of
Nothing -> throwM (ParseException file)
(Just c) -> return c
content <- liftIO $ BS.readFile file
let parsedContent = Y.decode content :: Maybe Config
case parsedContent of
Nothing -> throwM (ParseException file)
(Just c) -> return c
withDefaultConfig :: ReaderT Config m a -> m a
withDefaultConfig = (`runReaderT` defaultConfig)

@ -1,5 +1,5 @@
{-# LANGUAGE BangPatterns, FlexibleContexts, KindSignatures,
LambdaCase, StrictData, TemplateHaskell #-}
LambdaCase, StrictData #-}
module Echidna.Exec (
checkETest
@ -34,7 +34,7 @@ import qualified Data.Vector.Mutable as M
import qualified Data.Vector as V
import Hedgehog
import Hedgehog.Gen (sequential)
import Hedgehog.Gen (choice, sequential)
import Hedgehog.Internal.State (Action(..))
import Hedgehog.Internal.Property (PropertyConfig(..), mapConfig)
import Hedgehog.Range (linear)
@ -145,9 +145,10 @@ eCommandCoverage :: (MonadGen n, MonadTest m, MonadState VM m, MonadReader Cover
=> [SolCall] -> (VM -> Bool) -> [SolSignature] -> Config -> [Command n m VMState]
eCommandCoverage cov p ts conf = let useConf = flip runReaderT conf in case cov of
[] -> [eCommandUsing (useConf $ genInteractions ts) (\(Call c) -> execCallCoverage c) p]
xs -> map (\x -> eCommandUsing (useConf $ mutateCall x)
xs -> map (\x -> eCommandUsing (choice [mutateCall x, genInteractions ts])
(\(Call c) -> execCallCoverage c) p) xs
ePropertyUsing :: (MonadCatch m, MonadTest m, MonadReader Config n)
=> [Command Gen m VMState]
-> (m () -> PropertyT IO ())
@ -187,14 +188,3 @@ ePropertySeqCoverage calls cov p ts v = ask >>= \c -> ePropertyUsing (eCommandCo
threadCov <- liftIO $ readIORef threadCovRef
liftIO $ modifyMVar_ cov (\xs -> pure $ threadCov:xs)
return a
-- Should work, but missing instance MonadBaseControl b m => MonadBaseControl b (PropertyT m)
-- ePropertyPar :: VM -- Initial state
-- -> [(Text, [AbiType])] -- Type signatures to fuzz
-- -> (VM -> Bool) -- Predicate to fuzz for violations of
-- -> Int -- Max size
-- -> Int -- Max post-prefix size
-- -> Property
-- ePropertyPar v ts p n m = withRetries 10 . property $ executeParallel (Current v) =<<
-- forAll (parallel (linear 1 n) (linear 1 m) (Current v) [eCommand v ts p])

@ -8,7 +8,7 @@ import Control.Exception (Exception)
import Control.Monad (liftM2)
import Control.Monad.Catch (MonadThrow(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (MonadReader, ask, runReaderT)
import Control.Monad.Reader (MonadReader, ask)
import Control.Monad.State.Strict (MonadState, execState, modify, runState)
import Data.Foldable (toList)
import Data.List (find, partition)
@ -24,6 +24,7 @@ import qualified Data.Map as Map (lookup)
import Echidna.ABI (SolSignature)
import Echidna.Config (Config(..), sender, contractAddr, gasLimit, solcArgs, defaultConfig)
import EVM
(Contract, VM, VMResult(..), caller, contract, codeContract, contracts, env, gas, loadContract, replaceCodeOfSelf, resetState, state)
import EVM.Concrete (Blob(..), w256)
@ -71,7 +72,7 @@ readContract :: (MonadIO m, MonadThrow m, MonadReader Config m) => FilePath -> M
readContract filePath selectedContractName = do
cs <- readContracts filePath
c <- chooseContract cs selectedContractName
warn (isNothing selectedContractName && 1 < length cs) $
warn (isNothing selectedContractName && 1 < length cs)
"Multiple contracts found in file, only analyzing the first"
liftIO $ print $ "Analyzing contract: " <> c ^. contractName
return c
@ -117,6 +118,5 @@ currentContract :: MonadThrow m => VM -> m Contract
currentContract v = let a = v ^. state . contract in
maybe (throwM $ BadAddr a) pure . Map.lookup a $ v ^. env . contracts
addSolidity :: (MonadIO m, MonadThrow m, MonadState VM m) => FilePath -> Maybe Text -> m ()
addSolidity f mc = insertContract =<< currentContract =<< view _1 <$> runReaderT (loadSolidity f mc) defaultConfig
addSolidity :: (MonadIO m, MonadReader Config m, MonadState VM m, MonadThrow m) => FilePath -> Maybe Text -> m ()
addSolidity f mc = insertContract =<< currentContract =<< view _1 <$> loadSolidity f mc

@ -1,16 +1,17 @@
#Arguments to solc
#_solcArgs:
#solcArgs:
#Choose the number of epochs to use in coverage-guided testing
_epochs: 2
epochs: 2
#Set the gas limit for each test
_gasLimit: 0xfffff
gasLimit: 0xfffff
#Number of tests that will run for each property
_testLimit: 10000
#Honestly not sure what this is
_range: 10
testLimit: 10000
#Max call sequence length
range: 10
#Contract's address in the EVM
_contractAddr: 0x00a329c0648769a73afac7f9381e08fb43dbea72
contractAddr: 0x00a329c0648769a73afac7f9381e08fb43dbea72
#Sender's address in the EVM
_sender: 0x00a329c0648769a73afac7f9381e08fb43dbea70
sender: 0x00a329c0648769a73afac7f9381e08fb43dbea70
#List of addresses that will be used in all tests
#_addrList:
#addrList:

@ -56,14 +56,14 @@ main = do
(Options file contract coverage configFile) <- execParser opts
config <- maybe (pure defaultConfig) parseConfig configFile
(flip runReaderT) config $ do
flip runReaderT config $ do
-- Load solidity contract and get VM
(v,a,ts) <- loadSolidity file (pack <$> contract)
if not coverage
-- Run without coverage
then do
let prop t = ePropertySeq (flip checkETest t) a v >>= \x -> return (PropertyName $ show t, x)
let prop t = ePropertySeq (`checkETest` t) a v >>= \x -> return (PropertyName $ show t, x)
_ <- checkParallel . Group (GroupName file) =<< mapM prop ts
return ()
@ -71,7 +71,7 @@ main = do
else do
tests <- liftIO $ mapM (\t -> fmap (t,) (newMVar [])) ts
let prop (cov,t,mvar) =
ePropertySeqCoverage cov mvar (flip checkETest t) a v >>= \x -> return (PropertyName $ show t, x)
ePropertySeqCoverage cov mvar (`checkETest` t) a v >>= \x -> return (PropertyName $ show t, x)
replicateM_ (config ^. epochs) $ do

Loading…
Cancel
Save