mirror of https://github.com/crytic/echidna
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
149 lines
6.3 KiB
149 lines
6.3 KiB
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
module Echidna.Processor where
|
|
|
|
import Control.Monad.IO.Class (MonadIO(..))
|
|
import Control.Exception (Exception)
|
|
import Control.Monad.Catch (MonadThrow(..))
|
|
import Data.Aeson ((.:), (.:?), (.!=), decode, parseJSON, withEmbeddedJSON, withObject)
|
|
import Data.Aeson.Types (FromJSON, Parser, Value(String))
|
|
import Data.ByteString.Base16 qualified as BS16 (decode)
|
|
import Data.ByteString.Lazy.Char8 qualified as BSL
|
|
import Data.ByteString.UTF8 qualified as BSU
|
|
import Data.Either (fromRight)
|
|
import Data.HashMap.Strict qualified as M
|
|
import Data.List (nub, isPrefixOf)
|
|
import Data.List.NonEmpty qualified as NE
|
|
import Data.Maybe (catMaybes, fromMaybe)
|
|
import Data.SemVer (Version, fromText)
|
|
import Data.Text (pack, isSuffixOf)
|
|
import System.Directory (findExecutable)
|
|
import System.Process (StdStream(..), readCreateProcessWithExitCode, proc, std_err)
|
|
import System.Exit (ExitCode(..))
|
|
import Text.Read (readMaybe)
|
|
|
|
import EVM.ABI (AbiValue(..))
|
|
import EVM.Types (Addr(..))
|
|
|
|
import Echidna.ABI (hashSig, makeNumAbiValues, makeArrayAbiValues)
|
|
import Echidna.Types.Signature (ContractName, FunctionName, FunctionHash)
|
|
|
|
-- | Things that can go wrong trying to run a processor. Read the 'Show'
|
|
-- instance for more detailed explanations.
|
|
data ProcException = ProcessorFailure String String
|
|
| ProcessorNotFound String String
|
|
|
|
instance Show ProcException where
|
|
show = \case
|
|
ProcessorFailure p e -> "Error running " ++ p ++ ":\n" ++ e
|
|
ProcessorNotFound p e -> "Cannot find " ++ p ++ "in PATH.\n" ++ e
|
|
|
|
instance Exception ProcException
|
|
|
|
-- | This function is used to filter the lists of function names according to the supplied
|
|
-- contract name (if any) and returns a list of hashes
|
|
filterResults :: Maybe ContractName -> M.HashMap ContractName [FunctionName] -> [FunctionHash]
|
|
filterResults (Just c) rs =
|
|
case M.lookup c rs of
|
|
Nothing -> filterResults Nothing rs
|
|
Just s -> hashSig <$> s
|
|
filterResults Nothing rs = hashSig <$> (concat . M.elems) rs
|
|
|
|
enhanceConstants :: SlitherInfo -> [AbiValue]
|
|
enhanceConstants si =
|
|
nub . concatMap enh . concat . concat . M.elems $ M.elems <$> constantValues si
|
|
where
|
|
enh (AbiUInt _ n) = makeNumAbiValues (fromIntegral n)
|
|
enh (AbiInt _ n) = makeNumAbiValues (fromIntegral n)
|
|
enh (AbiString s) = makeArrayAbiValues s
|
|
enh v = [v]
|
|
|
|
-- we loose info on what constants are in which functions
|
|
data SlitherInfo = SlitherInfo
|
|
{ payableFunctions :: M.HashMap ContractName [FunctionName]
|
|
, constantFunctions :: M.HashMap ContractName [FunctionName]
|
|
, asserts :: M.HashMap ContractName [FunctionName]
|
|
, constantValues :: M.HashMap ContractName (M.HashMap FunctionName [AbiValue])
|
|
, generationGraph :: M.HashMap ContractName (M.HashMap FunctionName [FunctionName])
|
|
, solcVersions :: [Version]
|
|
, fallbackDefined :: [ContractName]
|
|
, receiveDefined :: [ContractName]
|
|
} deriving (Show)
|
|
|
|
noInfo :: SlitherInfo
|
|
noInfo = SlitherInfo mempty mempty mempty mempty mempty [] [] []
|
|
|
|
instance FromJSON SlitherInfo where
|
|
parseJSON = withObject "slitherOutput" $ \o -> do
|
|
-- take the value under 'description' through the path - $['results']['printers'][0]['description']
|
|
results <- o .: "results"
|
|
printer <- NE.head <$> results .: "printers" -- there must be at least one printer
|
|
description <- printer .: "description"
|
|
-- description is a JSON string, needs additional parsing
|
|
withEmbeddedJSON "descriptionString" parseDescription (String description)
|
|
where
|
|
parseDescription = withObject "description" $ \o -> do
|
|
payableFunctions <- o .: "payable"
|
|
constantFunctions <- o .: "constant_functions"
|
|
asserts <- o .: "assert"
|
|
fallbackDefined <- o .:? "with_fallback" .!= ["*"]
|
|
receiveDefined <- o .:? "with_receive" .!= ["*"]
|
|
constantValues'
|
|
-- the type annotation is needed
|
|
:: M.HashMap ContractName (M.HashMap FunctionName [[Maybe AbiValue]])
|
|
<- o .: "constants_used" >>= (traverse . traverse . traverse . traverse) parseConstant
|
|
-- flatten [[AbiValue]], the array probably shouldn't be nested, fix it in Slither
|
|
let constantValues = (fmap . fmap) (catMaybes . concat) constantValues'
|
|
functionsRelations <- o .: "functions_relations"
|
|
generationGraph <- (traverse . traverse) (withObject "relations" (.: "impacts")) functionsRelations
|
|
solcVersions' <- o .:? "solc_versions"
|
|
solcVersions <- case mapM (fromText . pack) (fromMaybe [] solcVersions') of
|
|
Left _ -> pure []
|
|
Right versions -> pure versions
|
|
pure SlitherInfo {..}
|
|
|
|
parseConstant :: Value -> Parser (Maybe AbiValue)
|
|
parseConstant = withObject "const" $ \o -> do
|
|
v <- o .: "value"
|
|
t <- o .: "type"
|
|
case t of
|
|
'u':'i':'n':'t':x ->
|
|
case AbiUInt <$> readMaybe x <*> readMaybe v of
|
|
Nothing -> failure v t
|
|
i -> pure i
|
|
|
|
'i':'n':'t':x ->
|
|
case AbiInt <$> readMaybe x <*> readMaybe v of
|
|
Nothing -> failure v t
|
|
i -> pure i
|
|
|
|
"string" ->
|
|
pure . Just . AbiString $
|
|
if "0x" `isPrefixOf` v
|
|
then fromRight (error ("invalid b16 decoding of: " ++ show v)) $ BS16.decode $ BSU.fromString $ drop 2 v
|
|
else BSU.fromString v
|
|
|
|
"address" ->
|
|
case AbiAddress . Addr <$> readMaybe v of
|
|
Nothing -> failure v t
|
|
a -> pure a
|
|
|
|
-- we don't need all the types for now
|
|
_ -> pure Nothing
|
|
where failure v t = fail $ "failed to parse " ++ t ++ ": " ++ v
|
|
|
|
-- Slither processing
|
|
runSlither :: (MonadIO m, MonadThrow m) => FilePath -> [String] -> m SlitherInfo
|
|
runSlither fp extraArgs = if ".vy" `isSuffixOf` pack fp then return noInfo else do
|
|
mp <- liftIO $ findExecutable "slither"
|
|
case mp of
|
|
Nothing -> throwM $ ProcessorNotFound "slither" "You should install it using 'pip3 install slither-analyzer --user'"
|
|
Just path -> liftIO $ do
|
|
let args = ["--ignore-compile", "--print", "echidna", "--json", "-"] ++ extraArgs ++ [fp]
|
|
(ec, out, err) <- readCreateProcessWithExitCode (proc path args) {std_err = Inherit} ""
|
|
case ec of
|
|
ExitSuccess ->
|
|
case decode (BSL.pack out) of
|
|
Just si -> pure si
|
|
Nothing -> throwM $ ProcessorFailure "slither" "decoding slither output failed"
|
|
ExitFailure _ -> throwM $ ProcessorFailure "slither" err
|
|
|