Remove lens for Campaign (#995)

lib/Echidna/Campaign.hs

@@ -5,11 +5,11 @@
 module Echidna.Campaign where
 
 import Control.Lens
-import Control.Monad (replicateM, when, unless)
+import Control.Monad (replicateM, when)
 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)
+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)
@@ -19,7 +19,6 @@ import Data.IORef (readIORef, writeIORef)
 import Data.Map qualified as Map
 import Data.Map (Map, (\\))
 import Data.Maybe (fromMaybe, isJust, mapMaybe)
-import Data.Ord (comparing)
 import Data.Set qualified as Set
 import Data.Text (Text)
 import System.Random (mkStdGen)
@@ -45,6 +44,7 @@ import Echidna.Types.Signature (makeBytecodeCache, MetadataCache)
 import Echidna.Types.Test
 import Echidna.Types.Tx (TxCall(..), Tx(..), getResult, call)
 import Echidna.Types.World (World)
+import Echidna.Types.Corpus (Corpus)
 
 instance MonadThrow m => MonadThrow (RandT g m) where
   throwM = lift . throwM
@@ -54,26 +54,26 @@ instance MonadCatch m => MonadCatch (RandT g m) where
 -- | Given a 'Campaign', checks if we can attempt any solves or shrinks without exceeding
 -- the limits defined in our 'CampaignConf'.
 isDone :: MonadReader EConfig m => Campaign -> m Bool
-isDone c | null c._tests = do
+isDone c | null c.tests = do
   conf <- asks (.campaignConf)
-  pure $ c._ncallseqs * conf.seqLen >= conf.testLimit
+  pure $ c.ncallseqs * conf.seqLen >= conf.testLimit
 isDone c = do
   conf <- asks (.campaignConf)
   let res (Open  i)   = if i >= conf.testLimit then Just True else Nothing
       res Passed      = Just True
       res (Large i)   = if i >= conf.shrinkLimit then Just False else Nothing
       res Solved      = Just False
       res (Failed _)  = Just False
-  let testResults = res . (.state) <$> c._tests
+  let testResults = res . (.state) <$> c.tests
   let 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
 -- success or a failure.
 isSuccessful :: Campaign -> Bool
-isSuccessful Campaign{_tests} =
-  all (\case { Passed -> True; Open _ -> True; _ -> False; }) ((.state) <$> _tests)
+isSuccessful Campaign{tests} =
+  all (\case { Passed -> True; Open _ -> True; _ -> False; }) ((.state) <$> tests)
 
 -- | Given an initial 'VM' state and a @('SolTest', 'TestState')@ pair, as well as possibly a sequence
 -- of transactions and the state after evaluation, see if:
@@ -105,7 +105,9 @@ updateTest vmForShrink (vm, xs) test = do
 -- | 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 f = let l = tests in use l >>= mapM f >>= (l .=)
+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.
@@ -139,26 +141,24 @@ updateGasInfo ((t, _):ts) tseq gi = updateGasInfo ts (t:tseq) gi
 execTxOptC :: (MonadIO m, MonadReader Env m, MonadState (VM, Campaign) m, MonadThrow m)
            => Tx -> m (VMResult, Gas)
 execTxOptC tx = do
