Update hevm to 0.50.1 (#884)

* Update hevm to 0.50.1

* Fix hlint

* Fix warnings

* Fix warnings in tests

* Optimize genDelay and genValue

* Document dictValues

flake.nix

@@ -42,8 +42,17 @@
             chmod +x $out/bin/solc
           '';
         };
+
+        hevm = pkgs.haskell.lib.dontCheck (
+          pkgs.haskellPackages.callCabal2nix "hevm" (pkgs.fetchFromGitHub {
+            owner = "ethereum";
+            repo = "hevm";
+            rev = "0.50.1";
+            sha256 = "sha256-fgseeQNxWh13PVLsfvyAdZZwtqzELbTivPOiRc6cox8=";
+        }) { secp256k1 = pkgs.secp256k1; });
+
         echidna = with pkgs; lib.pipe
-          (haskellPackages.callCabal2nix "echidna" ./. {})
+          (haskellPackages.callCabal2nix "echidna" ./. { inherit hevm; })
           [
             (haskell.lib.compose.addTestToolDepends [ haskellPackages.hpack slither-analyzer solc ])
             (haskell.lib.compose.disableCabalFlag "static")

lib/Echidna/ABI.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Echidna.ABI where
@@ -18,10 +19,11 @@ import Data.Hashable (Hashable(..))
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as M
 import Data.HashSet (HashSet, fromList, union)
-import Data.HashSet qualified as H
+import Data.Set (Set)
+import Data.Set qualified as Set
 import Data.List (intercalate)
 import Data.List.NonEmpty qualified as NE
-import Data.Maybe (fromMaybe, catMaybes)
+import Data.Maybe (fromMaybe, catMaybes, mapMaybe)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.Encoding (encodeUtf8)
@@ -33,7 +35,7 @@ import Data.Word (Word8)
 import Numeric (showHex)
 
 import EVM.ABI hiding (genAbiValue)
-import EVM.Types (Addr, abiKeccak)
+import EVM.Types (Addr, abiKeccak, W256)
 
 import Echidna.Mutator.Array (mutateLL, replaceAt)
 import Echidna.Types.Random
@@ -107,34 +109,24 @@ data GenDict = GenDict { _pSynthA    :: Float
                          -- ^ Default seed to use if one is not provided in EConfig
                        , _rTypes     :: Text -> Maybe AbiType
                          -- ^ Return types of any methods we scrape return values from
+                       , _dictValues :: Set W256
+                         -- ^ A set of int/uint constants for better performance
                        }
 
 makeLenses 'GenDict
 
 hashMapBy :: (Hashable k, Hashable a, Eq k, Ord a) => (a -> k) -> [a] -> HashMap k (HashSet a)
 hashMapBy f = M.fromListWith union . fmap (\v -> (f v, fromList [v]))
 
-gaddConstants :: [AbiValue] -> GenDict -> GenDict
-gaddConstants l = constants <>~ hashMapBy abiValueType l
-
 gaddCalls :: [SolCall] -> GenDict -> GenDict
 gaddCalls c = wholeCalls <>~ hashMapBy (fmap $ fmap abiValueType) c
 
 defaultDict :: GenDict
 defaultDict = mkGenDict 0 [] [] 0 (const Nothing)
 
-dictValues :: GenDict -> [Integer]
-dictValues g = catMaybes $ concatMap (\(_,h) -> map fromValue $ H.toList h) $ M.toList $ g ^. constants
-  where fromValue (AbiUInt _ n) = Just (toInteger n)
-        fromValue (AbiInt  _ n) = Just (toInteger n)
-        fromValue _             = Nothing
-
--- This instance is the only way for mkConf to work nicely, and is well-formed.
-{-# ANN module ("HLint: ignore Unused LANGUAGE pragma" :: String) #-}
--- We need the above since hlint doesn't notice DeriveAnyClass in StandaloneDeriving.
-deriving instance Hashable AbiType
-deriving instance Hashable AbiValue
-deriving instance Hashable Addr
+deriving anyclass instance Hashable AbiType
+deriving anyclass instance Hashable AbiValue
+deriving anyclass instance Hashable Addr
 
 -- | Construct a 'GenDict' from some dictionaries, a 'Float', a default seed, and a typing rule for
 -- return values
@@ -145,7 +137,14 @@ mkGenDict :: Float      -- ^ Percentage of time to mutate instead of synthesize.
           -> (Text -> Maybe AbiType)
           -- ^ A return value typing rule
           -> GenDict
-mkGenDict p vs cs = GenDict p (hashMapBy abiValueType vs) (hashMapBy (fmap $ fmap abiValueType) cs)
+mkGenDict p vs cs s tr =
+  GenDict p (hashMapBy abiValueType vs) (hashMapBy (fmap $ fmap abiValueType) cs) s tr (mkDictValues vs)
+
+mkDictValues :: [AbiValue] -> Set W256
+mkDictValues vs = Set.fromList $ mapMaybe fromValue vs
+  where fromValue (AbiUInt _ n) = Just (fromIntegral n)
+        fromValue (AbiInt  _ n) = Just (fromIntegral n)
+        fromValue _             = Nothing
 
 -- Generation (synthesis)
 

lib/Echidna/Campaign.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE GADTs #-}
 
 module Echidna.Campaign where
 
@@ -28,7 +29,7 @@ import System.Random (mkStdGen)
 import EVM
 import EVM.Dapp (DappInfo)
 import EVM.ABI (getAbi, AbiType(AbiAddressType), AbiValue(AbiAddress))
-import EVM.Types (Addr, Buffer(..))
+import EVM.Types (Addr, Expr(ConcreteBuf))
 
 import Echidna.ABI
 import Echidna.Exec
@@ -252,12 +253,13 @@ callseq ic v w ql = do
       additions = H.unionWith S.union diffs results
   -- append to the constants dictionary
   modifying (hasLens . genDict . constants) . H.unionWith S.union $ additions
+  modifying (hasLens . genDict . dictValues) . DS.union $ mkDictValues $ S.toList $ S.unions $ H.elems additions
   where
     -- Given a list of transactions and a return typing rule, this checks whether we know the return
     -- type for each function called, and if we do, tries to parse the return value as a value of that
     -- type. It returns a 'GenDict' style HashMap.
     parse l rt = H.fromList . flip mapMaybe l $ \(x, r) -> case (rt =<< x ^? call . _SolCall . _1, r) of
-      (Just ty, VMSuccess (ConcreteBuffer b)) ->
+      (Just ty, VMSuccess (ConcreteBuf b)) ->
         (ty,) . S.fromList . pure <$> runGetOrFail (getAbi ty) (b ^. lazy) ^? _Right . _3
       _ -> Nothing
 

lib/Echidna/Config.hs

@@ -19,7 +19,6 @@ import Data.Text (isPrefixOf)
 import Data.Yaml qualified as Y
 
 import EVM (result)
-import EVM.Types (w256)
 
 import Echidna.Test
 import Echidna.Types.Campaign
@@ -57,7 +56,7 @@ instance FromJSON EConfigWithUsage where
             let useKey k = hasLens %= insert k
                 x ..:? k = useKey k >> lift (x .:? k)
                 x ..!= y = fromMaybe y <$> x
-                getWord s d = w256 . fromIntegral <$> v ..:? s ..!= (d :: Integer)
+                getWord s d = fromIntegral <$> v ..:? s ..!= (d :: Integer)
 
                 -- TxConf
                 xc = TxConf <$> getWord "propMaxGas" maxGasPerBlock

lib/Echidna/Events.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE GADTs #-}
 
 module Echidna.Events where
 
@@ -8,16 +9,15 @@ import Data.Tree (flatten)
 import Data.Tree.Zipper (fromForest, TreePos, Empty)
 import Data.Text (pack, Text)
 import Data.Map qualified as M
-import Data.Maybe (listToMaybe)
+import Data.Maybe (listToMaybe, fromJust)
 import Data.Vector (fromList)
 import Control.Lens
 
 import EVM
 import EVM.ABI (Event(..), Indexed(..), decodeAbiValue, AbiType(AbiUIntType, AbiTupleType, AbiStringType))
-import EVM.Concrete (wordValue)
 import EVM.Dapp
 import EVM.Format (showValues, showError, contractNamePart)
-import EVM.Types (W256, maybeLitWord)
+import EVM.Types (Expr(ConcreteBuf), W256, maybeLitWord)
 import EVM.Solidity (contractName)
 
 type EventMap = M.Map W256 Event
@@ -37,14 +37,14 @@ extractEvents decodeErrors dappInfo' vm =
       forest = traceForest vm
       showTrace trace =
         let ?context = DappContext { _contextInfo = dappInfo', _contextEnv = vm ^?! EVM.env . EVM.contracts } in
-        let codehash' = trace ^. traceContract . codehash
+        let codehash' = fromJust $ maybeLitWord (trace ^. traceContract . codehash)
             maybeContractName = maybeContractNameFromCodeHash codehash'
         in
         case trace ^. traceData of
-          EventTrace (Log addr bytes topics) ->
+          EventTrace addr bytes topics ->
             case maybeLitWord =<< listToMaybe topics of
               Nothing   -> []
-              Just word -> case M.lookup (wordValue word) eventMap of
+              Just word -> case M.lookup word eventMap of
                              Just (Event name _ types) ->
                                -- TODO this is where indexed types are filtered out
                                -- they are filtered out for a reason as they only contain
@@ -67,7 +67,7 @@ extractEvents decodeErrors dappInfo' vm =
 decodeRevert :: Bool -> VM -> Events
 decodeRevert decodeErrors vm =
   case vm ^. result of
-    Just (VMFailure (Revert bs)) -> decodeRevertMsg decodeErrors bs
+    Just (VMFailure (Revert (ConcreteBuf bs))) -> decodeRevertMsg decodeErrors bs
     _                            -> []
 
 decodeRevertMsg :: Bool -> BS.ByteString -> Events

lib/Echidna/Exec.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE GADTs #-}
 
 module Echidna.Exec where
 
@@ -10,11 +11,11 @@ import Data.Has (Has(..))
 import Data.Map qualified as M
 import Data.Maybe (fromMaybe)
 import Data.Set qualified as S
+import Data.Word (Word64)
 
 import EVM
 import EVM.Exec (exec, vmForEthrunCreation)
-import EVM.Types (Buffer(..), Word)
-import EVM.Symbolic (litWord)
+import EVM.Types (Expr(ConcreteBuf, Lit))
 
 import Echidna.Events (emptyEvents)
 import Echidna.Transaction
@@ -43,7 +44,7 @@ getQuery (VMFailure (Query q)) = Just q
 getQuery _                     = Nothing
 
 emptyAccount :: Contract
-emptyAccount = initialContract (RuntimeCode mempty)
+emptyAccount = initialContract (RuntimeCode (ConcreteRuntimeCode mempty))
 
 -- | Matches execution errors that just cause a reversion.
 pattern Reversion :: VMResult
@@ -72,7 +73,7 @@ vmExcept e = throwM $ case VMFailure e of {Illegal -> IllegalExec e; _ -> Unknow
 execTxWith :: (MonadState x m, Has VM x) => (Error -> m ()) -> m VMResult -> Tx -> m (VMResult, Int)
 execTxWith onErr executeTx tx' = do
   isSelfDestruct <- hasSelfdestructed (tx' ^. dst)
-  if isSelfDestruct then pure (VMFailure (Revert ""), 0)
+  if isSelfDestruct then pure (VMFailure (Revert (ConcreteBuf "")), 0)
   else do
     hasLens . traces .= emptyEvents
     vmBeforeTx <- use hasLens
@@ -82,7 +83,7 @@ execTxWith onErr executeTx tx' = do
     gasLeftAfterTx <- use $ hasLens . state . gas
     checkAndHandleQuery vmBeforeTx vmResult' onErr executeTx tx' gasLeftBeforeTx gasLeftAfterTx
 
-checkAndHandleQuery :: (MonadState x m, Has VM x) => VM -> VMResult -> (Error -> m ()) -> m VMResult -> Tx -> EVM.Types.Word -> EVM.Types.Word -> m (VMResult, Int)
+checkAndHandleQuery :: (MonadState x m, Has VM x) => VM -> VMResult -> (Error -> m ()) -> m VMResult -> Tx -> Word64 -> Word64 -> m (VMResult, Int)
 checkAndHandleQuery vmBeforeTx vmResult' onErr executeTx tx' gasLeftBeforeTx gasLeftAfterTx =
         -- Continue transaction whose execution queried a contract or slot
     let continueAfterQuery = do
@@ -94,7 +95,7 @@ checkAndHandleQuery vmBeforeTx vmResult' onErr executeTx tx' gasLeftBeforeTx gas
 
     in case getQuery vmResult' of
       -- A previously unknown contract is required
-      Just (PleaseFetchContract _ _ continuation) -> do
+      Just (PleaseFetchContract _ continuation) -> do
         -- Use the empty contract
         hasLens %= execState (continuation emptyAccount)
         continueAfterQuery
@@ -135,11 +136,11 @@ handleErrorsAndConstruction onErr vmResult' vmBeforeTx tx' = case (vmResult', tx
     hasLens . traces .= tracesBeforeVMReset
     hasLens . state . codeContract .= codeContractBeforeVMReset
   (VMFailure x, _) -> onErr x
-  (VMSuccess (ConcreteBuffer bytecode'), SolCreate _) ->
+  (VMSuccess (ConcreteBuf bytecode'), SolCreate _) ->
     -- Handle contract creation.
     hasLens %= execState (do
-      env . contracts . at (tx' ^. dst) . _Just . contractcode .= InitCode (ConcreteBuffer "")
-      replaceCodeOfSelf (RuntimeCode (ConcreteBuffer bytecode'))
+      env . contracts . at (tx' ^. dst) . _Just . contractcode .= InitCode mempty mempty
+      replaceCodeOfSelf (RuntimeCode (ConcreteRuntimeCode bytecode'))
       loadContract (tx' ^. dst))
   _ -> pure ()
 
@@ -183,6 +184,6 @@ execTxWithCov memo l = do
       pure $ lookupBytecodeMetadata memo bc
 
 initialVM :: VM
-initialVM = vmForEthrunCreation mempty & block . timestamp .~ litWord initialTimestamp
+initialVM = vmForEthrunCreation mempty & block . timestamp .~ Lit initialTimestamp
                                        & block . number .~ initialBlockNumber
                                        & env . contracts .~ mempty       -- fixes weird nonce issues

lib/Echidna/Orphans/JSON.hs

@@ -14,7 +14,7 @@ import Data.ByteString (ByteString)
 import Data.DoubleWord (Word256, Int256, Word160)
 import Data.Text (Text, unpack)
 import EVM.ABI (AbiValue, AbiType)
-import EVM.Types (Addr, Word)
+import EVM.Types (Addr)
 import Text.Read (readMaybe)
 
 readT :: Read a => Text -> Maybe a
@@ -47,8 +47,5 @@ instance FromJSON ByteString where
 instance ToJSON Addr where
   toJSON = toJSON . show
 
-instance FromJSON Word where
-  parseJSON = withText "Word" $ maybe (fail "could not parse Word") pure . readT
-
 $(deriveJSON defaultOptions ''AbiType)
 $(deriveJSON defaultOptions ''AbiValue)

lib/Echidna/Output/JSON.hs

@@ -13,7 +13,7 @@ import Data.Text
 import Data.Text.Encoding (decodeUtf8)
 import Numeric (showHex)
 
-import EVM.Types (keccak)
+import EVM.Types (keccak')
 
 import Echidna.ABI (ppAbiValue, GenDict(..))
 import Echidna.Types.Coverage (CoverageInfo)
@@ -99,7 +99,7 @@ encodeCampaign C.Campaign{..} = encode
            , _error = Nothing
            , _tests = mapTest <$> _tests
            , seed = _defSeed _genDict
-           , coverage = mapKeys (("0x" ++) . (`showHex` "") . keccak) $ DF.toList <$> _coverage
+           , coverage = mapKeys (("0x" ++) . (`showHex` "") . keccak') $ DF.toList <$>_coverage
            , gasInfo = toList _gasInfo
            }
 

lib/Echidna/Output/Source.hs

@@ -4,7 +4,7 @@ import Prelude hiding (writeFile)
 
 import Control.Lens
 import Data.Foldable
-import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
 import Data.List (nub, sort)
 import Data.Map qualified as M
 import Data.Set qualified as S
@@ -140,7 +140,7 @@ srcMapForOpLocation contract (_,n,_,r) =
 buildRuntimeLinesMap :: SourceCache -> [SolcContract] -> M.Map Text (S.Set Int)
 buildRuntimeLinesMap sc contracts =
   M.fromListWith (<>)
-    [(k, S.singleton v) | (k, v) <- catMaybes $ srcMapCodePos sc <$> srcMaps]
+    [(k, S.singleton v) | (k, v) <- mapMaybe (srcMapCodePos sc) srcMaps]
   where
   srcMaps = concatMap
     (\c -> toList $ c ^. runtimeSrcmap <> c ^. creationSrcmap) contracts