hevm: allow mutations percentage to be set from the command line

src/hevm/hevm-cli/hevm-cli.hs

@@ -171,6 +171,7 @@ data Command w
       , debug         :: w ::: Bool                     <?> "Run interactively"
       , jsontrace     :: w ::: Bool                     <?> "Print json trace output at every step"
       , fuzzRuns      :: w ::: Maybe Int                <?> "Number of times to run fuzz tests"
+      , mutations     :: w ::: Maybe Int                <?> "Percentage of fuzz runs that should mutate a previous input vs randomly generating new inputs"
       , replay        :: w ::: Maybe (Text, ByteString) <?> "Custom fuzz case to run/debug"
       , rpc           :: w ::: Maybe URL                <?> "Fetch state from a remote node"
       , verbose       :: w ::: Maybe Int                <?> "Append call trace: {1} failures {2} all"
@@ -291,6 +292,11 @@ unitTestOptions cmd testFile = do
     , EVM.UnitTest.vmModifier = vmModifier
     , EVM.UnitTest.testParams = params
     , EVM.UnitTest.dapp = srcInfo
+    , EVM.UnitTest.mutations = case mutations cmd of
+                                 Nothing -> 50
+                                 Just x -> if x > 100
+                                              then error "Mutations cannot be greater than 100"
+                                              else x
     }
 
 main :: IO ()
@@ -757,7 +763,7 @@ vmFromCommand cmd = do
           , EVM.vmoptChainId       = word chainid 1
           , EVM.vmoptCreate        = create cmd
           , EVM.vmoptStorageModel  = ConcreteS
-          , EVM.vmoptTxAccessList  = mempty -- TODO: support me soon        
+          , EVM.vmoptTxAccessList  = mempty -- TODO: support me soon
           }
         word f def = fromMaybe def (f cmd)
         addr f def = fromMaybe def (f cmd)

src/hevm/src/EVM/Mutate.hs

@@ -18,14 +18,8 @@ import qualified Data.ListLike as LL
 
 -- | Given an 'AbiValue', generate a random \"similar\" value of the same 'AbiType'.
 mutateAbiValue :: AbiValue -> Gen AbiValue
-mutateAbiValue (AbiUInt n x)         = chooseInt (0, 9) >>= -- 10% of chance of mutation
-                                          \case
-                                            0 -> fixAbiUInt n <$> mutateNum x
-                                            _ -> return $ AbiUInt n x
-mutateAbiValue (AbiInt n x)          = chooseInt (0, 9) >>= -- 10% of chance of mutation
-                                          \case
-                                            0 -> fixAbiInt n <$> mutateNum x
-                                            _ -> return $ AbiInt n x
+mutateAbiValue (AbiUInt n x)         = frequency [(1, fixAbiUInt n <$> mutateNum x), (9, pure $ AbiUInt n x)]
+mutateAbiValue (AbiInt n x)         = frequency [(1, fixAbiInt n <$> mutateNum x), (9, pure $ AbiInt n x)]
 
 mutateAbiValue (AbiAddress x)        = return $ AbiAddress x
 mutateAbiValue (AbiBool _)           = genAbiValue AbiBoolType

src/hevm/src/EVM/UnitTest.hs

@@ -82,6 +82,7 @@ data UnitTestOptions = UnitTestOptions
   , vmModifier :: VM -> VM
   , dapp       :: DappInfo
   , testParams :: TestVMParams
+  , mutations  :: Int
   }
 
 data TestVMParams = TestVMParams
@@ -103,6 +104,7 @@ data TestVMParams = TestVMParams
   }
 
 type Corpus = Map (MultiSet OpLocation) (SolcContract, Text, AbiValue)
+data FuzzResult = Pass | Fail VM String
 
 defaultGasForCreating :: W256
 defaultGasForCreating = 0xffffffffffff
@@ -196,15 +198,12 @@ checkFailures UnitTestOptions { .. } method bailed = do
 
 -- | Either generates the calldata by mutating an example from the corpus, or synthesizes a random example
 genWithCorpus :: UnitTestOptions -> Corpus -> Text -> [AbiType] -> Gen AbiValue
-genWithCorpus _ corpus sig tps = do
-  b <- arbitrary :: Gen Bool
-  if b then genAbiValue (AbiTupleType $ Vector.fromList tps)
-       else do
-         -- TODO: also check that the contract matches here
-         let examples = [cd | (_, sig', cd) <- (fmap snd) . Map.toList $ corpus, sig' == sig]
-         case examples of
-           [] -> genAbiValue (AbiTupleType $ Vector.fromList tps)
-           _ -> Test.QuickCheck.elements examples >>= mutateAbiValue
+genWithCorpus UnitTestOptions { .. } corpus sig tps = do
+  -- TODO: also check that the contract matches here
+  let examples = [cd | (_, sig', cd) <- (fmap snd) . Map.toList $ corpus, sig' == sig]
+  if (null examples)
+     then genAbiValue (AbiTupleType $ Vector.fromList tps)
+     else frequency [(mutations, Test.QuickCheck.elements examples >>= mutateAbiValue), (100 - mutations, genAbiValue (AbiTupleType $ Vector.fromList tps))]
 
 -- | Randomly generates the calldata arguments and runs the test, updates the corpus with a new example if we explored a new path
 fuzzTest :: UnitTestOptions -> Text -> [AbiType] -> VM -> StateT Corpus IO FuzzResult
@@ -482,8 +481,6 @@ runOne opts@UnitTestOptions{..} vm testName args = do
           , vm''
           )
 
-data FuzzResult = Pass | Fail VM String
-
 -- | Define the thread spawner for property based tests
 fuzzRun :: UnitTestOptions -> VM -> Text -> [AbiType] -> IO (Text, Either Text Text, VM)
 fuzzRun opts@UnitTestOptions{..} vm testName types = do