Merge remote-tracking branch 'origin/master' into elopez/windows-buil…

…d-refresh
crytic · Feb 24, 2023 · bcddf2b · bcddf2b
2 parents c29bb61 + a711dd7
commit bcddf2b
Show file tree

Hide file tree

Showing 12 changed files with 156 additions and 152 deletions.
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
@@ -16,10 +16,8 @@ jobs:
       matrix:
         include:
           - os: ubuntu-20.04
-            apt-get: autoconf automake libtool
             shell: bash
           - os: macos-latest
-            brew: automake
             shell: bash
           - os: windows-latest
             shell: msys2 {0}
@@ -29,12 +27,9 @@ jobs:
         shell: ${{ matrix.shell }}
 
     steps:
-      - name: Get Packages
-        uses: mstksg/get-package@v1
-        if: runner.os != 'Windows'
-        with:
-          brew: ${{ matrix.brew }}
-          apt-get: ${{ matrix.apt-get }}
+      - name: Get Packages (macOS)
+        if: runner.os == 'macOS'
+        run: brew install automake
 
       - name: Get Packages (Windows)
         uses: msys2/setup-msys2@v2
@@ -72,19 +67,21 @@ jobs:
         uses: actions/cache@v3
         with:
           path: ~/.local/
-          key: ${{ runner.os }}-local-v4
+          key: ${{ runner.os }}-local-v5-${{ hashFiles('.github/scripts/install-*') }}
 
       - name: Cache Stack
         uses: actions/cache@v3
         with:
-          path: ~/.stack
-          key: ${{ runner.os }}-stack-v4
+          path: |
+            ~/.stack
+            .stack-work
+          key: ${{ runner.os }}-stack-v5-${{ hashFiles('package.yaml', 'stack.yaml') }}
 
       - name: Cache Cabal
         uses: actions/cache@v3
         with:
           path: ~/.cabal
-          key: ${{ runner.os }}-cabal-v4
+          key: ${{ runner.os }}-cabal-v5-${{ hashFiles('package.yaml', 'stack.yaml') }}
 
       - name: Build Libraries
         run: |

diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs
@@ -24,26 +24,27 @@ import Data.Text (Text)
 import System.Random (mkStdGen)
 
 import EVM (Contract, VM(..), VMResult(..), bytecode)
-import qualified EVM (Env(..))
+import EVM qualified (Env(..))
 import EVM.ABI (getAbi, AbiType(AbiAddressType), AbiValue(AbiAddress))
 import EVM.Types (Addr, Expr(ConcreteBuf))
 
 import Echidna.ABI
+import Echidna.Events (extractEvents)
 import Echidna.Exec
+import Echidna.Mutator.Corpus
+import Echidna.Shrink (shrinkTest)
 import Echidna.Test
 import Echidna.Transaction
-import Echidna.Shrink (shrinkTest)
+import Echidna.Types (Gas)
+import Echidna.Types.Buffer (viewBuffer)
 import Echidna.Types.Campaign
 import Echidna.Types.Config
 import Echidna.Types.Corpus (InitialCorpus)
 import Echidna.Types.Coverage (coveragePoints)
-import Echidna.Types.Test
-import Echidna.Types.Buffer (viewBuffer)
 import Echidna.Types.Signature (makeBytecodeMemo)
+import Echidna.Types.Test
 import Echidna.Types.Tx (TxCall(..), Tx(..), getResult, call)
 import Echidna.Types.World (World)
-import Echidna.Mutator.Corpus
-import Echidna.Events (extractEvents)
 
 instance MonadThrow m => MonadThrow (RandT g m) where
   throwM = lift . throwM
@@ -120,7 +121,7 @@ evalSeq vmForShrink e = go [] where
 
 -- | Given current `gasInfo` and a sequence of executed transactions, updates information on highest
 -- gas usage for each call
