Skip to content

Commit

Permalink
Merge pull request #301 from crytic/config-warn
Browse files Browse the repository at this point in the history
Warn on unused config keys
  • Loading branch information
incertia authored Dec 19, 2019
2 parents 25a3009 + 654811f commit c71b493
Show file tree
Hide file tree
Showing 4 changed files with 119 additions and 60 deletions.
16 changes: 15 additions & 1 deletion examples/solidity/basic/default.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,8 @@ prefix: "echidna_"
propMaxGas: 8000030
#testMaxGas is a gas limit; does not cause failure, but terminates sequence
testMaxGas: 0xffffffff
#maxGasprice is the maximum gas price
maxGasprice: 100000000000
#testLimit is the number of test sequences to run
testLimit: 50000
#stopOnFail makes echidna terminate as soon as any property fails and has been shrunk
Expand All @@ -15,6 +17,8 @@ stopOnFail: false
seqLen: 100
#shrinkLimit determines how much effort is spent shrinking failing sequences
shrinkLimit: 5000
#coverage controls coverage guided testing
coverage: false
#format can be "text" or "json" for different output (human or machine readable)
format: "text"
#contractAddr is the address of the contract itself
Expand All @@ -27,15 +31,25 @@ sender: ["0x10000", "0x20000", "0x00a329c0648769a73afac7f9381e08fb43dbea70"]
balanceAddr: 0xffffffff
#balanceContract overrides balanceAddr for the contract address
balanceContract: 0
#solcArgs allows special Args to solc
#solcArgs allows special args to solc
solcArgs: ""
#solcLibs is solc libraries
solcLibs: []
#cryticArgs allows special args to crytic
cryticArgs: []
#quiet produces (much) less verbose output
quiet: false
#checkAsserts checks assertions
checkAsserts: false
#dashboard determines if output is just text or an AFL-like display
dashboard: true
#timeout controls test timeout settings
timeout: null
#seed not defined by default, is the random seed
#seed: 0
#dictFreq controls how often to use echidna's internal dictionary vs random
#values
dictFreq: 0.40
maxTimeDelay: 604800
#maximum time between generated txs; default is one week
maxBlockDelay: 60480
Expand Down
143 changes: 90 additions & 53 deletions lib/Echidna/Config.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
Expand All @@ -12,12 +13,17 @@ import Control.Monad (liftM2, liftM5)
import Control.Monad.Catch (MonadThrow)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader (Reader, ReaderT(..), runReader)
import Control.Monad.State (StateT(..), runStateT)
import Control.Monad.Trans (lift)
import Data.ByteString.Lazy.Char8 (unpack)
import Data.Has (Has(..))
import Data.Aeson
import Data.Aeson.Lens
import Data.Functor ((<&>))
import Data.Text (isPrefixOf)
import Data.Has (Has(..))
import Data.HashMap.Strict (keys)
import Data.HashSet (HashSet, fromList, insert, difference)
import Data.Maybe (fromMaybe)
import Data.Text (Text, isPrefixOf)
import EVM (result)
import EVM.Concrete (Word(..), Whiff(..))

Expand All @@ -42,6 +48,15 @@ data EConfig = EConfig { _cConf :: CampaignConf
}
makeLenses ''EConfig

data EConfigWithUsage = EConfigWithUsage { _econfig :: EConfig
, _badkeys :: HashSet Text
, _unsetkeys :: HashSet Text
}
makeLenses ''EConfigWithUsage

instance Has EConfig EConfigWithUsage where
hasLens = econfig

instance Has CampaignConf EConfig where
hasLens = cConf

Expand All @@ -61,63 +76,85 @@ instance Has UIConf EConfig where
hasLens = uConf

instance FromJSON EConfig where
parseJSON (Object v) =
let tc = do psender <- v .:? "psender" .!= 0x00a329c0648769a73afac7f9381e08fb43dbea70
fprefix <- v .:? "prefix" .!= "echidna_"
let goal fname = if (fprefix <> "revert_") `isPrefixOf` fname then ResRevert else ResTrue
return $ TestConf (\fname -> (== goal fname) . maybe ResOther classifyRes . view result)
(const psender)
getWord s d = C Dull . fromIntegral <$> v .:? s .!= (d :: Integer)
xc = liftM5 TxConf (getWord "propMaxGas" 8000030) (getWord "testMaxGas" 0xffffffff)
(getWord "maxGasprice" 100000000000)
(getWord "maxTimeDelay" 604800) (getWord "maxBlockDelay" 60480)
cov = v .:? "coverage" <&> \case Just True -> Just mempty
_ -> Nothing
cc = CampaignConf <$> v .:? "testLimit" .!= 50000
<*> v .:? "stopOnFail" .!= False
<*> v .:? "seqLen" .!= 100
<*> v .:? "shrinkLimit" .!= 5000
<*> cov
<*> v .:? "seed"
<*> v .:? "dictFreq" .!= 0.40

