module EVM.Dapp where
import EVM.Concrete
import EVM.Debug (srcMapCodePos)
import EVM.Solidity
import EVM.Types
import EVM.ABI
import Control.Arrow ((>>>))
import Data.Aeson (Value)
import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.List (find, sort)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (isJust, fromJust, mapMaybe)
import Data.Sequence qualified as Seq
import Data.Text (Text, isPrefixOf, pack, unpack)
import Data.Text.Encoding (encodeUtf8)
import Data.Vector qualified as V
data DappInfo = DappInfo
{ DappInfo -> FilePath
root :: FilePath
, DappInfo -> Map Text SolcContract
solcByName :: Map Text SolcContract
, DappInfo -> Map W256 (CodeType, SolcContract)
solcByHash :: Map W256 (CodeType, SolcContract)
, DappInfo -> [(Code, SolcContract)]
solcByCode :: [(Code, SolcContract)]
, DappInfo -> SourceCache
sources :: SourceCache
, DappInfo -> [(Text, [(Test, [AbiType])])]
unitTests :: [(Text, [(Test, [AbiType])])]
, DappInfo -> Map FunctionSelector Method
abiMap :: Map FunctionSelector Method
, DappInfo -> Map W256 Event
eventMap :: Map W256 Event
, DappInfo -> Map W256 SolError
errorMap :: Map W256 SolError
, DappInfo -> Map Int Value
astIdMap :: Map Int Value
, DappInfo -> SrcMap -> Maybe Value
astSrcMap :: SrcMap -> Maybe Value
}
data Code = Code
{ Code -> ByteString
raw :: ByteString
, Code -> [Reference]
immutableLocations :: [Reference]
}
deriving Int -> Code -> ShowS
[Code] -> ShowS
Code -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Code] -> ShowS
$cshowList :: [Code] -> ShowS
show :: Code -> FilePath
$cshow :: Code -> FilePath
showsPrec :: Int -> Code -> ShowS
$cshowsPrec :: Int -> Code -> ShowS
Show
data DappContext = DappContext
{ DappContext -> DappInfo
info :: DappInfo
, DappContext -> Map Addr Contract
env :: Map Addr Contract
}
data Test = ConcreteTest Text | SymbolicTest Text | InvariantTest Text
instance Show Test where
show :: Test -> FilePath
show Test
t = Text -> FilePath
unpack forall a b. (a -> b) -> a -> b
$ Test -> Text
extractSig Test
t
dappInfo :: FilePath -> BuildOutput -> DappInfo
dappInfo :: FilePath -> BuildOutput -> DappInfo
dappInfo FilePath
root (BuildOutput (Contracts Map Text SolcContract
cs) SourceCache
sources) =
let
solcs :: [SolcContract]
solcs = forall k a. Map k a -> [a]
Map.elems Map Text SolcContract
cs
astIds :: Map Int Value
astIds = forall (f :: * -> *). Foldable f => f Value -> Map Int Value
astIdMap forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [(k, a)]
Map.toList SourceCache
sources.asts
immutables :: [SolcContract]
immutables = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(/=) forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.immutableReferences)) [SolcContract]
solcs
in DappInfo
{ $sel:root:DappInfo :: FilePath
root = FilePath
root
, $sel:unitTests:DappInfo :: [(Text, [(Test, [AbiType])])]
unitTests = [SolcContract] -> [(Text, [(Test, [AbiType])])]
findAllUnitTests [SolcContract]
solcs
, $sel:sources:DappInfo :: SourceCache
sources = SourceCache
sources
, $sel:solcByName:DappInfo :: Map Text SolcContract
solcByName = Map Text SolcContract
cs
, $sel:solcByHash:DappInfo :: Map W256 (CodeType, SolcContract)
solcByHash =
let
f :: (SolcContract -> W256)
-> CodeType -> Map W256 (CodeType, SolcContract)
f SolcContract -> W256
g CodeType
k = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(SolcContract -> W256
g SolcContract
x, (CodeType
k, SolcContract
x)) | SolcContract
x <- [SolcContract]
solcs]
in
forall a. Monoid a => a -> a -> a
mappend
((SolcContract -> W256)
-> CodeType -> Map W256 (CodeType, SolcContract)
f (.runtimeCodehash) CodeType
Runtime)
((SolcContract -> W256)
-> CodeType -> Map W256 (CodeType, SolcContract)
f (.creationCodehash) CodeType
Creation)
, $sel:solcByCode:DappInfo :: [(Code, SolcContract)]
solcByCode =
[(ByteString -> [Reference] -> Code
Code SolcContract
x.runtimeCode (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems SolcContract
x.immutableReferences), SolcContract
x) | SolcContract
x <- [SolcContract]
immutables]
, $sel:abiMap:DappInfo :: Map FunctionSelector Method
abiMap = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (.abiMap) [SolcContract]
solcs)
, $sel:eventMap:DappInfo :: Map W256 Event
eventMap = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (.eventMap) [SolcContract]
solcs)
, $sel:errorMap:DappInfo :: Map W256 SolError
errorMap = forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (.errorMap) [SolcContract]
solcs)
, $sel:astIdMap:DappInfo :: Map Int Value
astIdMap = Map Int Value
astIds
, $sel:astSrcMap:DappInfo :: SrcMap -> Maybe Value
astSrcMap = Map Int Value -> SrcMap -> Maybe Value
astSrcMap Map Int Value
astIds
}
emptyDapp :: DappInfo
emptyDapp :: DappInfo
emptyDapp = FilePath -> BuildOutput -> DappInfo
dappInfo FilePath
"" forall a. Monoid a => a
mempty
unitTestMarkerAbi :: FunctionSelector
unitTestMarkerAbi :: FunctionSelector
unitTestMarkerAbi = ByteString -> FunctionSelector
abiKeccak (Text -> ByteString
encodeUtf8 Text
"IS_TEST()")
findAllUnitTests :: [SolcContract] -> [(Text, [(Test, [AbiType])])]
findAllUnitTests :: [SolcContract] -> [(Text, [(Test, [AbiType])])]
findAllUnitTests = Text -> [SolcContract] -> [(Text, [(Test, [AbiType])])]
findUnitTests Text
".*:.*\\.(test|prove|invariant).*"
mkTest :: Text -> Maybe Test
mkTest :: Text -> Maybe Test
mkTest Text
sig
| Text
"test" Text -> Text -> Bool
`isPrefixOf` Text
sig = forall a. a -> Maybe a
Just (Text -> Test
ConcreteTest Text
sig)
| Text
"prove" Text -> Text -> Bool
`isPrefixOf` Text
sig = forall a. a -> Maybe a
Just (Text -> Test
SymbolicTest Text
sig)
| Text
"invariant" Text -> Text -> Bool
`isPrefixOf` Text
sig = forall a. a -> Maybe a
Just (Text -> Test
InvariantTest Text
sig)
| Bool
otherwise = forall a. Maybe a
Nothing
findUnitTests :: Text -> ([SolcContract] -> [(Text, [(Test, [AbiType])])])
findUnitTests :: Text -> [SolcContract] -> [(Text, [(Test, [AbiType])])]
findUnitTests Text
match =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a -> b) -> a -> b
$ \SolcContract
c ->
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionSelector
unitTestMarkerAbi SolcContract
c.abiMap of
Maybe Method
Nothing -> []
Just Method
_ ->
let testNames :: [(Test, [AbiType])]
testNames = (Text -> Bool) -> SolcContract -> [(Test, [AbiType])]
unitTestMethodsFiltered (Text -> Text -> Bool
regexMatches Text
match) SolcContract
c
in [(SolcContract
c.contractName, [(Test, [AbiType])]
testNames) | Bool -> Bool
not (ByteString -> Bool
BS.null SolcContract
c.runtimeCode) Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Test, [AbiType])]
testNames)]
unitTestMethodsFiltered :: (Text -> Bool) -> (SolcContract -> [(Test, [AbiType])])
unitTestMethodsFiltered :: (Text -> Bool) -> SolcContract -> [(Test, [AbiType])]
unitTestMethodsFiltered Text -> Bool
matcher SolcContract
c =
let
testName :: (Test, [AbiType]) -> Text
testName (Test, [AbiType])
method = SolcContract
c.contractName forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> (Test -> Text
extractSig (forall a b. (a, b) -> a
fst (Test, [AbiType])
method))
in
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Bool
matcher forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Test, [AbiType]) -> Text
testName) (SolcContract -> [(Test, [AbiType])]
unitTestMethods SolcContract
c)
unitTestMethods :: SolcContract -> [(Test, [AbiType])]
unitTestMethods :: SolcContract -> [(Test, [AbiType])]
unitTestMethods =
(.abiMap)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall k a. Map k a -> [a]
Map.elems
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a b. (a -> b) -> [a] -> [b]
map (\Method
f -> (Text -> Maybe Test
mkTest Method
f.methodSignature, forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Method
f.inputs))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. HasCallStack => Maybe a -> a
fromJust)
extractSig :: Test -> Text
(ConcreteTest Text
sig) = Text
sig
extractSig (SymbolicTest Text
sig) = Text
sig
extractSig (InvariantTest Text
sig) = Text
sig
traceSrcMap :: DappInfo -> Trace -> Maybe SrcMap
traceSrcMap :: DappInfo -> Trace -> Maybe SrcMap
traceSrcMap DappInfo
dapp Trace
trace = DappInfo -> Contract -> Int -> Maybe SrcMap
srcMap DappInfo
dapp Trace
trace.contract Trace
trace.opIx
srcMap :: DappInfo -> Contract -> Int -> Maybe SrcMap
srcMap :: DappInfo -> Contract -> Int -> Maybe SrcMap
srcMap DappInfo
dapp Contract
contr Int
opIndex = do
SolcContract
sol <- Contract -> DappInfo -> Maybe SolcContract
findSrc Contract
contr DappInfo
dapp
case Contract
contr.contractcode of
(InitCode ByteString
_ Expr 'Buf
_) ->
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
opIndex SolcContract
sol.creationSrcmap
(RuntimeCode RuntimeCode
_) ->
forall a. Int -> Seq a -> Maybe a
Seq.lookup Int
opIndex SolcContract
sol.runtimeSrcmap
findSrc :: Contract -> DappInfo -> Maybe SolcContract
findSrc :: Contract -> DappInfo -> Maybe SolcContract
findSrc Contract
c DappInfo
dapp = do
W256
hash <- Expr 'EWord -> Maybe W256
maybeLitWord Contract
c.codehash
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup W256
hash DappInfo
dapp.solcByHash of
Just (CodeType
_, SolcContract
v) -> forall a. a -> Maybe a
Just SolcContract
v
Maybe (CodeType, SolcContract)
Nothing -> ContractCode -> DappInfo -> Maybe SolcContract
lookupCode Contract
c.contractcode DappInfo
dapp
lookupCode :: ContractCode -> DappInfo -> Maybe SolcContract
lookupCode :: ContractCode -> DappInfo -> Maybe SolcContract
lookupCode (InitCode ByteString
c Expr 'Buf
_) DappInfo
a =
forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
c)) DappInfo
a.solcByHash
lookupCode (RuntimeCode (ConcreteRuntimeCode ByteString
c)) DappInfo
a =
case forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
c)) DappInfo
a.solcByHash of
Just SolcContract
x -> forall (m :: * -> *) a. Monad m => a -> m a
return SolcContract
x
Maybe SolcContract
Nothing -> forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ByteString -> Code -> Bool
compareCode ByteString
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) DappInfo
a.solcByCode
lookupCode (RuntimeCode (SymbolicRuntimeCode Vector (Expr 'Byte)
c)) DappInfo
a = let
code :: ByteString
code = [Word8] -> ByteString
BS.pack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Expr 'Byte -> Maybe Word8
maybeLitByte forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Vector (Expr 'Byte)
c
in case forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ByteString -> W256
keccak' (ByteString -> ByteString
stripBytecodeMetadata ByteString
code)) DappInfo
a.solcByHash of
Just SolcContract
x -> forall (m :: * -> *) a. Monad m => a -> m a
return SolcContract
x
Maybe SolcContract
Nothing -> forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ByteString -> Code -> Bool
compareCode ByteString
code forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) DappInfo
a.solcByCode
compareCode :: ByteString -> Code -> Bool
compareCode :: ByteString -> Code -> Bool
compareCode ByteString
raw (Code ByteString
template [Reference]
locs) =
let holes' :: [(Int, Int)]
holes' = forall a. Ord a => [a] -> [a]
sort [(Int
start, Int
len) | (Reference Int
start Int
len) <- [Reference]
locs]
insert :: a -> Int -> ByteString -> ByteString
insert a
at' Int
len' ByteString
bs = ByteString -> W256 -> W256 -> W256 -> ByteString -> ByteString
writeMemory (Int -> Word8 -> ByteString
BS.replicate Int
len' Word8
0) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len') W256
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
at') ByteString
bs
refined :: ByteString
refined = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
start, Int
len) ByteString
acc -> forall {a}. Integral a => a -> Int -> ByteString -> ByteString
insert Int
start Int
len ByteString
acc) ByteString
raw [(Int, Int)]
holes'
in ByteString -> Int
BS.length ByteString
raw forall a. Eq a => a -> a -> Bool
== ByteString -> Int
BS.length ByteString
template Bool -> Bool -> Bool
&& ByteString
template forall a. Eq a => a -> a -> Bool
== ByteString
refined
showTraceLocation :: DappInfo -> Trace -> Either Text Text
showTraceLocation :: DappInfo -> Trace -> Either Text Text
showTraceLocation DappInfo
dapp Trace
trace =
case DappInfo -> Trace -> Maybe SrcMap
traceSrcMap DappInfo
dapp Trace
trace of
Maybe SrcMap
Nothing -> forall a b. a -> Either a b
Left Text
"<no source map>"
Just SrcMap
sm ->
case SourceCache -> SrcMap -> Maybe (FilePath, Int)
srcMapCodePos DappInfo
dapp.sources SrcMap
sm of
Maybe (FilePath, Int)
Nothing -> forall a b. a -> Either a b
Left Text
"<source not found>"
Just (FilePath
fileName, Int
lineIx) ->
forall a b. b -> Either a b
Right (FilePath -> Text
pack FilePath
fileName forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
pack (forall a. Show a => a -> FilePath
show Int
lineIx))