Code cleanup (#1020)

lib/Echidna.hs

@@ -3,6 +3,7 @@ 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
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
@@ -38,43 +39,49 @@ import Echidna.Types.World
 -- * A World with all the required data for generating random transactions
 -- * A list of Echidna tests to check
 -- * A prepopulated dictionary
-prepareContract :: Env -> [SolcContract] -> NE.NonEmpty FilePath -> Maybe ContractName -> Seed
-                -> IO (VM, World, [EchidnaTest], GenDict)
+prepareContract
+  :: Env
+  -> [SolcContract]
+  -> NonEmpty FilePath
+  -> Maybe ContractName
+  -> Seed
+  -> IO (VM, World, [EchidnaTest], GenDict)
 prepareContract env contracts solFiles specifiedContract seed = do
   let solConf = env.cfg.solConf
 
   -- compile and load contracts
   (vm, funs, testNames, signatureMap) <- loadSpecified env specifiedContract contracts
 
-  -- load tests
-  let echidnaTests = createTests solConf.testMode
-                                 solConf.testDestruction
-                                 testNames
-                                 vm._state._contract
-                                 funs
-
   -- run processors
   slitherInfo <- runSlither (NE.head solFiles) solConf
   case find (< minSupportedSolcVersion) slitherInfo.solcVersions of
     Just outdatedVersion -> throwM $ OutdatedSolcVersion outdatedVersion
     Nothing -> pure ()
 
-  let eventMap = Map.unions $ map (.eventMap) contracts
-  let world = mkWorld solConf eventMap signatureMap specifiedContract slitherInfo
+  let
+    -- load tests
+    echidnaTests = createTests solConf.testMode
+                               solConf.testDestruction
+                               testNames
+                               vm._state._contract
+                               funs
+
+    eventMap = Map.unions $ map (.eventMap) contracts
+    world = mkWorld solConf eventMap signatureMap specifiedContract slitherInfo
 
-  let deployedAddresses = Set.fromList $ AbiAddress <$> Map.keys vm._env._contracts
-  let constants = enhanceConstants slitherInfo
-                  <> timeConstants
-                  <> extremeConstants
-                  <> staticAddresses solConf
-                  <> deployedAddresses
+    deployedAddresses = Set.fromList $ AbiAddress <$> Map.keys vm._env._contracts
+    constants = enhanceConstants slitherInfo
+                <> timeConstants
+                <> extremeConstants
+                <> staticAddresses solConf
+                <> deployedAddresses
 
-  let dict = mkGenDict env.cfg.campaignConf.dictFreq
-                       -- make sure we don't use cheat codes to form fuzzing call sequences
-                       (Set.delete (AbiAddress cheatCode) constants)
-                       Set.empty
-                       seed
-                       (returnTypes contracts)
+    dict = mkGenDict env.cfg.campaignConf.dictFreq
+                     -- make sure we don't use cheat codes to form fuzzing call sequences
+                     (Set.delete (AbiAddress cheatCode) constants)
+                     Set.empty
+                     seed
+                     (returnTypes contracts)
 
   pure (vm, world, echidnaTests, dict)
 

lib/Echidna/ABI.hs

@@ -21,6 +21,7 @@ import Data.HashMap.Strict qualified as M
 import Data.Set (Set)
 import Data.Set qualified as Set
 import Data.List (intercalate)
+import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
 import Data.Maybe (fromMaybe, catMaybes)
 import Data.Text (Text)
@@ -362,7 +363,7 @@ genAbiCallM genDict abi = do
   mutateAbiCall solCall
 
 -- | Given a list of 'SolSignature's, generate a random 'SolCall' for one, possibly with a dictionary.
-genInteractionsM :: MonadRandom m => GenDict -> NE.NonEmpty SolSignature -> m SolCall
+genInteractionsM :: MonadRandom m => GenDict -> NonEmpty SolSignature -> m SolCall
 genInteractionsM genDict l = genAbiCallM genDict =<< rElem l
 
 abiCalldata :: Text -> Vector AbiValue -> ByteString

lib/Echidna/Campaign.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE GADTs #-}
 
 module Echidna.Campaign where
@@ -9,7 +8,8 @@ import Control.Monad (replicateM, when, unless, void)
 import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
 import Control.Monad.Random.Strict (MonadRandom, RandT, evalRandT)
 import Control.Monad.Reader (MonadReader, asks, liftIO)
-import Control.Monad.State.Strict (MonadState(..), StateT(..), evalStateT, execStateT, gets, MonadIO, modify')
+import Control.Monad.State.Strict
+  (MonadState(..), StateT(..), evalStateT, execStateT, gets, MonadIO, modify')
 import Control.Monad.Trans (lift)
 import Control.Monad.Trans.Random.Strict (liftCatch)
 import Data.Binary.Get (runGetOrFail)
@@ -59,15 +59,16 @@ isDone c | null c.tests = do
   pure $ c.ncallseqs * conf.seqLen >= conf.testLimit
 isDone c = do
   conf <- asks (.campaignConf)
-  let result = \case
-        Open i   -> if i >= conf.testLimit then Just True else Nothing
-        Passed   -> Just True
-        Large i  -> if i >= conf.shrinkLimit then Just False else Nothing
-        Solved   -> Just False
-        Failed _ -> Just False
-  let testResults = result . (.state) <$> c.tests
-  let done = if conf.stopOnFail then Just False `elem` testResults
-                                else all isJust testResults
+  let
+    result = \case
+      Open i   -> if i >= conf.testLimit then Just True else Nothing
+      Passed   -> Just True
+      Large i  -> if i >= conf.shrinkLimit then Just False else Nothing
+      Solved   -> Just False
+      Failed _ -> Just False
+    testResults = result . (.state) <$> c.tests
+    done = if conf.stopOnFail then Just False `elem` testResults
+                              else all isJust testResults
   pure done
 
 -- | Given a 'Campaign', check if the test results should be reported as a
@@ -83,8 +84,12 @@ isSuccessful Campaign{tests} =
 -- (2): The test is 'Open', and evaluating it breaks our runtime
 -- (3): The test is unshrunk, and we can shrink it
 -- Then update accordingly, keeping track of how many times we've tried to solve or shrink.
-updateTest :: (MonadIO m, MonadCatch m, MonadRandom m, MonadReader Env m)
-           => VM -> (VM, [Tx]) -> EchidnaTest -> m EchidnaTest
+updateTest
+  :: (MonadIO m, MonadCatch m, MonadRandom m, MonadReader Env m)
+  => VM
+  -> (VM, [Tx])
+  -> EchidnaTest
+  -> m EchidnaTest
 updateTest vmForShrink (vm, xs) test = do
   limit <- asks (.cfg.campaignConf.testLimit)
   dappInfo <- asks (.dapp)
@@ -104,27 +109,38 @@ updateTest vmForShrink (vm, xs) test = do
       shrinkTest vmForShrink test
 
 -- | Given a rule for updating a particular test's state, apply it to each test in a 'Campaign'.
-runUpdate :: (MonadReader Env m, MonadState Campaign m)
-          => (EchidnaTest -> m EchidnaTest) -> m ()
+runUpdate
+  :: (MonadReader Env m, MonadState Campaign m)
+  => (EchidnaTest -> m EchidnaTest)
+  -> m ()
 runUpdate f = do
   tests' <- mapM f =<< gets (.tests)
   modify' $ \c -> c { tests = tests' }
 
--- | Given an initial 'VM' state and a way to run transactions, evaluate a list of transactions, constantly
--- checking if we've solved any tests or can shrink known solves.
-evalSeq :: (MonadIO m, MonadCatch m, MonadRandom m, MonadReader Env m, MonadState (VM, Campaign) m)
-        => VM -> (Tx -> m a) -> [Tx] -> m [(Tx, a)]
+-- | Given an initial 'VM' state and a way to run transactions, evaluate a list of transactions,
+-- constantly checking if we've solved any tests or can shrink known solves.
+evalSeq
+  :: (MonadIO m, MonadCatch m, MonadRandom m, MonadReader Env m, MonadState (VM, Campaign) m)
+  => VM
+  -> (Tx -> m a)
+  -> [Tx]
+  -> m [(Tx, a)]
 evalSeq vmForShrink e = go [] where
   go r xs = do
     (v', camp) <- get
     camp' <- execStateT (runUpdate (updateTest vmForShrink (v', reverse r))) camp
     put (v', camp')