-updateGasInfo :: [(Tx, (VMResult, Int))] -> [Tx] -> Map Text (Int, [Tx]) -> Map Text (Int, [Tx])
+updateGasInfo :: [(Tx, (VMResult, Gas))] -> [Tx] -> Map Text (Gas, [Tx]) -> Map Text (Gas, [Tx])
 updateGasInfo [] _ gi = gi
 updateGasInfo ((t@(Tx (SolCall (f, _)) _ _ _ _ _ _), (_, used')):ts) tseq gi =
   case mused of
@@ -135,7 +136,7 @@ updateGasInfo ((t, _):ts) tseq gi = updateGasInfo ts (t:tseq) gi
 
 -- | Execute a transaction, capturing the PC and codehash of each instruction executed, saving the
 -- transaction if it finds new coverage.
-execTxOptC :: (MonadIO m, MonadState (VM, Campaign) m, MonadThrow m) => Tx -> m (VMResult, Int)
+execTxOptC :: (MonadIO m, MonadState (VM, Campaign) m, MonadThrow m) => Tx -> m (VMResult, Gas)
 execTxOptC tx = do
   (vm, Campaign{_bcMemo, _coverage = oldCov}) <- get
   let cov = _2 . coverage
@@ -155,7 +156,7 @@ execTxOptC tx = do
   return res
 
 -- | Given a list of transactions in the corpus, save them discarding reverted transactions
-addToCorpus :: MonadState Campaign m => Int -> [(Tx, (VMResult, Int))] -> m ()
+addToCorpus :: MonadState Campaign m => Int -> [(Tx, (VMResult, Gas))] -> m ()
 addToCorpus n res = unless (null rtxs) $ corpus %= Set.insert (n, rtxs)
   where rtxs = fst <$> res
 

diff --git a/lib/Echidna/Config.hs b/lib/Echidna/Config.hs
@@ -1,14 +1,14 @@
 module Echidna.Config where
 
-import Control.Lens
-import Control.Monad.Fail qualified as M (MonadFail(..))
+import Control.Applicative ((<|>))
 import Control.Monad.Reader (Reader, ReaderT(..), runReader)
 import Control.Monad.State (StateT(..), runStateT, modify')
 import Control.Monad.Trans (lift)
 import Data.Aeson
 import Data.Aeson.KeyMap (keys)
 import Data.Bool (bool)
 import Data.ByteString qualified as BS
+import Data.Functor ((<&>))
 import Data.HashSet (fromList, insert, difference)
 import Data.Maybe (fromMaybe)
 import Data.Set qualified as Set
@@ -38,94 +38,102 @@ instance FromJSON EConfigWithUsage where
   -- config and not used and which keys were unset in the config and defaulted
   parseJSON o = do
     let v' = case o of
-                  Object v -> v
-                  _        -> mempty
+               Object v -> v
+               _        -> mempty
     (c, ks) <- runStateT (parser v') $ fromList []
     let found = fromList (keys v')
-    return $ EConfigWithUsage c (found `difference` ks) (ks `difference` found)
+    pure $ EConfigWithUsage c (found `difference` ks) (ks `difference` found)
     -- this parser runs in StateT and comes equipped with the following
     -- equivalent unary operators:
     -- x .:? k (Parser) <==> x ..:? k (StateT)
     -- x .!= v (Parser) <==> x ..!= v (StateT)
     -- tl;dr use an extra initial . to lift into the StateT parser
-    where parser v =
-            let useKey k = modify' $ insert k
-                x ..:? k = useKey k >> lift (x .:? k)
-                x ..!= y = fromMaybe y <$> x
-                -- Parse as unbounded Integer and see if it fits into W256
-                getWord256 k def = do
-                  value :: Integer <- fromMaybe (fromIntegral (def :: W256)) <$> v ..:? k
-                  if value > fromIntegral (maxBound :: W256) then
-                    fail $ show k <> ": value does not fit in 256 bits"
-                  else
-                    pure $ fromIntegral value
+    where
+    parser v =
+      EConfig <$> campaignConfParser
+              <*> pure names
+              <*> solConfParser
+              <*> testConfParser
+              <*> txConfParser
+              <*> (UIConf <$> v ..:? "timeout" <*> formatParser)
+      where
+      useKey k = modify' $ insert k
+      x ..:? k = useKey k >> lift (x .:? k)
+      x ..!= y = fromMaybe y <$> x
+      -- Parse as unbounded Integer and see if it fits into W256
+      getWord256 k def = do
+        value :: Integer <- fromMaybe (fromIntegral (def :: W256)) <$> v ..:? k
+        if value > fromIntegral (maxBound :: W256) then
+          fail $ show k <> ": value does not fit in 256 bits"
+        else
+          pure $ fromIntegral value
 
-                -- TxConf
-                xc = TxConf <$> v ..:? "propMaxGas" ..!= maxGasPerBlock
-                            <*> v ..:? "testMaxGas" ..!= maxGasPerBlock
-                            <*> getWord256 "maxGasprice" 0
-                            <*> getWord256 "maxTimeDelay" defaultTimeDelay
-                            <*> getWord256 "maxBlockDelay" defaultBlockDelay
-                            <*> getWord256 "maxValue" 100000000000000000000 -- 100 eth
+      txConfParser = TxConf
+        <$> v ..:? "propMaxGas" ..!= maxGasPerBlock
+        <*> v ..:? "testMaxGas" ..!= maxGasPerBlock
+        <*> getWord256 "maxGasprice" 0
+        <*> getWord256 "maxTimeDelay" defaultTimeDelay
+        <*> getWord256 "maxBlockDelay" defaultBlockDelay
+        <*> getWord256 "maxValue" 100000000000000000000 -- 100 eth
 
-                -- TestConf
-                tc = do
-                  psender <- v ..:? "psender" ..!= 0x10000
-                  fprefix <- v ..:? "prefix"  ..!= "echidna_"
-                  let goal fname = if (fprefix <> "revert_") `isPrefixOf` fname then ResRevert else ResTrue
-                      classify fname vm = maybe ResOther classifyRes vm._result == goal fname
-                  return $ TestConf classify (const psender)
+      testConfParser = do
+        psender <- v ..:? "psender" ..!= 0x10000
+        fprefix <- v ..:? "prefix"  ..!= "echidna_"
+        let goal fname = if (fprefix <> "revert_") `isPrefixOf` fname then ResRevert else ResTrue
+            classify fname vm = maybe ResOther classifyRes vm._result == goal fname
+        pure $ TestConf classify (const psender)
 
-                -- CampaignConf
-                cov = v ..:? "coverage" <&> \case Just False -> Nothing
-                                                  _          -> Just mempty
-                cc = CampaignConf <$> v ..:? "testLimit"   ..!= defaultTestLimit
-                                  <*> v ..:? "stopOnFail"  ..!= False
-                                  <*> v ..:? "estimateGas" ..!= False
-                                  <*> v ..:? "seqLen"      ..!= defaultSequenceLength
-                                  <*> v ..:? "shrinkLimit" ..!= defaultShrinkLimit
-                                  <*> cov
-                                  <*> v ..:? "seed"
-                                  <*> v ..:? "dictFreq"    ..!= 0.40
-                                  <*> v ..:? "corpusDir"   ..!= Nothing
-                                  <*> v ..:? "mutConsts"   ..!= defaultMutationConsts
+      campaignConfParser = CampaignConf
+        <$> v ..:? "testLimit"   ..!= defaultTestLimit
+        <*> v ..:? "stopOnFail"  ..!= False
+        <*> v ..:? "estimateGas" ..!= False
+        <*> v ..:? "seqLen"      ..!= defaultSequenceLength
+        <*> v ..:? "shrinkLimit" ..!= defaultShrinkLimit
+        <*> (v ..:? "coverage" <&> \case Just False -> Nothing;  _ -> Just mempty)
+        <*> v ..:? "seed"
+        <*> v ..:? "dictFreq"    ..!= 0.40
+        <*> v ..:? "corpusDir"   ..!= Nothing
+        <*> v ..:? "mutConsts"   ..!= defaultMutationConsts
 
-                -- SolConf
-                fnFilter = bool Whitelist Blacklist <$> v ..:? "filterBlacklist" ..!= True
-                                                    <*> v ..:? "filterFunctions" ..!= []
-                mode = v ..:? "testMode" >>= \case
-                  Just s  -> pure $ validateTestMode s
-                  Nothing -> pure "property"
-                sc = SolConf <$> v ..:? "contractAddr"    ..!= defaultContractAddr
-                             <*> v ..:? "deployer"        ..!= defaultDeployerAddr
-                             <*> v ..:? "sender"          ..!= Set.fromList [0x10000, 0x20000, defaultDeployerAddr]
-                             <*> v ..:? "balanceAddr"     ..!= 0xffffffff
-                             <*> v ..:? "balanceContract" ..!= 0
-                             <*> v ..:? "codeSize"        ..!= 0x6000      -- 24576 (EIP-170)
-                             <*> v ..:? "prefix"          ..!= "echidna_"
-                             <*> v ..:? "cryticArgs"      ..!= []
-                             <*> v ..:? "solcArgs"        ..!= ""
-                             <*> v ..:? "solcLibs"        ..!= []
-                             <*> v ..:? "quiet"           ..!= False
-                             <*> v ..:? "initialize"      ..!= Nothing
-                             <*> v ..:? "deployContracts" ..!= []
-                             <*> v ..:? "deployBytecodes" ..!= []
-                             <*> v ..:? "allContracts"    ..!= False
-                             <*> mode
-                             <*> v ..:? "testDestruction" ..!= False
-                             <*> v ..:? "allowFFI"        ..!= False
-                             <*> fnFilter
-                names :: Names
-                names Sender = (" from: " ++) . show
-                names _      = const ""
-                format = fromMaybe Interactive <$> (v ..:? "format" >>= \case
-                  Just ("text" :: String) -> pure . Just . NonInteractive $ Text
-                  Just "json"             -> pure . Just . NonInteractive $ JSON
-                  Just "none"             -> pure . Just . NonInteractive $ None
-                  Nothing -> pure Nothing
-                  _ -> M.fail "Unrecognized format type (should be text, json, or none)") in
-            EConfig <$> cc <*> pure names <*> sc <*> tc <*> xc
-                    <*> (UIConf <$> v ..:? "timeout" <*> format)
+      solConfParser = SolConf
+        <$> v ..:? "contractAddr"    ..!= defaultContractAddr
+        <*> v ..:? "deployer"        ..!= defaultDeployerAddr
+        <*> v ..:? "sender"          ..!= Set.fromList [0x10000, 0x20000, defaultDeployerAddr]
+        <*> v ..:? "balanceAddr"     ..!= 0xffffffff
+        <*> v ..:? "balanceContract" ..!= 0
+        <*> v ..:? "codeSize"        ..!= 0x6000      -- 24576 (EIP-170)
+        <*> v ..:? "prefix"          ..!= "echidna_"
+        <*> v ..:? "cryticArgs"      ..!= []
+        <*> v ..:? "solcArgs"        ..!= ""
+        <*> v ..:? "solcLibs"        ..!= []
+        <*> v ..:? "quiet"           ..!= False
+        <*> v ..:? "initialize"      ..!= Nothing
+        <*> v ..:? "deployContracts" ..!= []
+        <*> v ..:? "deployBytecodes" ..!= []
+        <*> ((<|>) <$> v ..:? "allContracts"
+                   -- TODO: keep compatible with the old name for a while
+                   <*> lift (v .:? "multi-abi")) ..!= False
+        <*> mode
+        <*> v ..:? "testDestruction" ..!= False
+        <*> v ..:? "allowFFI"        ..!= False
+        <*> fnFilter
+        where
+        mode = v ..:? "testMode" >>= \case
+          Just s  -> pure $ validateTestMode s
+          Nothing -> pure "property"
+        fnFilter = bool Whitelist Blacklist <$> v ..:? "filterBlacklist" ..!= True
+                                            <*> v ..:? "filterFunctions" ..!= []
+
+      names :: Names
+      names Sender = (" from: " ++) . show
+      names _      = const ""
+
+      formatParser = fromMaybe Interactive <$> (v ..:? "format" >>= \case
+        Just ("text" :: String) -> pure . Just . NonInteractive $ Text
+        Just "json"             -> pure . Just . NonInteractive $ JSON
+        Just "none"             -> pure . Just . NonInteractive $ None
+        Nothing -> pure Nothing
+        _ -> fail "Unrecognized format type (should be text, json, or none)")
 
 -- | The default config used by Echidna (see the 'FromJSON' instance for values used).
 defaultConfig :: EConfig

diff --git a/lib/Echidna/Exec.hs b/lib/Echidna/Exec.hs
@@ -21,7 +21,7 @@ import System.Process (readProcessWithExitCode)
 
 import Echidna.Events (emptyEvents)
 import Echidna.Transaction
-import Echidna.Types (ExecException(..), fromEVM)
+import Echidna.Types (ExecException(..), Gas, fromEVM)
 import Echidna.Types.Buffer (viewBuffer)
 import Echidna.Types.Coverage (CoverageMap)
 import Echidna.Types.Signature (BytecodeMemo, lookupBytecodeMetadata)
@@ -63,7 +63,7 @@ vmExcept e = throwM $ case VMFailure e of {Illegal -> IllegalExec e; _ -> Unknow
 
 -- | Given an error handler `onErr`, an execution strategy `executeTx`, and a transaction `tx`,
 -- execute that transaction using the given execution strategy, calling `onErr` on errors.
-execTxWith :: (MonadIO m, MonadState s m) => Lens' s VM -> (Error -> m ()) -> m VMResult -> Tx -> m (VMResult, Int)
+execTxWith :: (MonadIO m, MonadState s m) => Lens' s VM -> (Error -> m ()) -> m VMResult -> Tx -> m (VMResult, Gas)
 execTxWith l onErr executeTx tx = do
   vm <- use l
   if hasSelfdestructed vm tx.dst then
@@ -76,7 +76,7 @@ execTxWith l onErr executeTx tx = do
     vmResult <- runFully
     gasLeftAfterTx <- use $ l . state . gas
     handleErrorsAndConstruction vmResult vmBeforeTx
-    pure (vmResult, fromIntegral $ gasLeftBeforeTx - gasLeftAfterTx)
+    pure (vmResult, gasLeftBeforeTx - gasLeftAfterTx)
   where
   runFully = do
     vmResult <- executeTx
@@ -135,15 +135,15 @@ execTxWith l onErr executeTx tx = do
     _ -> pure ()
 
 -- | Execute a transaction "as normal".
-execTx :: (MonadIO m, MonadState VM m, MonadThrow m) => Tx -> m (VMResult, Int)
+execTx :: (MonadIO m, MonadState VM m, MonadThrow m) => Tx -> m (VMResult, Gas)
 execTx = execTxWith id vmExcept $ fromEVM exec
 
 -- | Execute a transaction, logging coverage at every step.
 execTxWithCov
   :: (MonadIO m, MonadState VM m, MonadThrow m)
   => BytecodeMemo
   -> Tx
-  -> m ((VMResult, Int), CoverageMap)
+  -> m ((VMResult, Gas), CoverageMap)
 execTxWithCov memo tx = do
   vm <- get
   (r, (vm', cm)) <- runStateT (execTxWith _1 vmExcept execCov tx) (vm, mempty)

diff --git a/lib/Echidna/Output/JSON.hs b/lib/Echidna/Output/JSON.hs
@@ -15,6 +15,7 @@ import Numeric (showHex)
 import EVM.Types (keccak')
 
 import Echidna.ABI (ppAbiValue, GenDict(..))
+import Echidna.Types (Gas)
 import Echidna.Types.Coverage (CoverageInfo)
 import Echidna.Types.Campaign qualified as C
 import Echidna.Types.Test qualified as T
@@ -27,7 +28,7 @@ data Campaign = Campaign
   , _tests :: [Test]
   , seed :: Int
   , coverage :: Map String [CoverageInfo]
-  , gasInfo :: [(Text, (Int, [Tx]))]
+  , gasInfo :: [(Text, (Gas, [Tx]))]
   }
 
 instance ToJSON Campaign where