names :: Names
names Sender = (" from: " ++) . show
names _ = const ""
ppc :: Y.Parser (Campaign -> Int -> String)
ppc = liftM2 (\cf xf c g -> runReader (ppCampaign c) (cf, xf, names) ++ "\nSeed: " ++ show g) cc xc
style :: Y.Parser (Campaign -> Int -> String)
style = v .:? "format" .!= ("text" :: String) >>=
\case "text" -> ppc
"json" -> pure . flip $ \g ->
unpack . encode . set (_Object . at "seed") (Just . toJSON $ g) . toJSON;
"none" -> pure $ \_ _ -> ""
_ -> pure $ \_ _ -> M.fail
"unrecognized ui type (should be text, json, or none)" in
EConfig <$> cc
<*> pure names
<*> (SolConf <$> v .:? "contractAddr" .!= 0x00a329c0648769a73afac7f9381e08fb43dbea72
<*> v .:? "deployer" .!= 0x00a329c0648769a73afac7f9381e08fb43dbea70
<*> v .:? "sender" .!= NE.fromList [0x10000, 0x20000, 0x00a329c0648769a73afac7f9381e08fb43dbea70]
<*> v .:? "balanceAddr" .!= 0xffffffff
<*> v .:? "balanceContract".!= 0
<*> v .:? "prefix" .!= "echidna_"
<*> v .:? "cryticArgs" .!= []
<*> v .:? "solcArgs" .!= ""
<*> v .:? "solcLibs" .!= []
<*> v .:? "quiet" .!= False
<*> v .:? "checkAsserts" .!= False)
<*> tc
<*> xc
<*> (UIConf <$> v .:? "dashboard" .!= True <*> v .:? "timeout" <*> style)
parseJSON _ = parseJSON (Object mempty)
-- retrieve the config from the key usage annotated parse
parseJSON = fmap _econfig . parseJSON

