Project-wide cleanup (#1021)

lib/Echidna.hs

@@ -1,7 +1,6 @@
 module Echidna where
 
 import Control.Monad.Catch (MonadThrow(..))
-import Data.HashMap.Strict qualified as HM
 import Data.List (find)
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
@@ -88,7 +87,7 @@ prepareContract env contracts solFiles specifiedContract seed = do
 loadInitialCorpus :: Env -> World -> IO [[Tx]]
 loadInitialCorpus env world = do
   -- load transactions from init sequence (if any)
-  let sigs = Set.fromList $ concatMap NE.toList (HM.elems world.highSignatureMap)
+  let sigs = Set.fromList $ concatMap NE.toList (Map.elems world.highSignatureMap)
   ethenoCorpus <-
     case env.cfg.solConf.initialize of
       Nothing -> pure []

lib/Echidna/ABI.hs

@@ -1,6 +1,3 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DerivingStrategies #-}
-
 module Echidna.ABI where
 
 import Control.Monad (liftM2, liftM3, foldM, replicateM)
@@ -15,9 +12,8 @@ import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
 import Data.DoubleWord (Int256, Word256)
 import Data.Foldable (toList)
-import Data.Hashable (Hashable(..))
-import Data.HashMap.Strict (HashMap)
-import Data.HashMap.Strict qualified as M
+import Data.Map (Map)
+import Data.Map qualified as Map
 import Data.Set (Set)
 import Data.Set qualified as Set
 import Data.List (intercalate)
@@ -30,7 +26,6 @@ import Data.Text.Encoding (encodeUtf8)
 import Data.Text.Encoding qualified as TE
 import Data.Vector (Vector)
 import Data.Vector qualified as V
-import Data.Vector.Instances ()
 import Data.Word (Word8)
 import Numeric (showHex)
 
@@ -108,9 +103,9 @@ hashSig = abiKeccak . TE.encodeUtf8
 data GenDict = GenDict
   { pSynthA    :: Float
     -- ^ Fraction of time to use dictionary vs. synthesize
-  , constants  :: !(HashMap AbiType (Set AbiValue))
+  , constants  :: !(Map AbiType (Set AbiValue))
     -- ^ Constants to use, sorted by type
-  , wholeCalls :: !(HashMap SolSignature (Set SolCall))
+  , wholeCalls :: !(Map SolSignature (Set SolCall))
     -- ^ Whole calls to use, sorted by type
   , defSeed    :: Int
     -- ^ Default seed to use if one is not provided in EConfig
@@ -121,20 +116,16 @@ data GenDict = GenDict
   }
 
 hashMapBy
-  :: (Hashable k, Hashable a, Eq k, Ord a)
+  :: (Ord k, Eq k, Ord a)
   => (a -> k)
   -> Set a
-  -> HashMap k (Set a)
-hashMapBy f = M.fromListWith Set.union . fmap (\v -> (f v, Set.singleton v)) . Set.toList
+  -> Map k (Set a)
+hashMapBy f = Map.fromListWith Set.union . fmap (\v -> (f v, Set.singleton v)) . Set.toList
 
 gaddCalls :: Set SolCall -> GenDict -> GenDict
 gaddCalls calls dict =
   dict { wholeCalls = dict.wholeCalls <> hashMapBy (fmap $ fmap abiValueType) calls }
 
-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
 mkGenDict
@@ -317,12 +308,17 @@ mutateAbiCall = traverse f
 -- | Given a generator taking an @a@ and returning a @b@ and a way to get @b@s associated with some
 -- @a@ from a 'GenDict', return a generator that takes an @a@ and either synthesizes new @b@s with the
 -- provided generator or uses the 'GenDict' dictionary (when available).
-genWithDict :: (Eq a, Hashable a, MonadRandom m)
-            => GenDict -> HashMap a (Set b) -> (a -> m b) -> a -> m b
+genWithDict
+  :: (Eq a, Ord a, MonadRandom m)
+  => GenDict
+  -> Map a (Set b)
+  -> (a -> m b)
+  -> a
+  -> m b
 genWithDict genDict m g t = do
   r <- getRandom
   let maybeValM = if genDict.pSynthA >= r then fromDict else pure Nothing
-      fromDict = case M.lookup t m of
+      fromDict = case Map.lookup t m of
                    Nothing -> pure Nothing
                    Just cs -> Just <$> rElem' cs
   fromMaybe <$> g t <*> maybeValM
@@ -362,9 +358,15 @@ genAbiCallM genDict abi = do
                          abi
   mutateAbiCall solCall
 
--- | Given a list of 'SolSignature's, generate a random 'SolCall' for one, possibly with a dictionary.
-genInteractionsM :: MonadRandom m => GenDict -> NonEmpty SolSignature -> m SolCall
-genInteractionsM genDict l = genAbiCallM genDict =<< rElem l
+-- | Given a list of 'SolSignature's, generate a random 'SolCall' for one,
+-- possibly with a dictionary.
+genInteractionsM
+  :: MonadRandom m
+  => GenDict
+  -> NonEmpty SolSignature
+  -> m SolCall
+genInteractionsM genDict solSignatures =
+  rElem solSignatures >>= genAbiCallM genDict
 
 abiCalldata :: Text -> Vector AbiValue -> ByteString
 abiCalldata s xs = BSLazy.toStrict . runPut $ do

lib/Echidna/Campaign.hs

@@ -14,7 +14,6 @@ import Control.Monad.Trans (lift)
 import Control.Monad.Trans.Random.Strict (liftCatch)
 import Data.Binary.Get (runGetOrFail)
 import Data.ByteString.Lazy qualified as LBS
-import Data.HashMap.Strict qualified as H
 import Data.IORef (readIORef, writeIORef)
 import Data.Map qualified as Map
 import Data.Map (Map, (\\))
@@ -162,11 +161,12 @@ execTxOptC
 execTxOptC tx = do
   (vm, camp@Campaign{coverage = oldCov}) <- get
   ((res, txCov), vm') <- runStateT (execTxWithCov tx) vm
-  let vmr = getResult $ fst res
-  -- Update the tx coverage map with the proper binary according to the vm result
-  let txCov' = Map.mapWithKey (\_ s -> Set.map (set _4 vmr) s) txCov
-  -- Update the global coverage map with the one from this tx run
-  let newCov = Map.unionWith Set.union oldCov txCov'
+  let
+    vmr = getResult $ fst res
+    -- Update the tx coverage map with the proper binary according to the vm result
+    txCov' = Map.mapWithKey (\_ s -> Set.map (set _4 vmr) s) txCov
+    -- Update the global coverage map with the one from this tx run
+    newCov = Map.unionWith Set.union oldCov txCov'
   put (vm', camp { coverage = newCov })
   when (coveragePoints oldCov < coveragePoints newCov) $ do
     let dict' = case tx.call of
@@ -220,39 +220,42 @@ callseq initialCorpus vm world seqLen = do
   conf <- asks (.cfg.campaignConf)
   -- First, we figure out whether we need to execute with or without coverage
   -- optimization and gas info, and pick our execution function appropriately
-  let coverageEnabled = isJust conf.knownCoverage
-  let ef = if coverageEnabled
-              then execTxOptC
-              else \tx -> do (v, ca) <- get
-                             (r, vm') <- runStateT (execTx tx) v
-                             put (vm', ca)
-                             pure r
+  let
+    coverageEnabled = isJust conf.knownCoverage
+    execFunc =
+      if coverageEnabled
+         then execTxOptC
+         else \tx -> do
+           (v, ca) <- get
+           (r, vm') <- runStateT (execTx tx) v
+           put (vm', ca)
+           pure r
   -- Then, we get the current campaign state
   camp <- get
   -- Then, we generate the actual transaction in the sequence
   metaCacheRef <- asks (.metadataCache)
   metaCache <- liftIO $ readIORef metaCacheRef
   -- Replay transactions in the corpus during the first iterations
   txSeq <- if length initialCorpus > camp.ncallseqs
-    then pure $ initialCorpus !! camp.ncallseqs
-    else randseq metaCache seqLen vm._env._contracts world
+              then pure $ initialCorpus !! camp.ncallseqs
+              else randseq metaCache seqLen vm._env._contracts world
 
   -- We then run each call sequentially. This gives us the result of each call, plus a new state
-  (res, (vm', camp')) <- runStateT (evalSeq vm ef txSeq) (vm, camp)
+  (res, (vm', camp')) <- runStateT (evalSeq vm execFunc txSeq) (vm, camp)
 
   let
     -- compute the addresses not present in the old VM via set difference
     newAddrs = Map.keys $ vm'._env._contracts \\ vm._env._contracts
     -- and construct a set to union to the constants table
-    diffs = H.fromList [(AbiAddressType, Set.fromList $ AbiAddress <$> newAddrs)]
+    diffs = Map.fromList [(AbiAddressType, Set.fromList $ AbiAddress <$> newAddrs)]
     -- Now we try to parse the return values as solidity constants, and add then to the 'GenDict'
-    results = parse (map (\(t, (vr, _)) -> (t, vr)) res) camp.genDict.rTypes
+    results = returnValues (map (\(t, (vr, _)) -> (t, vr)) res) camp.genDict.rTypes
     -- union the return results with the new addresses
-    additions = H.unionWith Set.union diffs results
+    additions = Map.unionWith Set.union diffs results
     -- append to the constants dictionary
     updatedDict = camp.genDict
-      { constants = H.unionWith Set.union additions camp.genDict.constants
-      , dictValues = Set.union (mkDictValues $ Set.unions $ H.elems additions)
+      { constants = Map.unionWith Set.union additions camp.genDict.constants
+      , dictValues = Set.union (mkDictValues $ Set.unions $ Map.elems additions)
                                camp.genDict.dictValues
       }
 
@@ -274,16 +277,17 @@ callseq initialCorpus vm world seqLen = do
     , ncallseqs = camp.ncallseqs + 1
     }
   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 $ \(tx, result) -> do
-      fname <- case tx.call of
-        SolCall (fname, _) -> Just fname
-        _ -> Nothing
-      type' <- rt fname
+  -- 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 Map.
+  returnValues txResults returnTypeOf =
+    Map.fromList . flip mapMaybe txResults $ \(tx, result) -> do
       case result of
-        VMSuccess (ConcreteBuf buf) ->
+        VMSuccess (ConcreteBuf buf) -> do
+          fname <- case tx.call of
+            SolCall (fname, _) -> Just fname
+            _ -> Nothing
+          type' <- returnTypeOf fname
           case runGetOrFail (getAbi type') (LBS.fromStrict buf) of
             -- make sure we don't use cheat codes to form fuzzing call sequences
             Right (_, _, abiValue) | abiValue /= AbiAddress cheatCode ->
@@ -305,17 +309,19 @@ campaign
   -> m Campaign
 campaign u vm world ts dict initialCorpus = do
   conf <- asks (.cfg.campaignConf)
-
   metaCacheRef <- asks (.metadataCache)
   fetchContractCacheRef <- asks (.fetchContractCache)
   external <- liftIO $ Map.mapMaybe id <$> readIORef fetchContractCacheRef
   liftIO $ writeIORef metaCacheRef (memo (vm._env._contracts <> external))
 
-  let c = fromMaybe mempty conf.knownCoverage
-  let effectiveSeed = fromMaybe dict.defSeed conf.seed
-      effectiveGenDict = dict { defSeed = effectiveSeed }
-      camp = Campaign ts c mempty effectiveGenDict False Set.empty 0
+  let
+    covMap = fromMaybe mempty conf.knownCoverage
+    effectiveSeed = fromMaybe dict.defSeed conf.seed
+    effectiveGenDict = dict { defSeed = effectiveSeed }
+    camp = Campaign ts covMap mempty effectiveGenDict False Set.empty 0
+
   execStateT (evalRandT (lift u >> runCampaign) (mkStdGen effectiveSeed)) camp
+
   where
     memo = makeBytecodeCache . map (forceBuf . (^. bytecode)) . Map.elems
     runCampaign = do

lib/Echidna/Config.hs

@@ -8,7 +8,6 @@ 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
 import Data.Text (isPrefixOf)
@@ -39,9 +38,9 @@ instance FromJSON EConfigWithUsage where
     let v' = case o of
                Object v -> v
                _        -> mempty
-    (c, ks) <- runStateT (parser v') $ fromList []
-    let found = fromList (keys v')
-    pure $ EConfigWithUsage c (found `difference` ks) (ks `difference` found)
+    (c, ks) <- runStateT (parser v') $ Set.fromList []
+    let found = Set.fromList (keys v')
+    pure $ EConfigWithUsage c (found `Set.difference` ks) (ks `Set.difference` found)
     -- this parser runs in StateT and comes equipped with the following
     -- equivalent unary operators:
     -- x .:? k (Parser) <==> x ..:? k (StateT)
@@ -58,7 +57,7 @@ instance FromJSON EConfigWithUsage where
               <*> v ..:? "rpcUrl"
               <*> v ..:? "rpcBlock"
       where
-      useKey k = modify' $ insert k
+      useKey k = modify' $ Set.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

lib/Echidna/Deploy.hs

@@ -1,6 +1,8 @@
 module Echidna.Deploy where
 
+import Control.Monad (foldM)
 import Control.Monad.Catch (MonadThrow(..), throwM)
+import Control.Monad.Reader (MonadReader, asks)
 import Control.Monad.State.Strict (execStateT, MonadIO)
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
@@ -9,16 +11,15 @@ import Data.Either (fromRight)
 import Data.Text (Text, unlines)
 import Data.Text.Encoding (encodeUtf8)
 
-import EVM hiding (Env)
+import EVM hiding (bytecode, Env)
 import EVM.Solidity
 import EVM.Types (Addr)
 
-import Echidna.Types.Solidity (SolException(..))
-import Echidna.Types.Tx (createTx, unlimitedGasPerBlock)
 import Echidna.Exec (execTx)
 import Echidna.Events (extractEvents)
-import Control.Monad.Reader (MonadReader, asks)
 import Echidna.Types.Config (Env(..))
+import Echidna.Types.Solidity (SolException(..))
+import Echidna.Types.Tx (createTx, unlimitedGasPerBlock)
 
 deployContracts
   :: (MonadIO m, MonadReader Env m, MonadThrow m)
@@ -46,17 +47,15 @@ deployBytecodes'
   -> Addr
   -> VM
   -> m VM
-deployBytecodes' []           _ vm = pure vm
-deployBytecodes' ((a, bc):cs) d vm =
-  deployBytecodes' cs d =<< loadRest
+deployBytecodes' cs src initialVM = foldM deployOne initialVM cs
   where
-    -- This will initialize with zero a large number of possible constructor parameters
-    zeros = BS.replicate 320 0
-    loadRest = do
-      vm' <- flip execStateT vm $
-        execTx $ createTx (bc <> zeros) d a unlimitedGasPerBlock (0, 0)
-      case vm'._result of
-        Just (VMSuccess _) -> pure vm'
-        _ -> do
-          di <- asks (.dapp)
-          throwM $ DeploymentFailed a (Data.Text.unlines $ extractEvents True di vm')
+  deployOne vm (dst, bytecode) = do
+    vm' <- flip execStateT vm $
+      execTx $ createTx (bytecode <> zeros) src dst unlimitedGasPerBlock (0, 0)
+    case vm'._result of
+      Just (VMSuccess _) -> pure vm'
+      _ -> do
+        di <- asks (.dapp)
+        throwM $ DeploymentFailed dst (Data.Text.unlines $ extractEvents True di vm')
+  -- This will initialize with zero a large number of possible constructor parameters
+  zeros = BS.replicate 320 0

lib/Echidna/Exec.hs

@@ -41,14 +41,15 @@ data ErrorClass = RevertE | IllegalE | UnknownE
 
 -- | Given an execution error, classify it. Mostly useful for nice @pattern@s ('Reversion', 'Illegal').
 classifyError :: Error -> ErrorClass
-classifyError (OutOfGas _ _)         = RevertE
-classifyError (Revert _)             = RevertE
-classifyError (UnrecognizedOpcode _) = RevertE
-classifyError StackLimitExceeded     = RevertE
-classifyError StackUnderrun          = IllegalE
-classifyError BadJumpDestination     = IllegalE
-classifyError IllegalOverflow        = IllegalE
-classifyError _                      = UnknownE
+classifyError = \case
+  OutOfGas _ _         -> RevertE
+  Revert _             -> RevertE
+  UnrecognizedOpcode _ -> RevertE
+  StackLimitExceeded   -> RevertE
+  StackUnderrun        -> IllegalE
+  BadJumpDestination   -> IllegalE
+  IllegalOverflow      -> IllegalE
+  _                    -> UnknownE
 
 -- | Extracts the 'Query' if there is one.
 getQuery :: VMResult -> Maybe Query
@@ -65,7 +66,8 @@ pattern Illegal <- VMFailure (classifyError -> IllegalE)
 
 -- | Given an execution error, throw the appropriate exception.
 vmExcept :: MonadThrow m => Error -> m ()
-vmExcept e = throwM $ case VMFailure e of {Illegal -> IllegalExec e; _ -> UnknownFailure e}
+vmExcept e = throwM $
+  case VMFailure e of {Illegal -> IllegalExec e; _ -> UnknownFailure e}
 
 -- | 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.