Merge branch 'master' into dev-evm-config

lib/Echidna/ABI.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

lib/Echidna/Config.hs

@@ -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)

lib/Echidna/Exec.hs

@@ -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])

lib/Echidna/Solidity.hs

@@ -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

solidity/config.yaml

@@ -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:

src/Main.hs

@@ -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