instance FromJSON EConfigWithUsage where
-- this runs the parser in a StateT monad which keeps track of the keys
-- utilized by the config parser
-- we can then compare the set difference between the keys found in the config
-- file and the keys used by the parser to comopute which keys were set in the
-- config and not used and which keys were unset in the config and defaulted
parseJSON o = do
let v' = case o of
Object v -> v
_ -> mempty
(c, ks) <- runStateT (parser v') $ fromList []
let found = fromList (keys v')
return $ EConfigWithUsage c (found `difference` ks) (ks `difference` found)
-- this parser runs in StateT and comes equipped with the following
-- equivalent unary operators:
-- x .:? k (Parser) <==> x ..:? k (StateT)
-- 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
x ..:? k = useKey k >> lift (x .:? k)
x ..!= y = fromMaybe y <$> x
tc = do psender <- v ..:? "psender" ..!= 0x00a329c0648769a73afac7f9381e08fb43dbea70
fprefix <- v ..:? "prefix" ..!= "echidna_"
let goal fname = if (fprefix <> "revert_") `isPrefixOf` fname then ResRevert else ResTrue
return $ TestConf (\fname -> (== goal fname) . maybe ResOther classifyRes . view result)
(const psender)
getWord s d = C Dull . fromIntegral <$> v ..:? s ..!= (d :: Integer)
xc = liftM5 TxConf (getWord "propMaxGas" 8000030) (getWord "testMaxGas" 0xffffffff)
(getWord "maxGasprice" 100000000000)
(getWord "maxTimeDelay" 604800) (getWord "maxBlockDelay" 60480)
cov = v ..:? "coverage" <&> \case Just True -> Just mempty
_ -> Nothing
cc = CampaignConf <$> v ..:? "testLimit" ..!= 50000
<*> v ..:? "stopOnFail" ..!= False
<*> v ..:? "seqLen" ..!= 100
<*> v ..:? "shrinkLimit" ..!= 5000
<*> cov
<*> v ..:? "seed"
<*> v ..:? "dictFreq" ..!= 0.40
names :: Names
names Sender = (" from: " ++) . show
names _ = const ""
--ppc :: Has (HashSet Text) s => StateT s Y.Parser (Campaign -> Int -> String)
ppc = liftM2 (\cf xf c g -> runReader (ppCampaign c) (cf, xf, names) ++ "\nSeed: " ++ show g) cc xc
--style :: Has (HashSet Text) s => StateT s Y.Parser (Campaign -> Int -> String)
style = v ..:? "format" ..!= ("text" :: String) >>=
\case "text" -> ppc
"json" -> pure . flip $ \g ->
unpack . encode . set (_Object . at "seed") (Just . toJSON $ g) . toJSON
"none" -> pure $ \_ _ -> ""
_ -> pure $ \_ _ -> M.fail
"unrecognized ui type (should be text, json, or none)" in
EConfig <$> cc
<*> pure names
<*> (SolConf <$> v ..:? "contractAddr" ..!= 0x00a329c0648769a73afac7f9381e08fb43dbea72
<*> v ..:? "deployer" ..!= 0x00a329c0648769a73afac7f9381e08fb43dbea70
<*> v ..:? "sender" ..!= (0x10000 NE.:| [0x20000, 0x00a329c0648769a73afac7f9381e08fb43dbea70])
<*> v ..:? "balanceAddr" ..!= 0xffffffff
<*> v ..:? "balanceContract" ..!= 0
<*> v ..:? "prefix" ..!= "echidna_"
<*> v ..:? "cryticArgs" ..!= []
<*> v ..:? "solcArgs" ..!= ""
<*> v ..:? "solcLibs" ..!= []
<*> v ..:? "quiet" ..!= False
<*> v ..:? "checkAsserts" ..!= False)
<*> tc
<*> xc
<*> (UIConf <$> v ..:? "dashboard" ..!= True <*> v ..:? "timeout" <*> style)

-- | The default config used by Echidna (see the 'FromJSON' instance for values used).
defaultConfig :: EConfig
defaultConfig = either (error "Config parser got messed up :(") id $ Y.decodeEither' ""

-- | Try to parse an Echidna config file, throw an error if we can't.
parseConfig :: (MonadThrow m, MonadIO m) => FilePath -> m EConfig
parseConfig :: (MonadThrow m, MonadIO m) => FilePath -> m EConfigWithUsage
parseConfig f = liftIO (BS.readFile f) >>= Y.decodeThrow

-- | Run some action with the default configuration, useful in the REPL.
Expand Down
9 changes: 6 additions & 3 deletions src/Main.hs
Original file line number Diff line number Diff line change
@@ -1,13 +1,15 @@
module Main where

import Control.Lens (view)
import Control.Lens (view, (^.))
import Control.Monad (unless)
import Control.Monad.Reader (runReaderT)
import Control.Monad.Random (getRandom)
import Data.Text (pack)
import Data.Text (pack, unpack)
import Data.Version (showVersion)
import Options.Applicative
import Paths_echidna (version)
import System.Exit (exitWith, exitSuccess, ExitCode(..))
import System.IO (hPutStrLn, stderr)

import Echidna.ABI
import Echidna.Config
Expand Down Expand Up @@ -44,7 +46,8 @@ opts = info (helper <*> versionOption <*> options) $ fullDesc
main :: IO ()
main = do Options f c conf <- execParser opts
g <- getRandom
cfg <- maybe (pure defaultConfig) parseConfig conf
EConfigWithUsage cfg ks _ <- maybe (pure (EConfigWithUsage defaultConfig mempty mempty)) parseConfig conf
unless (cfg ^. sConf . quiet) $ mapM_ (hPutStrLn stderr . ("Warning: unused option: " ++) . unpack) ks
cpg <- flip runReaderT cfg $ do
cs <- contracts f
ads <- addresses
Expand Down
11 changes: 8 additions & 3 deletions src/test/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ import Test.Tasty.HUnit

import Echidna.ABI (SolCall, mkGenDict)
import Echidna.Campaign (Campaign(..), CampaignConf(..), TestState(..), campaign, tests)
import Echidna.Config (EConfig, defaultConfig, parseConfig, sConf, cConf)
import Echidna.Config (EConfig, EConfigWithUsage(..), _econfig, defaultConfig, parseConfig, sConf, cConf)
import Echidna.Solidity
import Echidna.Transaction (Tx, call)

Expand Down Expand Up @@ -38,10 +38,15 @@ configTests :: TestTree
configTests = testGroup "Configuration tests" $
[ testCase file $ void $ parseConfig file | file <- files ] ++
[ testCase "parse \"coverage: true\"" $ do
config <- parseConfig "coverage/test.yaml"
config <- _econfig <$> parseConfig "coverage/test.yaml"
assertCoverage config $ Just mempty
, testCase "coverage disabled by default" $
assertCoverage defaultConfig Nothing
, testCase "defaults.yaml" $ do
EConfigWithUsage _ bad unset <- parseConfig "basic/default.yaml"
assertBool ("unused options: " ++ show bad) $ null bad
let unset' = unset & sans "seed"
assertBool ("unset options: " ++ show unset') $ null unset'
]
where files = ["basic/config.yaml", "basic/default.yaml"]
assertCoverage config value = do
Expand Down Expand Up @@ -189,7 +194,7 @@ integrationTests = testGroup "Solidity Integration Testing"

testContract :: FilePath -> Maybe FilePath -> [(String, Campaign -> Bool)] -> TestTree
testContract fp cfg as = testCase fp $ do
c <- set (sConf . quiet) True <$> maybe (pure defaultConfig) parseConfig cfg
c <- set (sConf . quiet) True <$> maybe (pure defaultConfig) (fmap _econfig . parseConfig) cfg
res <- runContract fp c
mapM_ (\(t,f) -> assertBool t $ f res) as

Expand Down

0 comments on commit c71b493

Please sign in to comment.