Refactor and simplify code to not use Data.Has

lib/Echidna.hs

@@ -1,15 +1,12 @@
 module Echidna where
 
-import Control.Lens (view, (^.), to)
-import Data.Has (Has(..))
-import Control.Monad.Catch (MonadCatch(..), MonadThrow(..))
-import Control.Monad.Reader (MonadReader, MonadIO, liftIO)
+import Control.Monad.Catch (MonadThrow(..))
 import Data.HashMap.Strict (toList)
 import Data.Map.Strict (keys)
 import Data.List (nub, find)
 import Data.List.NonEmpty qualified as NE
 
-import EVM (env, contracts, VM)
+import EVM
 import EVM.ABI (AbiValue(AbiAddress))
 import EVM.Solidity (SourceCache, SolcContract)
 
@@ -39,42 +36,42 @@ import Echidna.RPC (loadEtheno, extractFromEtheno)
 -- * A list of Echidna tests to check
 -- * A prepopulated dictionary (if any)
 -- * A list of transaction sequences to initialize the corpus
-prepareContract :: (MonadCatch m, MonadReader x m, MonadIO m, MonadFail m, Has SolConf x)
-                => EConfig -> NE.NonEmpty FilePath -> Maybe ContractName -> Seed
-                -> m (VM, SourceCache, [SolcContract], World, [EchidnaTest], Maybe GenDict, [[Tx]])
+prepareContract :: EConfig -> NE.NonEmpty FilePath -> Maybe ContractName -> Seed
+                -> IO (VM, SourceCache, [SolcContract], World, [EchidnaTest], Maybe GenDict, [[Tx]])
 prepareContract cfg fs c g = do
-  ctxs1 <- liftIO $ loadTxs (fmap (++ "/reproducers/") cd)
-  ctxs2 <- liftIO $ loadTxs (fmap (++ "/coverage/") cd)
+  ctxs1 <- loadTxs (fmap (++ "/reproducers/") cd)
+  ctxs2 <- loadTxs (fmap (++ "/coverage/") cd)
   let ctxs = ctxs1 ++ ctxs2
 
+  let solConf = cfg._sConf
+
   -- compile and load contracts
-  (cs, scs) <- Echidna.Solidity.contracts fs
-  p <- loadSpecified c cs
+  (cs, scs) <- Echidna.Solidity.contracts solConf fs
+  p <- loadSpecified solConf c cs
 
   -- run processors
-  ca <- view (hasLens . cryticArgs)
-  si <- runSlither (NE.head fs) ca
+  si <- runSlither (NE.head fs) solConf._cryticArgs
   case find (< minSupportedSolcVersion) $ solcVersions si of
     Just outdatedVersion -> throwM $ OutdatedSolcVersion outdatedVersion
     Nothing -> return ()
 
   -- load tests
-  (v, w, ts) <- prepareForTest p c si
+  let (v, w, ts) = prepareForTest solConf p c si
 
   -- get signatures
-  let sigs = nub $ concatMap (NE.toList . snd) (toList $ w ^. highSignatureMap)
+  let sigs = nub $ concatMap (NE.toList . snd) (toList $ w._highSignatureMap)
 
-  ads <- addresses
-  let ads' = AbiAddress <$> v ^. env . EVM.contracts . to keys
+  let ads = addresses solConf
+  let ads' = AbiAddress <$> keys v._env._contracts
   let constants' = enhanceConstants si ++ timeConstants ++ extremeConstants ++ NE.toList ads ++ ads'
 
   -- load transactions from init sequence (if any)