-  (vm, Campaign{_coverage = oldCov}) <- get
-  let cov = _2 . coverage
-  ((res, newCov), vm') <- runStateT (execTxWithCov tx) vm
-  _1 .= vm'
+  (vm, camp@Campaign{coverage = oldCov}) <- get
+  ((res, txCov), vm') <- runStateT (execTxWithCov tx) vm
   let vmr = getResult $ fst res
-  -- Update the coverage map with the proper binary according to the vm result
-  cov .= Map.mapWithKey (\_ s -> Set.map (set _4 vmr) s) newCov
-  -- Update the global coverage map with the union of the result just obtained
-  cov %= Map.unionWith Set.union oldCov
-  grew <- (== LT) . comparing coveragePoints oldCov <$> use cov
-  when grew $ do
-    case tx.call of
-      SolCall c -> _2 . genDict %= gaddCalls (Set.singleton c)
-      _ -> pure ()
-    _2 . newCoverage .= True
-  return 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'
+  put (vm', camp { coverage = newCov })
+  when (coveragePoints oldCov < coveragePoints newCov) $ do
+    let dict' = case tx.call of
+          SolCall c -> gaddCalls (Set.singleton c) camp.genDict
+          _ -> camp.genDict
+    modify' $ \(_vm, c) -> (_vm, c { newCoverage = True, genDict = dict' })
+  pure res
 
 -- | Given a list of transactions in the corpus, save them discarding reverted transactions
-addToCorpus :: MonadState Campaign m => Int -> [(Tx, (VMResult, Gas))] -> m ()
-addToCorpus n res = unless (null rtxs) $ corpus %= Set.insert (n, rtxs)
+addToCorpus :: Int -> [(Tx, (VMResult, Gas))] -> Corpus -> Corpus
+addToCorpus n res corpus = if null rtxs then corpus else Set.insert (n, rtxs) corpus
   where rtxs = fst <$> res
 
 -- | Generate a new sequences of transactions, either using the corpus or with
@@ -178,9 +178,9 @@ randseq memo seqLen deployedContracts world = do
                          else seqMutatorsStateful (fromConsts mutConsts)
   -- Fetch the mutator
   let mut = getCorpusMutation cmut
-  if null camp._corpus
+  if null camp.corpus
     then pure randTxs -- Use the generated random transactions
-    else mut seqLen camp._corpus randTxs -- Apply the mutator
+    else mut seqLen camp.corpus randTxs -- Apply the mutator
 
 -- | 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
@@ -199,40 +199,49 @@ callseq initialCorpus vm world seqLen = do
                              put (vm', ca)
                              pure r
   -- Then, we get the current campaign state
-  ca <- get
+  camp <- get
   -- Then, we generate the actual transaction in the sequence
   metaCacheRef <- asks (.metadataCache)
   metaCache <- liftIO $ readIORef metaCacheRef
-  txSeq <-
-    -- Replay transactions in the corpus during the first iterations
-    if length initialCorpus > ca._ncallseqs
-      then pure $ initialCorpus !! ca._ncallseqs
-      else randseq metaCache seqLen vm._env._contracts world
+  -- 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
+
   -- 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, ca)
-  let -- compute the addresses not present in the old VM via set difference
-      diff = 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 <$> diff)]
-  -- Save the global campaign state (also vm state, but that gets reset before it's used)
-  put camp -- Update the gas estimation
-  when conf.estimateGas $ gasInfo %= updateGasInfo res []
-  -- If there is new coverage, add the transaction list to the corpus
-  when camp._newCoverage $ addToCorpus (camp._ncallseqs + 1) res
-  -- Reset the new coverage flag
-  newCoverage .= False
-  -- Keep track of the number of calls to `callseq`
-  ncallseqs += 1
-  -- Now we try to parse the return values as solidity constants, and add then to the 'GenDict'
-  types <- gets (._genDict.rTypes)
-  let results = parse (map (\(t, (vr, _)) -> (t, vr)) res) types
-      -- union the return results with the new addresses
-      additions = H.unionWith Set.union diffs results
-  -- append to the constants dictionary
-  let dict = camp._genDict
-  genDict .= dict
-    { constants = H.unionWith Set.union additions dict.constants
-    , dictValues = Set.union (mkDictValues $ Set.unions $ H.elems additions) dict.dictValues
+  (res, (vm', camp')) <- runStateT (evalSeq vm ef 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)]
+    -- 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
+    -- union the return results with the new addresses
+    additions = H.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)
+                               camp.genDict.dictValues
+      }
+
+  -- Update the campaign state
+  put camp'
+    { genDict = updatedDict
+      -- Update the gas estimation
+    , gasInfo = if conf.estimateGas
+                   then updateGasInfo res [] camp.gasInfo
+                   else camp.gasInfo
+      -- If there is new coverage, add the transaction list to the corpus
+    , corpus = if camp'.newCoverage
+                  then addToCorpus (camp.ncallseqs + 1) res camp.corpus
+                  else camp.corpus
+      -- Reset the new coverage flag
+    , newCoverage = False
+      -- Keep track of the number of calls to `callseq`
+    , ncallseqs = camp.ncallseqs + 1
     }
   where
     -- Given a list of transactions and a return typing rule, this checks whether we know the return
@@ -278,17 +287,17 @@ campaign u vm world ts dict initialCorpus = do
   execStateT (evalRandT (lift u >> runCampaign) (mkStdGen effectiveSeed)) camp
   where
     memo = makeBytecodeCache . map (forceBuf . (^. bytecode)) . Map.elems
-    runCampaign = gets (fmap (.state) . (._tests)) >>= update
-    update c = do
+    runCampaign = do
+      testStates <- gets (fmap (.state) . (.tests))
       CampaignConf{testLimit, stopOnFail, seqLen, shrinkLimit} <- asks (.cfg.campaignConf)
-      Campaign{_ncallseqs} <- get
-      if | stopOnFail && any (\case Solved -> True; Failed _ -> True; _ -> False) c ->
+      Campaign{ncallseqs} <- get
+      if | stopOnFail && any (\case Solved -> True; Failed _ -> True; _ -> False) testStates ->
            lift u
