From 386489aa6a944ee7a36aac93bde91cf2fb3db702 Mon Sep 17 00:00:00 2001 From: Artur Cygan Date: Sat, 18 Feb 2023 01:37:14 +0100 Subject: [PATCH] GenDict without lens --- lib/Echidna/ABI.hs | 40 ++++++++++++++++++-------------------- lib/Echidna/Campaign.hs | 13 ++++++++----- lib/Echidna/Output/JSON.hs | 2 +- lib/Echidna/Transaction.hs | 2 +- lib/Echidna/UI/Report.hs | 2 +- lib/Echidna/UI/Widgets.hs | 2 +- 6 files changed, 31 insertions(+), 30 deletions(-) diff --git a/lib/Echidna/ABI.hs b/lib/Echidna/ABI.hs index d57f9b9ec..f22463d1f 100644 --- a/lib/Echidna/ABI.hs +++ b/lib/Echidna/ABI.hs @@ -1,10 +1,8 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE TemplateHaskell #-} module Echidna.ABI where -import Control.Lens import Control.Monad (join, liftM2, liftM3, foldM, replicateM) import Control.Monad.Random.Strict (MonadRandom, getRandom, getRandoms, getRandomR) import Control.Monad.Random.Strict qualified as R @@ -101,27 +99,27 @@ hashSig :: Text -> FunctionHash hashSig = abiKeccak . TE.encodeUtf8 -- | Configuration necessary for generating new 'SolCalls'. Don't construct this by hand! Use 'mkConf'. -data GenDict = GenDict { _pSynthA :: Float - -- ^ Fraction of time to use dictionary vs. synthesize - , _constants :: HashMap AbiType (Set AbiValue) - -- ^ Constants to use, sorted by type - , _wholeCalls :: HashMap SolSignature (Set SolCall) - -- ^ Whole calls to use, sorted by type - , _defSeed :: Int - -- ^ Default seed to use if one is not provided in EConfig - , _rTypes :: Text -> Maybe AbiType - -- ^ Return types of any methods we scrape return values from - , _dictValues :: Set W256 - -- ^ A set of int/uint constants for better performance - } - -makeLenses 'GenDict +data GenDict = GenDict + { pSynthA :: Float + -- ^ Fraction of time to use dictionary vs. synthesize + , constants :: HashMap AbiType (Set AbiValue) + -- ^ Constants to use, sorted by type + , wholeCalls :: HashMap SolSignature (Set SolCall) + -- ^ Whole calls to use, sorted by type + , defSeed :: Int + -- ^ Default seed to use if one is not provided in EConfig + , rTypes :: Text -> Maybe AbiType + -- ^ Return types of any methods we scrape return values from + , dictValues :: Set W256 + -- ^ A set of int/uint constants for better performance + } hashMapBy :: (Hashable k, Hashable a, 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 gaddCalls :: Set SolCall -> GenDict -> GenDict -gaddCalls c = wholeCalls <>~ hashMapBy (fmap $ fmap abiValueType) c +gaddCalls calls dict = + dict { wholeCalls = dict.wholeCalls <> hashMapBy (fmap $ fmap abiValueType) calls } defaultDict :: GenDict defaultDict = mkGenDict 0 Set.empty Set.empty 0 (const Nothing) @@ -307,7 +305,7 @@ genWithDict :: (Eq a, Hashable a, MonadRandom m) => GenDict -> HashMap 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 + let maybeValM = if genDict.pSynthA >= r then fromDict else pure Nothing fromDict = case M.lookup t m of Nothing -> pure Nothing Just cs -> Just <$> rElem' cs @@ -315,7 +313,7 @@ genWithDict genDict m g t = do -- | Synthesize a random 'AbiValue' given its 'AbiType'. Requires a dictionary. genAbiValueM :: MonadRandom m => GenDict -> AbiType -> m AbiValue -genAbiValueM genDict = genWithDict genDict genDict._constants $ \case +genAbiValueM genDict = genWithDict genDict genDict.constants $ \case (AbiUIntType n) -> fixAbiUInt n . fromInteger <$> getRandomUint n (AbiIntType n) -> fixAbiInt n . fromInteger <$> getRandomInt n AbiAddressType -> AbiAddress . fromInteger <$> getRandomR (0, 2 ^ (160 :: Integer) - 1) @@ -334,7 +332,7 @@ genAbiValueM genDict = genWithDict genDict genDict._constants $ \case genAbiCallM :: MonadRandom m => GenDict -> SolSignature -> m SolCall genAbiCallM genDict abi = do solCall <- genWithDict genDict - genDict._wholeCalls + genDict.wholeCalls (traverse $ traverse (genAbiValueM genDict)) abi mutateAbiCall solCall diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs index 9c4de7ee3..762e4e60e 100644 --- a/lib/Echidna/Campaign.hs +++ b/lib/Echidna/Campaign.hs @@ -221,13 +221,16 @@ callseq ic v w ql = do -- 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) + 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 - modifying (genDict . constants) . H.unionWith Set.union $ additions - modifying (genDict . dictValues) . Set.union $ mkDictValues $ Set.unions $ H.elems additions + 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 + } 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 @@ -258,8 +261,8 @@ campaign campaign u vm w ts d txs = do conf <- asks (.cfg.campaignConf) let c = fromMaybe mempty conf.knownCoverage - let effectiveSeed = fromMaybe d'._defSeed conf.seed - effectiveGenDict = d' { _defSeed = effectiveSeed } + let effectiveSeed = fromMaybe d'.defSeed conf.seed + effectiveGenDict = d' { defSeed = effectiveSeed } d' = fromMaybe defaultDict d execStateT (evalRandT runCampaign (mkStdGen effectiveSeed)) diff --git a/lib/Echidna/Output/JSON.hs b/lib/Echidna/Output/JSON.hs index 1e0bd5259..6103eea4d 100644 --- a/lib/Echidna/Output/JSON.hs +++ b/lib/Echidna/Output/JSON.hs @@ -97,7 +97,7 @@ encodeCampaign C.Campaign{..} = encode Campaign { _success = True , _error = Nothing , _tests = mapTest <$> _tests - , seed = _genDict._defSeed + , seed = _genDict.defSeed , coverage = mapKeys (("0x" ++) . (`showHex` "") . keccak') $ DF.toList <$>_coverage , gasInfo = toList _gasInfo } diff --git a/lib/Echidna/Transaction.hs b/lib/Echidna/Transaction.hs index 82636bccc..b2cb33e28 100644 --- a/lib/Echidna/Transaction.hs +++ b/lib/Echidna/Transaction.hs @@ -51,7 +51,7 @@ genTxM memo m = do World ss hmm lmm ps _ <- asks fst genDict <- gets (._genDict) mm <- getSignatures hmm lmm - let ns = genDict._dictValues + let ns = genDict.dictValues s' <- rElem' ss r' <- rElem' $ Set.fromList (mapMaybe (toContractA mm) (toList m)) c' <- genInteractionsM genDict (snd r') diff --git a/lib/Echidna/UI/Report.hs b/lib/Echidna/UI/Report.hs index c45ab5332..e25265418 100644 --- a/lib/Echidna/UI/Report.hs +++ b/lib/Echidna/UI/Report.hs @@ -124,7 +124,7 @@ ppCampaign c = do gasInfoPrinted <- ppGasInfo c let coveragePrinted = maybe "" ("\n" ++) . ppCoverage $ c._coverage corpusPrinted = maybe "" ("\n" ++) . ppCorpus $ c._corpus - seedPrinted = "\nSeed: " ++ show c._genDict._defSeed + seedPrinted = "\nSeed: " ++ show c._genDict.defSeed pure $ testsPrinted ++ gasInfoPrinted diff --git a/lib/Echidna/UI/Widgets.hs b/lib/Echidna/UI/Widgets.hs index 43e8020cd..b73db3dc3 100644 --- a/lib/Echidna/UI/Widgets.hs +++ b/lib/Echidna/UI/Widgets.hs @@ -69,7 +69,7 @@ summaryWidget :: Campaign -> Widget Name summaryWidget c = padLeft (Pad 1) ( str ("Tests found: " ++ show (length c._tests)) <=> - str ("Seed: " ++ show c._genDict._defSeed) + str ("Seed: " ++ show c._genDict.defSeed) <=> maybe emptyWidget str (ppCoverage c._coverage) <=>