-  es' <- liftIO $ maybe (return []) loadEtheno it
+  es' <- maybe (return []) loadEtheno it
   let txs = ctxs ++ maybe [] (const [extractFromEtheno es' sigs]) it
 
   -- start ui and run tests
   let sc = selectSourceCache c scs
-  return (v, sc, cs, w, ts, Just $ mkGenDict df constants' [] g (returnTypes cs), txs)
-  where cd = cfg ^. cConf . corpusDir
-        df = cfg ^. cConf . dictFreq
-        it = cfg ^. sConf . initialize
+  pure (v, sc, cs, w, ts, Just $ mkGenDict df constants' [] g (returnTypes cs), txs)
+  where cd = cfg._cConf._corpusDir
+        df = cfg._cConf._dictFreq
+        it = cfg._sConf._initialize

lib/Echidna/Config.hs

@@ -5,14 +5,13 @@ import Control.Monad.Catch (MonadThrow)
 import Control.Monad.Fail qualified as M (MonadFail(..))
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Reader (Reader, ReaderT(..), runReader)
-import Control.Monad.State (StateT(..), runStateT)
+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.List.NonEmpty qualified as NE
-import Data.Has (Has(..))
 import Data.HashSet (fromList, insert, difference)
 import Data.Maybe (fromMaybe)
 import Data.Text (isPrefixOf)
@@ -23,16 +22,14 @@ import EVM (result)
 import Echidna.Test
 import Echidna.Types.Campaign
 import Echidna.Mutator.Corpus (defaultMutationConsts)
-import Echidna.Types.Config (EConfigWithUsage(..), EConfig(..))
 import Echidna.Types.Solidity
 import Echidna.Types.Tx (TxConf(TxConf), maxGasPerBlock, defaultTimeDelay, defaultBlockDelay)
 import Echidna.Types.Test (TestConf(..))
-import Echidna.UI
-import Echidna.UI.Report
+import Echidna.Types.Config
 
 instance FromJSON EConfig where
   -- retrieve the config from the key usage annotated parse
-  parseJSON = fmap _econfig . parseJSON
+  parseJSON = fmap econfig . parseJSON
 
 instance FromJSON EConfigWithUsage where
   -- this runs the parser in a StateT monad which keeps track of the keys
@@ -53,7 +50,7 @@ instance FromJSON EConfigWithUsage where
     -- x .!= v (Parser) <==> x ..!= v (StateT)
     -- tl;dr use an extra initial . to lift into the StateT parser
     where parser v =
-            let useKey k = hasLens %= insert k
+            let useKey k = modify' $ insert k
                 x ..:? k = useKey k >> lift (x .:? k)
                 x ..!= y = fromMaybe y <$> x
                 getWord s d = fromIntegral <$> v ..:? s ..!= (d :: Integer)

lib/Echidna/Exec.hs

@@ -5,9 +5,8 @@
 module Echidna.Exec where
 
 import Control.Lens
-import Control.Monad.Catch (Exception, MonadThrow(..))
-import Control.Monad.State.Strict (MonadState, execState, execState)
-import Data.Has (Has(..))
+import Control.Monad.Catch (MonadThrow(..))
+import Control.Monad.State.Strict (MonadState (get, put), execState, execState)
 import Data.Map qualified as M
 import Data.Maybe (fromMaybe)
 import Data.Set qualified as S
@@ -20,9 +19,11 @@ import EVM.Types (Expr(ConcreteBuf, Lit))
 import Echidna.Events (emptyEvents)
 import Echidna.Transaction
 import Echidna.Types.Buffer (viewBuffer)
+import Echidna.Types.Campaign
 import Echidna.Types.Coverage (CoverageMap)
 import Echidna.Types.Signature (BytecodeMemo, lookupBytecodeMetadata)
 import Echidna.Types.Tx (TxCall(..), Tx, TxResult(..), call, dst, initialTimestamp, initialBlockNumber)
+import Echidna.Types (ExecException(..))
 
 -- | Broad categories of execution failures: reversions, illegal operations, and ???.
 data ErrorClass = RevertE | IllegalE | UnknownE
@@ -54,109 +55,99 @@ pattern Reversion <- VMFailure (classifyError -> RevertE)
 pattern Illegal :: VMResult
 pattern Illegal <- VMFailure (classifyError -> IllegalE)
 
--- | We throw this when our execution fails due to something other than reversion.
-data ExecException = IllegalExec Error | UnknownFailure Error
-
-instance Show ExecException where
-  show (IllegalExec e) = "VM attempted an illegal operation: " ++ show e
-  show (UnknownFailure e) = "VM failed for unhandled reason, " ++ show e
-    ++ ". This shouldn't happen. Please file a ticket with this error message and steps to reproduce!"
-
-instance Exception ExecException
-
 -- | 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}
 
 -- | 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 :: (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 (ConcreteBuf "")), 0)
+execTxWith :: MonadState s m => Lens' s VM -> (Error -> m ()) -> m VMResult -> Tx -> m (VMResult, Int)
+execTxWith l onErr executeTx tx' = do
+  vm <- use l
+  if hasSelfdestructed vm (tx'^. dst) then
+    pure (VMFailure (Revert (ConcreteBuf "")), 0)
   else do
-    hasLens . traces .= emptyEvents
-    vmBeforeTx <- use hasLens
-    setupTx tx'
-    gasLeftBeforeTx <- use $ hasLens . state . gas
+    l . traces .= emptyEvents
+    vmBeforeTx <- use l
+    l %= execState (setupTx tx')
+    gasLeftBeforeTx <- use $ l . state . gas
     vmResult' <- executeTx
-    gasLeftAfterTx <- use $ hasLens . state . gas
-    checkAndHandleQuery vmBeforeTx vmResult' onErr executeTx tx' gasLeftBeforeTx gasLeftAfterTx
+    gasLeftAfterTx <- use $ l . state . gas
+    checkAndHandleQuery l vmBeforeTx vmResult' onErr executeTx tx' gasLeftBeforeTx gasLeftAfterTx
 
-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 =
+checkAndHandleQuery :: MonadState s m => Lens' s VM -> VM -> VMResult -> (Error -> m ()) -> m VMResult -> Tx -> Word64 -> Word64 -> m (VMResult, Int)
+checkAndHandleQuery l vmBeforeTx vmResult' onErr executeTx tx' gasLeftBeforeTx gasLeftAfterTx =
         -- Continue transaction whose execution queried a contract or slot
     let continueAfterQuery = do
           -- Run remaining effects
           vmResult'' <- executeTx
           -- Correct gas usage
-          gasLeftAfterTx' <- use $ hasLens . state . gas
-          checkAndHandleQuery vmBeforeTx vmResult'' onErr executeTx tx' gasLeftBeforeTx gasLeftAfterTx'
+          gasLeftAfterTx' <- use $ l . state . gas
+          checkAndHandleQuery l vmBeforeTx vmResult'' onErr executeTx tx' gasLeftBeforeTx gasLeftAfterTx'
 
     in case getQuery vmResult' of
       -- A previously unknown contract is required
       Just (PleaseFetchContract _ continuation) -> do
         -- Use the empty contract
-        hasLens %= execState (continuation emptyAccount)
+        l %= execState (continuation emptyAccount)
         continueAfterQuery
 
       -- A previously unknown slot is required
       Just (PleaseFetchSlot _ _ continuation) -> do
         -- Use the zero slot
-        hasLens %= execState (continuation 0)
+        l %= execState (continuation 0)
         continueAfterQuery
 
       -- No queries to answer
       _ -> do
-        handleErrorsAndConstruction onErr vmResult' vmBeforeTx tx'
+        handleErrorsAndConstruction l onErr vmResult' vmBeforeTx tx'
         return (vmResult', fromIntegral $ gasLeftBeforeTx - gasLeftAfterTx)
 
 -- | Handles reverts, failures and contract creations that might be the result
 -- (`vmResult`) of executing transaction `tx`.
-handleErrorsAndConstruction :: (MonadState s m, Has VM s)
-                            => (Error -> m ())
+handleErrorsAndConstruction :: MonadState s m
+                            => Lens' s VM
+                            -> (Error -> m ())
                             -> VMResult
                             -> VM
                             -> Tx
                             -> m ()
-handleErrorsAndConstruction onErr vmResult' vmBeforeTx tx' = case (vmResult', tx' ^. call) of
+handleErrorsAndConstruction l onErr vmResult' vmBeforeTx tx' = case (vmResult', tx' ^. call) of
   (Reversion, _) -> do
-    tracesBeforeVMReset <- use $ hasLens . traces
-    codeContractBeforeVMReset <- use $ hasLens . state . codeContract
-    calldataBeforeVMReset <- use $ hasLens . state . calldata
-    callvalueBeforeVMReset <- use $ hasLens . state . callvalue
+    tracesBeforeVMReset <- use $ l . traces
+    codeContractBeforeVMReset <- use $ l . state . codeContract
+    calldataBeforeVMReset <- use $ l . state . calldata
+    callvalueBeforeVMReset <- use $ l . state . callvalue
     -- If a transaction reverts reset VM to state before the transaction.
-    hasLens .= vmBeforeTx
+    l .= vmBeforeTx
     -- Undo reset of some of the VM state.
     -- Otherwise we'd loose all information about the reverted transaction like
     -- contract address, calldata, result and traces.
-    hasLens . result ?= vmResult'
-    hasLens . state . calldata .= calldataBeforeVMReset
-    hasLens . state . callvalue .= callvalueBeforeVMReset
-    hasLens . traces .= tracesBeforeVMReset
-    hasLens . state . codeContract .= codeContractBeforeVMReset
+    l . result ?= vmResult'
+    l . state . calldata .= calldataBeforeVMReset
+    l . state . callvalue .= callvalueBeforeVMReset
+    l . traces .= tracesBeforeVMReset
+    l . state . codeContract .= codeContractBeforeVMReset
   (VMFailure x, _) -> onErr x
   (VMSuccess (ConcreteBuf bytecode'), SolCreate _) ->
     -- Handle contract creation.
-    hasLens %= execState (do
+    l %= execState (do
       env . contracts . at (tx' ^. dst) . _Just . contractcode .= InitCode mempty mempty
       replaceCodeOfSelf (RuntimeCode (ConcreteRuntimeCode bytecode'))
       loadContract (tx' ^. dst))
   _ -> pure ()
 
 -- | Execute a transaction "as normal".
-execTx :: (MonadState x m, Has VM x, MonadThrow m) => Tx -> m (VMResult, Int)
-execTx = execTxWith vmExcept $ liftSH exec
+execTx :: (MonadState VM m, MonadThrow m) => Tx -> m (VMResult, Int)
+execTx = execTxWith id vmExcept $ fromEVM exec
 
 -- | Execute a transaction, logging coverage at every step.
-execTxWithCov :: (MonadState x m, Has VM x) => BytecodeMemo -> Lens' x CoverageMap -> m VMResult
-execTxWithCov memo l = do
-  vm :: VM          <- use hasLens
-  cm :: CoverageMap <- use l
-  let (r, vm', cm') = loop vm cm
-  hasLens .= vm'
-  l       .= cm'
-  return r
+execTxWithCov :: MonadState (VM, Campaign) m => BytecodeMemo -> m VMResult
+execTxWithCov memo = do
+  (vm, camp) <- get
+  let (r, vm', cm') = loop vm camp._coverage
+  put (vm', camp { _coverage = cm' })
+  pure r
   where
     -- | Repeatedly exec a step and add coverage until we have an end result
     loop :: VM -> CoverageMap -> (VMResult, VM, CoverageMap)

lib/Echidna/Mutator/Corpus.hs

@@ -5,10 +5,10 @@ import Data.Set qualified as DS
 
 import Echidna.Mutator.Array
 import Echidna.Transaction (mutateTx, shrinkTx)
+import Echidna.Types (MutationConsts)
 import Echidna.Types.Tx (Tx)
 import Echidna.Types.Corpus
 
-type MutationConsts a = (a, a, a, a)
 defaultMutationConsts :: Num a => MutationConsts a
 defaultMutationConsts = (1, 1, 1, 1)
 
@@ -40,7 +40,7 @@ mutator Deletion = deleteRandList
 selectAndMutate :: MonadRandom m
                 => ([Tx] -> m [Tx]) -> Corpus -> m [Tx]
 selectAndMutate f ctxs = do
-  rtxs <- weighted $ map (\(i, txs) -> (txs, fromInteger i)) $ DS.toDescList ctxs
+  rtxs <- weighted $ map (\(i, txs) -> (txs, fromIntegral i)) $ DS.toDescList ctxs
   k <- getRandomR (0, length rtxs - 1)
   f $ take k rtxs
 
@@ -51,7 +51,7 @@ selectAndCombine f ql ctxs gtxs = do
   rtxs2 <- selectFromCorpus
   txs <- f rtxs1 rtxs2
   return . take ql $ txs ++ gtxs
-    where selectFromCorpus = weighted $ map (\(i, txs) -> (txs, fromInteger i)) $ DS.toDescList ctxs
+    where selectFromCorpus = weighted $ map (\(i, txs) -> (txs, fromIntegral i)) $ DS.toDescList ctxs
 
 getCorpusMutation :: MonadRandom m
                   => CorpusMutation -> (Int -> Corpus -> [Tx] -> m [Tx])

lib/Echidna/RPC.hs

@@ -154,7 +154,7 @@ execEthenoTxs et = do
        (VMSuccess (ConcreteBuf bc),
         ContractCreated _ ca _ _ _ _) -> do
           env . contracts . at ca . _Just . contractcode .= InitCode mempty mempty
-          liftSH (replaceCodeOfSelf (RuntimeCode (ConcreteRuntimeCode bc)) >> loadContract ca)
+          fromEVM (replaceCodeOfSelf (RuntimeCode (ConcreteRuntimeCode bc)) >> loadContract ca)
           return ()
        _                              -> return ()
 

lib/Echidna/Shrink.hs

@@ -4,25 +4,24 @@ import Control.Lens
 import Control.Monad ((<=<))
 import Control.Monad.Catch (MonadThrow)
 import Control.Monad.Random.Strict (MonadRandom, getRandomR, uniform, uniformMay)
-import Control.Monad.Reader.Class (MonadReader)
+import Control.Monad.Reader.Class (MonadReader, asks)
 import Control.Monad.State.Strict (MonadState(get, put))
 import Data.Foldable (traverse_)
-import Data.Has (Has(..))
 import Data.Maybe (fromMaybe)
 
 import EVM (VM)
 
 import Echidna.Exec
 import Echidna.Transaction
 import Echidna.Events (Events)
-import Echidna.Types.Solidity (SolConf(..), sender)
+import Echidna.Types.Solidity (SolConf(..))
 import Echidna.Types.Test (TestValue(..))
 import Echidna.Types.Tx (Tx, TxResult, src)
+import Echidna.Types.Config
 
 -- | Given a call sequence that solves some Echidna test, try to randomly generate a smaller one that
 -- still solves that test.
-shrinkSeq :: ( MonadRandom m, MonadReader x m, MonadThrow m
-             , Has SolConf x, MonadState y m, Has VM y)
+shrinkSeq :: (MonadRandom m, MonadReader Env m, MonadThrow m, MonadState VM m)
           => m (TestValue, Events, TxResult) -> (TestValue, Events, TxResult) -> [Tx] -> m ([Tx], TestValue, Events, TxResult)
 shrinkSeq f (v,es,r) xs = do
   strategies <- sequence [shorten, shrunk]
@@ -41,7 +40,7 @@ shrinkSeq f (v,es,r) xs = do
       put og
       pure res
     shrinkSender x = do
-      l <- view (hasLens . sender)
+      l <- asks (.cfg._sConf._sender)
       case ifind (const (== x ^. src)) l of
         Nothing     -> pure x
         Just (i, _) -> flip (set src) x . fromMaybe (x ^. src) <$> uniformMay (l ^.. folded . indices (< i))