diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,42 @@ -# hevm changelog +# Changelog -## Unreleased +All notable changes to this project will be documented in this file. +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). + +## [0.49.0] - 2021-11-12 + +### Added + +- Support for solc 0.8.10 + +### Changed + +- Clearer display for the invalid opcode (`0xfe`) in debug view +- Better error messages when trying to deploy unlinked bytecode +- `bytesX` arguments to `hevm abiencode` are automatically padded + +### Fixed + +- Test contracts with no code (e.g. `abstract` contracts) are now skipped +- Replay data for invariant tests is now displayed in a form that does not cause errors when used with `dapp test --replay` + +## [0.48.1] - 2021-09-08 + +### Added + +- Support for 0.8.4 custom error types in stack traces + +### Changed + +- Contract feching happens synchronously again. +- Invariants checked before calling methods from targetContracts. + +### Fixed + +- The block gas limit and basefee are now correctly fetched when running tests via rpc + ## 0.48.0 - 2021-08-03 ### Changed @@ -17,6 +52,8 @@ - Removed NoSuchContract failures ## 0.47.0 - 2021-07-01 + +### Added - A new test runner for checking invariants against random reachable contract states. - `hevm symbolic` can search for solc 0.8 style assertion violations, and a new `--assertions` flag diff --git a/hevm-cli/hevm-cli.hs b/hevm-cli/hevm-cli.hs --- a/hevm-cli/hevm-cli.hs +++ b/hevm-cli/hevm-cli.hs @@ -82,6 +82,7 @@ import qualified Data.ByteString.Char8 as Char8 import qualified Data.ByteString.Lazy as LazyByteString import qualified Data.Map as Map +import qualified Data.Text as Text import qualified System.Timeout as Timeout import qualified Paths_hevm as Paths @@ -189,6 +190,7 @@ , state :: w ::: Maybe String "Path to state repository" , cache :: w ::: Maybe String "Path to rpc cache repository" , match :: w ::: Maybe String "Test case filter - only run methods matching regex" + , covMatch :: w ::: Maybe String "Coverage filter - only print coverage for files matching regex" , solver :: w ::: Maybe Text "Used SMT solver: z3 (default) or cvc4" , smtdebug :: w ::: Bool "Print smt queries sent to the solver" , ffi :: w ::: Bool "Allow the usage of the hevm.ffi() cheatcode (WARNING: this allows test authors to execute arbitrary code on your machine)" @@ -298,6 +300,7 @@ , EVM.UnitTest.askSmtIters = askSmtIterations cmd , EVM.UnitTest.smtTimeout = smttimeout cmd , EVM.UnitTest.solver = solver cmd + , EVM.UnitTest.covMatch = pack <$> covMatch cmd , EVM.UnitTest.smtState = Just state , EVM.UnitTest.verbose = verbose cmd , EVM.UnitTest.match = pack $ fromMaybe ".*" (match cmd) @@ -532,7 +535,8 @@ showCounterexample preState maybesig treeShowing tree io $ exitWith (ExitFailure 1) - Timeout _ -> do + Timeout tree -> do + treeShowing tree io $ exitWith (ExitFailure 1) Qed tree -> do io $ putStrLn $ "Explored: " <> show (length tree) @@ -593,23 +597,33 @@ let dapp = dappInfo "." contractMap sourceCache f (k, vs) = do - putStr "***** hevm coverage for " - putStrLn (unpack k) - putStrLn "" - forM_ vs $ \(n, bs) -> do - case ByteString.find (\x -> x /= 0x9 && x /= 0x20 && x /= 0x7d) bs of - Nothing -> putStr "..... " - Just _ -> - case n of - -1 -> putStr ";;;;; " - 0 -> putStr "##### " - _ -> putStr " " - Char8.putStrLn bs - putStrLn "" - + when (shouldPrintCoverage (EVM.UnitTest.covMatch opts) k) $ do + putStr ("\x1b[0m" ++ "————— hevm coverage for ") -- Prefixed with color reset + putStrLn (unpack k ++ " —————") + putStrLn "" + forM_ vs $ \(n, bs) -> do + case ByteString.find (\x -> x /= 0x9 && x /= 0x20 && x /= 0x7d) bs of + Nothing -> putStr "\x1b[38;5;240m" -- Gray (Coverage status isn't relevant) + Just _ -> + case n of + -1 -> putStr "\x1b[38;5;240m" -- Gray (Coverage status isn't relevant) + 0 -> putStr "\x1b[31m" -- Red (Uncovered) + _ -> putStr "\x1b[32m" -- Green (Covered) + Char8.putStrLn bs + putStrLn "" mapM_ f (Map.toList (coverageReport dapp covs)) Nothing -> error ("Failed to read Solidity JSON for `" ++ solcFile ++ "'") + +shouldPrintCoverage :: Maybe Text -> Text -> Bool +shouldPrintCoverage (Just covMatch) file = regexMatches covMatch file +shouldPrintCoverage Nothing file = not (isTestOrLib file) + +isTestOrLib :: Text -> Bool +isTestOrLib file = Text.isSuffixOf ".t.sol" file || areAnyPrefixOf ["src/test/", "src/tests/", "lib/"] file + +areAnyPrefixOf :: [Text] -> Text -> Bool +areAnyPrefixOf prefixes t = any (flip Text.isPrefixOf t) prefixes launchExec :: Command Options.Unwrapped -> IO () launchExec cmd = do diff --git a/hevm.cabal b/hevm.cabal --- a/hevm.cabal +++ b/hevm.cabal @@ -2,7 +2,7 @@ name: hevm version: - 0.48.0 + 0.49.0 synopsis: Ethereum virtual machine evaluator description: @@ -81,7 +81,6 @@ ethjet/tinykeccak.h, ethjet/ethjet.h, ethjet/ethjet-ff.h, ethjet/blake2.h build-depends: QuickCheck >= 2.13.2 && < 2.15, - async == 2.2.3, Decimal >= 0.5.1 && < 0.6, containers >= 0.6.0 && < 0.7, deepseq >= 1.4.4 && < 1.5, diff --git a/src/EVM/ABI.hs b/src/EVM/ABI.hs --- a/src/EVM/ABI.hs +++ b/src/EVM/ABI.hs @@ -35,6 +35,7 @@ , AbiVals (..) , abiKind , Event (..) + , SolError (..) , Anonymity (..) , Indexed (..) , putAbi @@ -146,8 +147,10 @@ deriving (Show, Ord, Eq, Generic) data Indexed = Indexed | NotIndexed deriving (Show, Ord, Eq, Generic) -data Event = Event Text Anonymity [(AbiType, Indexed)] +data Event = Event Text Anonymity [(Text, AbiType, Indexed)] deriving (Show, Ord, Eq, Generic) +data SolError = SolError Text [AbiType] + deriving (Show, Ord, Eq, Generic) abiKind :: AbiType -> AbiKind abiKind = \case @@ -480,9 +483,13 @@ readsPrec n (_:t) = readsPrec n t makeAbiValue :: AbiType -> String -> AbiValue -makeAbiValue typ str = case readP_to_S (parseAbiValue typ) str of +makeAbiValue typ str = case readP_to_S (parseAbiValue typ) (padStr str) of [(val,"")] -> val _ -> error $ "could not parse abi argument: " ++ str ++ " : " ++ show typ + where + padStr = case typ of + (AbiBytesType n) -> padRight' (2 * n + 2) -- +2 is for the 0x prefix + _ -> id parseAbiValue :: AbiType -> ReadP AbiValue parseAbiValue (AbiUIntType n) = do W256 w <- readS_to_P reads diff --git a/src/EVM/Dapp.hs b/src/EVM/Dapp.hs --- a/src/EVM/Dapp.hs +++ b/src/EVM/Dapp.hs @@ -4,10 +4,10 @@ module EVM.Dapp where import EVM (Trace, traceContract, traceOpIx, ContractCode(..), Contract(..), codehash, contractcode) -import EVM.ABI (Event, AbiType) +import EVM.ABI (Event, AbiType, SolError) import EVM.Debug (srcMapCodePos) import EVM.Solidity -import EVM.Types (W256, abiKeccak, keccak, Buffer(..), Addr) +import EVM.Types (W256, abiKeccak, keccak, Buffer(..), Addr, regexMatches) import EVM.Concrete import Data.ByteString (ByteString) @@ -26,8 +26,6 @@ import Data.List (find) import qualified Data.Map as Map -import qualified Data.Sequence as Seq -import qualified Text.Regex.TDFA as Regex data DappInfo = DappInfo { _dappRoot :: FilePath @@ -38,6 +36,7 @@ , _dappUnitTests :: [(Text, [(Test, [AbiType])])] , _dappAbiMap :: Map Word32 Method , _dappEventMap :: Map W256 Event + , _dappErrorMap :: Map W256 SolError , _dappAstIdMap :: Map Int Value , _dappAstSrcMap :: SrcMap -> Maybe Value } @@ -89,6 +88,7 @@ -- Sum up the ABI maps from all the contracts. , _dappAbiMap = mconcat (map (view abiMap) solcs) , _dappEventMap = mconcat (map (view eventMap) solcs) + , _dappErrorMap = mconcat (map (view errorMap) solcs) , _dappAstIdMap = astIds , _dappAstSrcMap = astSrcMap astIds @@ -120,17 +120,6 @@ | "invariant" `isPrefixOf` sig = Just (InvariantTest sig) | otherwise = Nothing -regexMatches :: Text -> Text -> Bool -regexMatches regexSource = - let - compOpts = - Regex.defaultCompOpt { Regex.lastStarGreedy = True } - execOpts = - Regex.defaultExecOpt { Regex.captureGroups = False } - regex = Regex.makeRegexOpts compOpts execOpts (unpack regexSource) - in - Regex.matchTest regex . Seq.fromList . unpack - findUnitTests :: Text -> ([SolcContract] -> [(Text, [(Test, [AbiType])])]) findUnitTests match = concatMap $ \c -> @@ -138,7 +127,7 @@ Nothing -> [] Just _ -> let testNames = unitTestMethodsFiltered (regexMatches match) c - in [(view contractName c, testNames) | not (null testNames)] + in [(view contractName c, testNames) | not (BS.null (view runtimeCode c)) && not (null testNames)] unitTestMethodsFiltered :: (Text -> Bool) -> (SolcContract -> [(Test, [AbiType])]) unitTestMethodsFiltered matcher c = diff --git a/src/EVM/Dev.hs b/src/EVM/Dev.hs --- a/src/EVM/Dev.hs +++ b/src/EVM/Dev.hs @@ -58,6 +58,7 @@ facts <- Git.loadFacts (Git.RepoAt repoPath) pure (flip Facts.apply facts) params <- getParametersFromEnvironmentVariables Nothing + dapp <- loadDappInfo root path let opts = UnitTestOptions { oracle = EVM.Fetch.zero @@ -68,10 +69,11 @@ , smtState = Nothing , solver = Nothing , match = "" + , covMatch = Nothing , fuzzRuns = 100 , replay = Nothing , vmModifier = loadFacts - , dapp = emptyDapp + , dapp = dapp , testParams = params , maxDepth = Nothing , ffiAllowed = False @@ -128,6 +130,7 @@ , smtState = Nothing , solver = Nothing , match = "" + , covMatch = Nothing , fuzzRuns = 100 , replay = Nothing , vmModifier = loadFacts diff --git a/src/EVM/Emacs.hs b/src/EVM/Emacs.hs --- a/src/EVM/Emacs.hs +++ b/src/EVM/Emacs.hs @@ -513,6 +513,7 @@ , smtState = Nothing , solver = Nothing , match = "" + , covMatch = Nothing , fuzzRuns = 100 , replay = Nothing , vmModifier = id diff --git a/src/EVM/Facts.hs b/src/EVM/Facts.hs --- a/src/EVM/Facts.hs +++ b/src/EVM/Facts.hs @@ -47,6 +47,7 @@ import Control.Lens (view, set, at, ix, (&), over, assign) import Control.Monad.State.Strict (execState, when) import Data.ByteString (ByteString) +import Data.Monoid ((<>)) import Data.Ord (comparing) import Data.Set (Set) import Text.Read (readMaybe) @@ -118,7 +119,7 @@ , NonceFact a (view nonce x) , CodeFact a b ] - SymbolicBuffer _ -> + SymbolicBuffer b -> -- here simply ignore storing the bytecode storageFacts a x ++ [ BalanceFact a (view balance x) diff --git a/src/EVM/Fetch.hs b/src/EVM/Fetch.hs --- a/src/EVM/Fetch.hs +++ b/src/EVM/Fetch.hs @@ -5,7 +5,6 @@ module EVM.Fetch where import Prelude hiding (Word) -import Data.Scientific import EVM.ABI import EVM.Types (Addr, w256, W256, hexText, Word, Buffer(..)) @@ -17,14 +16,15 @@ import Control.Lens hiding ((.=)) import Control.Monad.Reader +import Control.Monad.Trans.Maybe import Data.SBV.Trans.Control import qualified Data.SBV.Internals as SBV import Data.SBV.Trans hiding (Word) import Data.Aeson import Data.Aeson.Lens -import Control.Concurrent.Async import qualified Data.ByteString as BS import Data.Text (Text, unpack, pack) +import Data.Maybe (fromMaybe) import qualified Data.Vector as RegularVector import Network.Wreq @@ -35,7 +35,6 @@ -- | Abstract representation of an RPC fetch request data RpcQuery a where - QueryAccount :: Addr -> RpcQuery (BS.ByteString, W256, W256) QueryCode :: Addr -> RpcQuery BS.ByteString QueryBlock :: RpcQuery Block QueryBalance :: Addr -> RpcQuery W256 @@ -47,10 +46,10 @@ deriving instance Show (RpcQuery a) -rpc :: String -> [Value] -> Scientific -> Value -rpc method args i = object +rpc :: String -> [Value] -> Value +rpc method args = object [ "jsonrpc" .= ("2.0" :: String) - , "id" .= Number i + , "id" .= Number 1 , "method" .= method , "params" .= args ] @@ -81,41 +80,38 @@ -> RpcQuery a -> IO (Maybe a) fetchQuery n f q = do - case q of - QueryAccount addr -> do - [m, m', m''] <- mapConcurrently (\(x, i) -> f (rpc x [toRPC addr, toRPC n] i)) [("eth_getCode", 1), ("eth_getBalance", 2), ("eth_getTransactionCount", 3)] - return $ liftM3 (\a b c -> - (hexText . view _String $ a, - readText . view _String $ b, - readText . view _String $ c)) m m' m'' + x <- case q of QueryCode addr -> do - m <- f (rpc "eth_getCode" [toRPC addr, toRPC n] 1) + m <- f (rpc "eth_getCode" [toRPC addr, toRPC n]) return $ hexText . view _String <$> m QueryNonce addr -> do - m <- f (rpc "eth_getTransactionCount" [toRPC addr, toRPC n] 1) + m <- f (rpc "eth_getTransactionCount" [toRPC addr, toRPC n]) return $ readText . view _String <$> m QueryBlock -> do - m <- f (rpc "eth_getBlockByNumber" [toRPC n, toRPC False] 1) + m <- f (rpc "eth_getBlockByNumber" [toRPC n, toRPC False]) return $ m >>= parseBlock QueryBalance addr -> do - m <- f (rpc "eth_getBalance" [toRPC addr, toRPC n] 1) + m <- f (rpc "eth_getBalance" [toRPC addr, toRPC n]) return $ readText . view _String <$> m QuerySlot addr slot -> do - m <- f (rpc "eth_getStorageAt" [toRPC addr, toRPC slot, toRPC n] 1) + m <- f (rpc "eth_getStorageAt" [toRPC addr, toRPC slot, toRPC n]) return $ readText . view _String <$> m QueryChainId -> do - m <- f (rpc "eth_chainId" [toRPC n] 1) + m <- f (rpc "eth_chainId" [toRPC n]) return $ readText . view _String <$> m + return x + parseBlock :: (AsValue s, Show s) => s -> Maybe EVM.Block parseBlock j = do coinbase <- readText <$> j ^? key "miner" . _String timestamp <- litWord . readText <$> j ^? key "timestamp" . _String number <- readText <$> j ^? key "number" . _String difficulty <- readText <$> j ^? key "difficulty" . _String - baseFee <- readText <$> j ^? key "baseFeePerGas" . _String + gasLimit <- readText <$> j ^? key "gasLimit" . _String + let baseFee = readText <$> j ^? key "baseFeePerGas" . _String -- default codesize, default gas limit, default feescedule - return $ EVM.Block coinbase timestamp number difficulty 0xffffffff baseFee 0xffffffff FeeSchedule.berlin + return $ EVM.Block coinbase timestamp number difficulty gasLimit (fromMaybe 0 baseFee) 0xffffffff FeeSchedule.berlin fetchWithSession :: Text -> Session -> Value -> IO (Maybe Value) fetchWithSession url sess x = do @@ -124,19 +120,20 @@ fetchContractWithSession :: BlockNumber -> Text -> Addr -> Session -> IO (Maybe Contract) -fetchContractWithSession n url addr sess = +fetchContractWithSession n url addr sess = runMaybeT $ do let fetch :: Show a => RpcQuery a -> IO (Maybe a) fetch = fetchQuery n (fetchWithSession url sess) - in - fetch (QueryAccount addr) >>= \case - Nothing -> return Nothing - Just (theCode, theBalance, theNonce) -> - return $ Just $ - initialContract (EVM.RuntimeCode (ConcreteBuffer theCode)) - & set nonce (w256 theNonce) - & set balance (w256 theBalance) - & set external True + + theCode <- MaybeT $ fetch (QueryCode addr) + theNonce <- MaybeT $ fetch (QueryNonce addr) + theBalance <- MaybeT $ fetch (QueryBalance addr) + + return $ + initialContract (EVM.RuntimeCode (ConcreteBuffer theCode)) + & set nonce (w256 theNonce) + & set balance (w256 theBalance) + & set external True fetchSlotWithSession :: BlockNumber -> Text -> Session -> Addr -> W256 -> IO (Maybe Word) diff --git a/src/EVM/Flatten.hs b/src/EVM/Flatten.hs --- a/src/EVM/Flatten.hs +++ b/src/EVM/Flatten.hs @@ -10,7 +10,8 @@ -- This module is mostly independent from the rest of Hevm, -- using only the source code metadata support modules. -import EVM.Dapp (DappInfo, dappSources, regexMatches) +import EVM.Dapp (DappInfo, dappSources) +import EVM.Types (regexMatches) import EVM.Solidity (sourceAsts) import EVM.Demand (demand) @@ -218,7 +219,7 @@ maximalPragma :: [Value] -> Text maximalPragma asts = ( case mapMaybe versions asts of - [] -> "" -- allow for no pragma + [] -> "" -- allow for no pragma xs -> "pragma solidity " <> pack (show (rangeIntersection xs)) diff --git a/src/EVM/Format.hs b/src/EVM/Format.hs --- a/src/EVM/Format.hs +++ b/src/EVM/Format.hs @@ -5,16 +5,16 @@ import Prelude hiding (Word) import qualified EVM -import EVM.Dapp (DappInfo (..), dappSolcByHash, dappAbiMap, showTraceLocation, dappEventMap) +import EVM.Dapp (DappInfo (..), dappSolcByHash, dappAbiMap, showTraceLocation, dappEventMap, dappErrorMap) import EVM.Dapp (DappContext (..), contextInfo, contextEnv) import EVM.Concrete ( wordValue ) import EVM (VM, VMResult(..), cheatCode, traceForest, traceData, Error (..), result) import EVM (Trace, TraceData (..), Log (..), Query (..), FrameContext (..), Storage(..)) import EVM.SymExec import EVM.Symbolic (len, litWord) -import EVM.Types (maybeLitWord, Word (..), Whiff(..), SymWord(..), W256 (..), num) +import EVM.Types (maybeLitWord, Word (..), Whiff(..), SymWord(..), W256 (..), num, word) import EVM.Types (Addr, Buffer(..), ByteStringS(..)) -import EVM.ABI (AbiValue (..), Event (..), AbiType (..)) +import EVM.ABI (AbiValue (..), Event (..), AbiType (..), SolError (..)) import EVM.ABI (Indexed (NotIndexed), getAbiSeq) import EVM.ABI (parseTypeName, formatString) import EVM.Solidity (SolcContract(..), contractName, abiMap) @@ -122,11 +122,15 @@ showCall ts (ConcreteBuffer bs) = showValues ts $ ConcreteBuffer (BS.drop 4 bs) showError :: (?context :: DappContext) => ByteString -> Text -showError bs = case BS.take 4 bs of - -- Method ID for Error(string) - "\b\195y\160" -> showCall [AbiStringType] (ConcreteBuffer bs) - _ -> formatBinary bs - +showError bs = + let dappinfo = view contextInfo ?context + bs4 = BS.take 4 bs + in case Map.lookup (word bs4) (view dappErrorMap dappinfo) of + Just (SolError errName ts) -> errName <> " " <> showCall ts (ConcreteBuffer bs) + Nothing -> case bs4 of + -- Method ID for Error(string) + "\b\195y\160" -> showCall [AbiStringType] (ConcreteBuffer bs) + _ -> formatBinary bs -- the conditions under which bytes will be decoded and rendered as a string isPrintable :: ByteString -> Bool @@ -170,8 +174,8 @@ traces = fmap (fmap (unpack . showTrace dapp vm)) forest in pack $ concatMap showTree traces -unindexed :: [(AbiType, Indexed)] -> [AbiType] -unindexed ts = [t | (t, NotIndexed) <- ts] +unindexed :: [(Text, AbiType, Indexed)] -> [AbiType] +unindexed ts = [t | (_, t, NotIndexed) <- ts] showTrace :: DappInfo -> VM -> Trace -> Text showTrace dapp vm trace = diff --git a/src/EVM/Op.hs b/src/EVM/Op.hs --- a/src/EVM/Op.hs +++ b/src/EVM/Op.hs @@ -167,4 +167,6 @@ OpLog x -> "LOG" ++ show x OpPush x -> "PUSH " ++ show x OpRevert -> "REVERT" - OpUnknown x -> "UNKNOWN " ++ show x + OpUnknown x -> case x of + 254 -> "INVALID" + _ -> "UNKNOWN " ++ (showHex x "") diff --git a/src/EVM/Solidity.hs b/src/EVM/Solidity.hs --- a/src/EVM/Solidity.hs +++ b/src/EVM/Solidity.hs @@ -29,6 +29,7 @@ , methodMutability , abiMap , eventMap + , errorMap , storageLayout , contractName , constructorInputs @@ -57,6 +58,7 @@ , lineSubrange , astIdMap , astSrcMap + , containsLinkerHole ) where import EVM.ABI @@ -144,6 +146,7 @@ , _constructorInputs :: [(Text, AbiType)] , _abiMap :: Map Word32 Method , _eventMap :: Map W256 Event + , _errorMap :: Map W256 SolError , _immutableReferences :: Map W256 [Reference] , _storageLayout :: Maybe (Map Text StorageItem) , _runtimeSrcmap :: Seq SrcMap @@ -367,6 +370,7 @@ _constructorInputs = mkConstructor abis, _abiMap = mkAbiMap abis, _eventMap = mkEventMap abis, + _errorMap = mkErrorMap abis, _storageLayout = mkStorageLayout $ x ^? key "storage-layout", _immutableReferences = mempty -- TODO: deprecate combined-json } @@ -409,6 +413,7 @@ _constructorInputs = mkConstructor abis, _abiMap = mkAbiMap abis, _eventMap = mkEventMap abis, + _errorMap = mkErrorMap abis, _storageLayout = mkStorageLayout $ x ^? key "storageLayout", _immutableReferences = fromMaybe mempty $ do x' <- runtime ^? key "immutableReferences" @@ -445,14 +450,33 @@ (case abi ^?! key "anonymous" . _Bool of True -> Anonymous False -> NotAnonymous) - (map (\y -> ( force "internal error: type" (parseTypeName' y) - , if y ^?! key "indexed" . _Bool - then Indexed - else NotIndexed )) + (map (\y -> + ( y ^?! key "name" . _String + , force "internal error: type" (parseTypeName' y) + , if y ^?! key "indexed" . _Bool + then Indexed + else NotIndexed + )) (toList $ abi ^?! key "inputs" . _Array)) ) in f <$> relevant +mkErrorMap :: [Value] -> Map W256 SolError +mkErrorMap abis = Map.fromList $ + let + relevant = filter (\y -> "error" == y ^?! key "type" . _String) abis + f abi = + ( stripKeccak $ keccak (encodeUtf8 (signature abi)) + , SolError + (abi ^?! key "name" . _String) + (map (\y -> ( force "internal error: type" (parseTypeName' y))) + (toList $ abi ^?! key "inputs" . _Array)) + ) + in f <$> relevant + where + stripKeccak :: W256 -> W256 + stripKeccak = read . take 10 . show + mkConstructor :: [Value] -> [(Text, AbiType)] mkConstructor abis = let @@ -512,10 +536,15 @@ , force "internal error: method type" (parseTypeName' x) ) +containsLinkerHole :: Text -> Bool +containsLinkerHole = regexMatches "__\\$[a-z0-9]{34}\\$__" + toCode :: Text -> ByteString toCode t = case BS16.decode (encodeUtf8 t) of Right d -> d - Left e -> error e + Left e -> if containsLinkerHole t + then error "unlinked libraries detected in bytecode" + else error e solidity' :: Text -> IO (Text, Text) solidity' src = withSystemTempFile "hevm.sol" $ \path handle -> do diff --git a/src/EVM/TTY.hs b/src/EVM/TTY.hs --- a/src/EVM/TTY.hs +++ b/src/EVM/TTY.hs @@ -24,7 +24,6 @@ import EVM.Solidity hiding (storageLayout) import EVM.Types hiding (padRight) import EVM.UnitTest -import EVM.RLP (RLP(..)) import EVM.StorageLayout import EVM.Stepper (Stepper) @@ -249,6 +248,7 @@ , testParams = error "irrelevant" , dapp = dappinfo , ffiAllowed = False + , covMatch = Nothing } ui0 = initUiVmState vm opts (void Stepper.execFully) @@ -645,12 +645,12 @@ void (execSymTest opts theTestName (SymbolicBuffer buf, w256lit len)) InvariantTest _ -> do targets <- getTargetContracts opts - let randomRun = explorationStepper opts theTestName [] targets (List []) (fromMaybe 20 maxDepth) + let randomRun = initialExplorationStepper opts theTestName [] targets (fromMaybe 20 maxDepth) void $ case replay of Nothing -> randomRun Just (sig, cd) -> if theTestName == sig - then explorationStepper opts theTestName (decodeCalls cd) targets (List []) (length (decodeCalls cd)) + then initialExplorationStepper opts theTestName (decodeCalls cd) targets (length (decodeCalls cd)) else randomRun pure $ initUiVmState vm0 opts script where diff --git a/src/EVM/Types.hs b/src/EVM/Types.hs --- a/src/EVM/Types.hs +++ b/src/EVM/Types.hs @@ -36,6 +36,8 @@ import qualified Data.Serialize.Get as Cereal import qualified Data.Text as Text import qualified Data.Text.Encoding as Text +import qualified Data.Sequence as Seq +import qualified Text.Regex.TDFA as Regex import qualified Text.Read -- Some stuff for "generic programming", needed to create Word512 @@ -461,6 +463,9 @@ padRight :: Int -> ByteString -> ByteString padRight n xs = xs <> BS.replicate (n - BS.length xs) 0 +padRight' :: Int -> String -> String +padRight' n xs = xs <> replicate (n - length xs) '0' + -- | Right padding / truncating truncpad :: Int -> [SWord 8] -> [SWord 8] truncpad n xs = if m > n then take n xs @@ -553,6 +558,18 @@ >>> BS.unpack >>> word32 +-- Utils concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b] concatMapM f xs = liftM concat (mapM f xs) + +regexMatches :: Text -> Text -> Bool +regexMatches regexSource = + let + compOpts = + Regex.defaultCompOpt { Regex.lastStarGreedy = True } + execOpts = + Regex.defaultExecOpt { Regex.captureGroups = False } + regex = Regex.makeRegexOpts compOpts execOpts (Text.unpack regexSource) + in + Regex.matchTest regex . Seq.fromList . Text.unpack diff --git a/src/EVM/UnitTest.hs b/src/EVM/UnitTest.hs --- a/src/EVM/UnitTest.hs +++ b/src/EVM/UnitTest.hs @@ -78,6 +78,7 @@ , smtTimeout :: Maybe Integer , smtState :: Maybe SBV.State , solver :: Maybe Text + , covMatch :: Maybe Text , match :: Text , fuzzRuns :: Int , replay :: Maybe (Text, BSLazy.ByteString) @@ -465,6 +466,14 @@ List v <- rlpdecode $ BSLazy.toStrict b return $ flip fmap v $ \(List [BS caller', BS target, BS cd, BS ts]) -> (num (word caller'), num (word target), cd, word ts) +-- | Runs an invariant test, calls the invariant before execution begins +initialExplorationStepper :: UnitTestOptions -> ABIMethod -> [ExploreTx] -> [Addr] -> Int -> Stepper (Bool, RLP) +initialExplorationStepper opts'' testName replayData targets i = do + let history = List [] + x <- runUnitTest opts'' testName emptyAbi + if x + then explorationStepper opts'' testName replayData targets history i + else pure (False, history) explorationStepper :: UnitTestOptions -> ABIMethod -> [ExploreTx] -> [Addr] -> RLP -> Int -> Stepper (Bool, RLP) explorationStepper _ _ _ _ history 0 = return (True, history) @@ -563,16 +572,16 @@ then foldM (\a@((success, _), _) _ -> if success - then runStateT (EVM.Stepper.interpret oracle (explorationStepper opts testName [] targets (List []) depth)) initialVm + then runStateT (EVM.Stepper.interpret oracle (initialExplorationStepper opts testName [] targets depth)) initialVm else pure a) ((True, (List [])), initialVm) -- no canonical "post vm" [0..fuzzRuns] - else runStateT (EVM.Stepper.interpret oracle (explorationStepper opts testName replayTxs targets (List []) (length replayTxs))) initialVm + else runStateT (EVM.Stepper.interpret oracle (initialExplorationStepper opts testName replayTxs targets (length replayTxs))) initialVm if x then return ("\x1b[32m[PASS]\x1b[0m " <> testName <> " (runs: " <> (pack $ show fuzzRuns) <>", depth: " <> pack (show depth) <> ")", Right (passOutput vm' opts testName), vm') -- no canonical "post vm" else let replayText = if null replayTxs - then "\nReplay data: '(" <> pack (show testName) <> ", " <> pack (show (show (ByteStringS $ rlpencode counterex))) <> ")'" + then "\nReplay data: '(" <> pack (show testName) <> "," <> pack (show (show (ByteStringS $ rlpencode counterex))) <> ")'" else " (replayed)" in return ("\x1b[31m[FAIL]\x1b[0m " <> testName <> replayText, Left (failOutput vm' opts testName), vm') @@ -956,15 +965,17 @@ getParametersFromEnvironmentVariables rpc = do block' <- maybe EVM.Fetch.Latest (EVM.Fetch.BlockNumber . read) <$> (lookupEnv "DAPP_TEST_NUMBER") - (miner,ts,blockNum,diff) <- + (miner,ts,blockNum,diff,limit,base) <- case rpc of - Nothing -> return (0,0,0,0) + Nothing -> return (0,0,0,0,0,0) Just url -> EVM.Fetch.fetchBlockFrom block' url >>= \case Nothing -> error "Could not fetch block" Just EVM.Block{..} -> return ( _coinbase , wordValue $ forceLit _timestamp , wordValue _number , wordValue _difficulty + , wordValue _gaslimit + , wordValue _baseFee ) let getWord s def = maybe def read <$> lookupEnv s @@ -976,13 +987,13 @@ <*> getAddr "DAPP_TEST_ORIGIN" ethrunAddress <*> getWord "DAPP_TEST_GAS_CREATE" defaultGasForCreating <*> getWord "DAPP_TEST_GAS_CALL" defaultGasForInvoking - <*> getWord "DAPP_TEST_BASEFEE" 0 + <*> getWord "DAPP_TEST_BASEFEE" base <*> getWord "DAPP_TEST_PRIORITYFEE" 0 <*> getWord "DAPP_TEST_BALANCE" defaultBalanceForTestContract <*> getAddr "DAPP_TEST_COINBASE" miner <*> getWord "DAPP_TEST_NUMBER" blockNum <*> getWord "DAPP_TEST_TIMESTAMP" ts - <*> getWord "DAPP_TEST_GAS_LIMIT" 0 + <*> getWord "DAPP_TEST_GAS_LIMIT" limit <*> getWord "DAPP_TEST_GAS_PRICE" 0 <*> getWord "DAPP_TEST_MAXCODESIZE" defaultMaxCodeSize <*> getWord "DAPP_TEST_DIFFICULTY" diff diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -152,6 +152,15 @@ in x == y ] + , testGroup "Unresolved link detection" + [ testCase "holes detected" $ do + let code' = "608060405234801561001057600080fd5b5060405161040f38038061040f83398181016040528101906100329190610172565b73__$f3cbc3eb14e5bd0705af404abcf6f741ec$__63ab5c1ffe826040518263ffffffff1660e01b81526004016100699190610217565b60206040518083038186803b15801561008157600080fd5b505af4158015610095573d6000803e3d6000fd5b505050506040513d601f19601f820116820180604052508101906100b99190610145565b50506103c2565b60006100d36100ce84610271565b61024c565b9050828152602081018484840111156100ef576100ee610362565b5b6100fa8482856102ca565b509392505050565b600081519050610111816103ab565b92915050565b600082601f83011261012c5761012b61035d565b5b815161013c8482602086016100c0565b91505092915050565b60006020828403121561015b5761015a61036c565b5b600061016984828501610102565b91505092915050565b6000602082840312156101885761018761036c565b5b600082015167ffffffffffffffff8111156101a6576101a5610367565b5b6101b284828501610117565b91505092915050565b60006101c6826102a2565b6101d081856102ad565b93506101e08185602086016102ca565b6101e981610371565b840191505092915050565b60006102016003836102ad565b915061020c82610382565b602082019050919050565b6000604082019050818103600083015261023181846101bb565b90508181036020830152610244816101f4565b905092915050565b6000610256610267565b905061026282826102fd565b919050565b6000604051905090565b600067ffffffffffffffff82111561028c5761028b61032e565b5b61029582610371565b9050602081019050919050565b600081519050919050565b600082825260208201905092915050565b60008115159050919050565b60005b838110156102e85780820151818401526020810190506102cd565b838111156102f7576000848401525b50505050565b61030682610371565b810181811067ffffffffffffffff821117156103255761032461032e565b5b80604052505050565b7f4e487b7100000000000000000000000000000000000000000000000000000000600052604160045260246000fd5b600080fd5b600080fd5b600080fd5b600080fd5b6000601f19601f8301169050919050565b7f6261720000000000000000000000000000000000000000000000000000000000600082015250565b6103b4816102be565b81146103bf57600080fd5b50565b603f806103d06000396000f3fe6080604052600080fdfea26469706673582212207d03b26e43dc3d116b0021ddc9817bde3762a3b14315351f11fc4be384fd14a664736f6c63430008060033" + assertBool "linker hole not detected" (containsLinkerHole code'), + testCase "no false positives" $ do + let code' = "0x608060405234801561001057600080fd5b50600436106100365760003560e01c806317bf8bac1461003b578063acffee6b1461005d575b600080fd5b610043610067565b604051808215151515815260200191505060405180910390f35b610065610073565b005b60008060015414905090565b6000809054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1663f8a8fd6d6040518163ffffffff1660e01b815260040160206040518083038186803b1580156100da57600080fd5b505afa1580156100ee573d6000803e3d6000fd5b505050506040513d602081101561010457600080fd5b810190808051906020019092919050505060018190555056fea265627a7a723158205d775f914dcb471365a430b5f5b2cfe819e615cbbb5b2f1ccc7da1fd802e43c364736f6c634300050b0032" + assertBool "false positive" (not . containsLinkerHole $ code') + ] + , testGroup "metadata stripper" [ testCase "it strips the metadata for solc => 0.6" $ do let code' = hexText "0x608060405234801561001057600080fd5b50600436106100365760003560e01c806317bf8bac1461003b578063acffee6b1461005d575b600080fd5b610043610067565b604051808215151515815260200191505060405180910390f35b610065610073565b005b60008060015414905090565b6000809054906101000a900473ffffffffffffffffffffffffffffffffffffffff1673ffffffffffffffffffffffffffffffffffffffff1663f8a8fd6d6040518163ffffffff1660e01b815260040160206040518083038186803b1580156100da57600080fd5b505afa1580156100ee573d6000803e3d6000fd5b505050506040513d602081101561010457600080fd5b810190808051906020019092919050505060018190555056fea265627a7a723158205d775f914dcb471365a430b5f5b2cfe819e615cbbb5b2f1ccc7da1fd802e43c364736f6c634300050b0032"