-         | any (\case Open  n   -> n <= testLimit; _ -> False) c ->
+         | any (\case Open n -> n <= testLimit; _ -> False) testStates ->
            callseq initialCorpus vm world seqLen >> step
-         | any (\case Large n   -> n < shrinkLimit; _ -> False) c ->
+         | any (\case Large n -> n < shrinkLimit; _ -> False) testStates ->
            step
-         | null c && (seqLen * _ncallseqs) <= testLimit ->
+         | null testStates && (seqLen * ncallseqs) <= testLimit ->
            callseq initialCorpus vm world seqLen >> step
          | otherwise ->
            lift u

lib/Echidna/Output/JSON.hs

@@ -97,10 +97,10 @@ encodeCampaign :: C.Campaign -> ByteString
 encodeCampaign C.Campaign{..} = encode
   Campaign { _success = True
            , _error = Nothing
-           , _tests = mapTest <$> _tests
-           , seed = _genDict.defSeed
-           , coverage = mapKeys (("0x" ++) . (`showHex` "") . keccak') $ DF.toList <$>_coverage
-           , gasInfo = toList _gasInfo
+           , _tests = mapTest <$> tests
+           , seed = genDict.defSeed
+           , coverage = mapKeys (("0x" ++) . (`showHex` "") . keccak') $ DF.toList <$> coverage
+           , gasInfo = toList gasInfo
            }
 
 mapTest :: EchidnaTest -> Test

lib/Echidna/Transaction.hs

@@ -48,7 +48,7 @@ genTx :: (MonadRandom m, MonadState Campaign m)
   -> Map Addr Contract
   -> m Tx
 genTx memo world txConf deployedContracts = do
-  genDict <- gets (._genDict)
+  genDict <- gets (.genDict)
   sigMap <- getSignatures world.highSignatureMap world.lowSignatureMap
   sender <- rElem' world.senders
   (dstAddr, dstAbis) <- rElem' $ Set.fromList $

lib/Echidna/Types/Campaign.hs

@@ -1,8 +1,5 @@
-{-# LANGUAGE TemplateHaskell #-}
-
 module Echidna.Types.Campaign where
 
-import Control.Lens
 import Data.Map (Map)
 import Data.Text (Text)
 
@@ -39,22 +36,22 @@ data CampaignConf = CampaignConf
   }
 
 -- | The state of a fuzzing campaign.
-data Campaign = Campaign { _tests       :: [EchidnaTest]
-                           -- ^ Tests being evaluated
-                         , _coverage    :: CoverageMap
-                           -- ^ Coverage captured (NOTE: we don't always record this)
-                         , _gasInfo     :: Map Text (Gas, [Tx])
-                           -- ^ Worst case gas (NOTE: we don't always record this)
-                         , _genDict     :: GenDict
-                           -- ^ Generation dictionary
-                         , _newCoverage :: Bool
-                           -- ^ Flag to indicate new coverage found
-                         , _corpus      :: Corpus
-                           -- ^ List of transactions with maximum coverage
-                         , _ncallseqs   :: Int
-                           -- ^ Number of times the callseq is called
-                         }
-makeLenses ''Campaign
+data Campaign = Campaign
+  { tests       :: [EchidnaTest]
+    -- ^ Tests being evaluated
+  , coverage    :: CoverageMap
+    -- ^ Coverage captured (NOTE: we don't always record this)
+  , gasInfo     :: Map Text (Gas, [Tx])
+    -- ^ Worst case gas (NOTE: we don't always record this)
+  , genDict     :: GenDict
+    -- ^ Generation dictionary
+  , newCoverage :: Bool
+    -- ^ Flag to indicate new coverage found
+  , corpus      :: Corpus
+    -- ^ List of transactions with maximum coverage
+  , ncallseqs   :: Int
+    -- ^ Number of times the callseq is called
+  }
 
 defaultCampaign :: Campaign
 defaultCampaign = Campaign mempty mempty mempty defaultDict False mempty 0

lib/Echidna/UI.hs

@@ -213,12 +213,12 @@ isTerminal = (&&) <$> queryTerminal (Fd 0) <*> queryTerminal (Fd 1)
 -- | Composes a compact text status line of the campaign
 statusLine :: CampaignConf -> Campaign -> String
 statusLine campaignConf camp =
-  "tests: " <> show (length $ filter didFail camp._tests) <> "/" <> show (length camp._tests)
+  "tests: " <> show (length $ filter didFail camp.tests) <> "/" <> show (length camp.tests)
   <> ", fuzzing: " <> show fuzzRuns <> "/" <> show campaignConf.testLimit
-  <> ", cov: " <> show (scoveragePoints camp._coverage)
-  <> ", corpus: " <> show (corpusSize camp._corpus)
+  <> ", cov: " <> show (scoveragePoints camp.coverage)
+  <> ", corpus: " <> show (corpusSize camp.corpus)
   where
-  fuzzRuns = case filter isOpen camp._tests of
+  fuzzRuns = case filter isOpen camp.tests of
     -- fuzzing progress is the same for all Open tests, grab the first one
     EchidnaTest { state = Open t }:_ -> t
     _ -> campaignConf.testLimit

lib/Echidna/UI/Report.hs

@@ -24,9 +24,9 @@ ppCampaign :: MonadReader EConfig m => Campaign -> m String
 ppCampaign campaign = do
   testsPrinted <- ppTests campaign
   gasInfoPrinted <- ppGasInfo campaign
-  let coveragePrinted = ppCoverage campaign._coverage
-      corpusPrinted = "\n" <> ppCorpus campaign._corpus
-      seedPrinted = "\nSeed: " <> show campaign._genDict.defSeed
+  let coveragePrinted = ppCoverage campaign.coverage
+      corpusPrinted = "\n" <> ppCorpus campaign.corpus
+      seedPrinted = "\nSeed: " <> show campaign.genDict.defSeed
   pure $
     testsPrinted
     <> gasInfoPrinted
@@ -65,9 +65,9 @@ ppCorpus c = "Corpus size: " <> show (corpusSize c)
 
 -- | Pretty-print the gas usage information a 'Campaign' has obtained.
 ppGasInfo :: MonadReader EConfig m => Campaign -> m String
-ppGasInfo Campaign { _gasInfo } | _gasInfo == mempty = pure ""
-ppGasInfo Campaign { _gasInfo } = do
-  items <- mapM ppGasOne $ sortOn (\(_, (n, _)) -> n) $ toList _gasInfo
+ppGasInfo Campaign { gasInfo } | gasInfo == mempty = pure ""
+ppGasInfo Campaign { gasInfo } = do
+  items <- mapM ppGasOne $ sortOn (\(_, (n, _)) -> n) $ toList gasInfo
   pure $ intercalate "" items
 
 -- | Pretty-print the gas usage for a function.
@@ -131,7 +131,7 @@ ppOptimized b es xs = do
 
 -- | Pretty-print the status of all 'SolTest's in a 'Campaign'.
 ppTests :: MonadReader EConfig m => Campaign -> m String
-ppTests Campaign { _tests = ts } = unlines . catMaybes <$> mapM pp ts
+ppTests Campaign { tests } = unlines . catMaybes <$> mapM pp tests
   where
   pp t =
     case t.testType of

lib/Echidna/UI/Widgets.hs

@@ -78,13 +78,13 @@ campaignStatus uiState = do
       pure $ mainbox (padLeft (Pad 1) $
         withAttr (attrName "failure") $ strBreak $ formatCrashReport e) emptyWidget
     (Timedout, _) ->
-      mainbox <$> testsWidget uiState.campaign._tests
+      mainbox <$> testsWidget uiState.campaign.tests
               <*> pure (finalStatus "Timed out, C-c or esc to exit")
     (_, True) ->
-      mainbox <$> testsWidget uiState.campaign._tests
+      mainbox <$> testsWidget uiState.campaign.tests
               <*> pure (finalStatus "Campaign complete, C-c or esc to exit")
     _ ->
-      mainbox <$> testsWidget uiState.campaign._tests
+      mainbox <$> testsWidget uiState.campaign.tests
               <*> pure emptyWidget
   where
     mainbox :: Widget Name -> Widget Name -> Widget Name
@@ -116,13 +116,13 @@ summaryWidget uiState =
   leftSide =
     let c = uiState.campaign in
     padLeft (Pad 1) $
-      vLimit 1 (str "Tests found: " <+> str (show (length c._tests)) <+> fill ' ')
+      vLimit 1 (str "Tests found: " <+> str (show (length c.tests)) <+> fill ' ')
       <=>
-      str ("Seed: " ++ show c._genDict.defSeed)
+      str ("Seed: " ++ show c.genDict.defSeed)
       <=>
-      str (ppCoverage c._coverage)
+      str (ppCoverage c.coverage)
       <=>
-      str (ppCorpus c._corpus)
+      str (ppCorpus c.corpus)
   rightSide = fetchCacheWidget uiState.fetchedContracts uiState.fetchedSlots
 
 fetchCacheWidget