-    case xs of []     -> pure []
-               (y:ys) -> e y >>= \a -> ((y, a) :) <$> go (y:r) ys
+    case xs of
+      []     -> pure []
+      (y:ys) -> e y >>= \a -> ((y, a) :) <$> go (y:r) ys
 
 -- | Given current `gasInfo` and a sequence of executed transactions, updates information on highest
 -- gas usage for each call
-updateGasInfo :: [(Tx, (VMResult, Gas))] -> [Tx] -> Map Text (Gas, [Tx]) -> Map Text (Gas, [Tx])
+updateGasInfo
+  :: [(Tx, (VMResult, Gas))]
+  -> [Tx]
+  -> Map Text (Gas, [Tx])
+  -> Map Text (Gas, [Tx])
 updateGasInfo [] _ gi = gi
 updateGasInfo ((tx@(Tx { call = SolCall (f, _) }), (_, used')):txs) tseq gi =
   case mused of
@@ -139,8 +155,10 @@ 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, MonadReader Env m, MonadState (VM, Campaign) m, MonadThrow m)
-           => Tx -> m (VMResult, Gas)
+execTxOptC
+  :: (MonadIO m, MonadReader Env m, MonadState (VM, Campaign) m, MonadThrow m)
+  => Tx
+  -> m (VMResult, Gas)
 execTxOptC tx = do
   (vm, camp@Campaign{coverage = oldCov}) <- get
   ((res, txCov), vm') <- runStateT (execTxWithCov tx) vm
@@ -164,8 +182,13 @@ addToCorpus n res corpus = if null rtxs then corpus else Set.insert (n, rtxs) co
 
 -- | Generate a new sequences of transactions, either using the corpus or with
 -- randomly created transactions
-randseq :: (MonadRandom m, MonadReader Env m, MonadState Campaign m)
-        => MetadataCache -> Int -> Map Addr Contract -> World -> m [Tx]
+randseq
+  :: (MonadRandom m, MonadReader Env m, MonadState Campaign m)
+  => MetadataCache
+  -> Int
+  -> Map Addr Contract
+  -> World
+  -> m [Tx]
 randseq memo seqLen deployedContracts world = do
   camp <- get
   mutConsts <- asks (.cfg.campaignConf.mutConsts)
@@ -186,8 +209,13 @@ randseq memo seqLen deployedContracts world = do
 -- | Given an initial 'VM' and 'World' state and a number of calls to generate,
 -- generate that many calls, constantly checking if we've solved any tests or
 -- can shrink known solves. Update coverage as a result
-callseq :: (MonadIO m, MonadCatch m, MonadRandom m, MonadReader Env m, MonadState Campaign m)
-        => [[Tx]] -> VM -> World -> Int -> m ()
+callseq
+  :: (MonadIO m, MonadCatch m, MonadRandom m, MonadReader Env m, MonadState Campaign m)
+  => [[Tx]]
+  -> VM
+  -> World
+  -> Int
+  -> m ()
 callseq initialCorpus vm world seqLen = do
   conf <- asks (.cfg.campaignConf)
   -- First, we figure out whether we need to execute with or without coverage
@@ -247,8 +275,8 @@ callseq initialCorpus vm world seqLen = do
     }
   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.
+    -- 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
@@ -267,12 +295,13 @@ callseq initialCorpus vm world seqLen = do
 -- to generate calls with. Return the 'Campaign' state once we can't solve or shrink anything.
 campaign
   :: (MonadIO m, MonadCatch m, MonadRandom m, MonadReader Env m)
-  => StateT Campaign m Bool -- ^ Callback to run after each state update (for instrumentation)
-  -> VM                  -- ^ Initial VM state
-  -> World               -- ^ Initial world state
-  -> [EchidnaTest]       -- ^ Tests to evaluate
-  -> GenDict             -- ^ Generation dictionary
-  -> [[Tx]]              -- ^ Initial corpus of transactions
+  -- | Callback to run after each state update (for instrumentation)
+  => StateT Campaign m Bool
+  -> VM            -- ^ Initial VM state
+  -> World         -- ^ Initial world state
+  -> [EchidnaTest] -- ^ Tests to evaluate
+  -> GenDict       -- ^ Generation dictionary
+  -> [[Tx]]        -- ^ Initial corpus of transactions
   -> m Campaign
 campaign u vm world ts dict initialCorpus = do
   conf <- asks (.cfg.campaignConf)

lib/Echidna/Config.hs

@@ -1,7 +1,6 @@
 module Echidna.Config where
 
 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
@@ -145,11 +144,3 @@ defaultConfig = either (error "Config parser got messed up :(") id $ Y.decodeEit
 -- | Try to parse an Echidna config file, throw an error if we can't.
 parseConfig :: FilePath -> IO EConfigWithUsage
 parseConfig f = BS.readFile f >>= Y.decodeThrow
-
--- | Run some action with the default configuration, useful in the REPL.
-withDefaultConfig :: ReaderT EConfig m a -> m a
-withDefaultConfig = (`runReaderT` defaultConfig)
-
--- | 'withDefaultConfig' but not for transformers
-withDefaultConfig' :: Reader EConfig a -> a
-withDefaultConfig' = (`runReader` defaultConfig)

lib/Echidna/Deploy.hs

@@ -2,7 +2,8 @@ module Echidna.Deploy where
 
 import Control.Monad.Catch (MonadThrow(..), throwM)
 import Control.Monad.State.Strict (execStateT, MonadIO)
-import Data.ByteString (ByteString, pack, append)
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
 import Data.ByteString.Base16 qualified as BS16 (decode)
 import Data.Either (fromRight)
 import Data.Text (Text, unlines)
@@ -21,28 +22,41 @@ import Echidna.Types.Config (Env(..))
 
 deployContracts
   :: (MonadIO m, MonadReader Env m, MonadThrow m)
-  => [(Addr, SolcContract)] -> Addr -> VM -> m VM
+  => [(Addr, SolcContract)]
+  -> Addr
+  -> VM
+  -> m VM
 deployContracts cs = deployBytecodes' $ map (\(a, c) -> (a, c.creationCode)) cs
 
 deployBytecodes
   :: (MonadIO m, MonadReader Env m, MonadThrow m)
-  => [(Addr, Text)] -> Addr -> VM -> m VM
-deployBytecodes cs =
-  deployBytecodes' $ map (\(a, bc) -> (a, fromRight (error ("invalid b16 decoding of: " ++ show bc)) $ BS16.decode $ encodeUtf8 bc)) cs
+  => [(Addr, Text)]
+  -> Addr
+  -> VM
+  -> m VM
+deployBytecodes cs = deployBytecodes' $
+  (\(a, bc) ->
+    (a, fromRight (error ("invalid b16 decoding of: " ++ show bc)) $ BS16.decode $ encodeUtf8 bc)
+  ) <$> cs
 
 -- | Deploy a list of solidity contracts in certain addresses
 deployBytecodes'
   :: (MonadIO m, MonadReader Env m, MonadThrow m)
-  => [(Addr, ByteString)] -> Addr -> VM -> m VM
-deployBytecodes' []            _ vm = return vm
+  => [(Addr, ByteString)]
+  -> Addr
+  -> VM
+  -> m VM
+deployBytecodes' []           _ vm = pure vm
 deployBytecodes' ((a, bc):cs) d vm =
   deployBytecodes' cs d =<< loadRest
   where
-    zeros = pack $ replicate 320 0 -- This will initialize with zero a large number of possible constructor parameters
+    -- This will initialize with zero a large number of possible constructor parameters
+    zeros = BS.replicate 320 0
     loadRest = do
-      vm' <- execStateT (execTx $ createTx (bc `append` zeros) d a unlimitedGasPerBlock (0, 0)) vm
+      vm' <- flip execStateT vm $
+        execTx $ createTx (bc <> zeros) d a unlimitedGasPerBlock (0, 0)
       case vm'._result of
-        (Just (VMSuccess _)) -> return vm'
+        Just (VMSuccess _) -> pure vm'
         _ -> do
           di <- asks (.dapp)
           throwM $ DeploymentFailed a (Data.Text.unlines $ extractEvents True di vm')