Skip to content

Commit

Permalink
linters, formatters, some warnings
Browse files Browse the repository at this point in the history
  • Loading branch information
@laudiacay
laudiacay committed Apr 6, 2021
1 parent cd81146 commit 7349aa6
Show file tree
Hide file tree
Showing 30 changed files with 4,555 additions and 4,274 deletions.
151 changes: 71 additions & 80 deletions src/hevm/src/EVM.hs
View file

Large diffs are not rendered by default.

565 changes: 295 additions & 270 deletions src/hevm/src/EVM/ABI.hs
View file

Large diffs are not rendered by default.

129 changes: 71 additions & 58 deletions src/hevm/src/EVM/Concrete.hs
View file
Original file line number Diff line number Diff line change
@@ -1,20 +1,17 @@
{-# Language FlexibleInstances #-}
{-# Language StrictData #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StrictData #-}

module EVM.Concrete where

import Prelude hiding (Word)

import EVM.RLP
import EVM.Types

import Control.Lens ((^?), ix)
import Data.Bits (Bits (..), shiftL, shiftR)
import Control.Lens (ix, (^?))
import Data.Bits (Bits (..), shiftL, shiftR)
import Data.ByteString (ByteString)
import Data.Maybe (fromMaybe)
import Data.Word (Word8)

import qualified Data.ByteString as BS
import Data.Maybe (fromMaybe)
import Data.Word (Word8)
import EVM.RLP
import EVM.Types
import Prelude hiding (Word)

wordAt :: Int -> ByteString -> W256
wordAt i bs =
Expand All @@ -26,14 +23,13 @@ readByteOrZero i bs = fromMaybe 0 (bs ^? ix i)
byteStringSliceWithDefaultZeroes :: Int -> Int -> ByteString -> ByteString
byteStringSliceWithDefaultZeroes offset size bs =
if size == 0
then ""
-- else if offset > BS.length bs
-- then BS.replicate size 0
-- todo: this ^^ should work, investigate why it causes more GST fails
else
let bs' = BS.take size (BS.drop offset bs)
in bs' <> BS.replicate (size - BS.length bs') 0
then ""
else -- else if offset > BS.length bs
-- then BS.replicate size 0
-- todo: this ^^ should work, investigate why it causes more GST fails

let bs' = BS.take size (BS.drop offset bs)
in bs' <> BS.replicate (size - BS.length bs') 0

wordValue :: Word -> W256
wordValue (C _ x) = x
Expand All @@ -44,39 +40,50 @@ sliceMemory o s =

writeMemory :: ByteString -> Word -> Word -> Word -> ByteString -> ByteString
writeMemory bs1 (C _ n) (C _ src) (C _ dst) bs0 =
let
(a, b) = BS.splitAt (num dst) bs0
a' = BS.replicate (num dst - BS.length a) 0
-- sliceMemory should work for both cases, but we are using 256 bit
-- words, whereas ByteString is only defined up to 64 bit. For large n,
-- src, dst this will cause problems (often in GeneralStateTests).
-- Later we could reimplement ByteString for 256 bit arguments.
c = if src > num (BS.length bs1)
then BS.replicate (num n) 0
else sliceMemory src n bs1
b' = BS.drop (num n) b
in
a <> a' <> c <> b'
let (a, b) = BS.splitAt (num dst) bs0
a' = BS.replicate (num dst - BS.length a) 0
-- sliceMemory should work for both cases, but we are using 256 bit
-- words, whereas ByteString is only defined up to 64 bit. For large n,
-- src, dst this will cause problems (often in GeneralStateTests).
-- Later we could reimplement ByteString for 256 bit arguments.
c =
if src > num (BS.length bs1)
then BS.replicate (num n) 0
else sliceMemory src n bs1
b' = BS.drop (num n) b
in a <> a' <> c <> b'

readMemoryWord :: Word -> ByteString -> Word
readMemoryWord (C _ i) m =
if i > (num $ BS.length m) then 0 else
let
go !a (-1) = a
go !a !n = go (a + shiftL (num $ readByteOrZero (num i + n) m)
(8 * (31 - n))) (n - 1)
w = go (0 :: W256) (31 :: Int)
in {-# SCC "readMemoryWord" #-}
C (Literal w) w
if i > num (BS.length m)
then 0
else
let go !a (-1) = a
go !a !n =
go
( a
+ shiftL
(num $ readByteOrZero (num i + n) m)
(8 * (31 - n))
)
(n - 1)
w = go (0 :: W256) (31 :: Int)
in {-# SCC "readMemoryWord" #-}
C (Literal w) w

readMemoryWord32 :: Word -> ByteString -> Word
readMemoryWord32 (C _ i) m =
let
go !a (-1) = a
go !a !n = go (a + shiftL (num $ readByteOrZero (num i + n) m)
(8 * (3 - n))) (n - 1)
in {-# SCC "readMemoryWord32" #-}
w256 $ go (0 :: W256) (3 :: Int)
let go !a (-1) = a
go !a !n =
go
( a
+ shiftL
(num $ readByteOrZero (num i + n) m)
(8 * (3 - n))
)
(n - 1)
in {-# SCC "readMemoryWord32" #-}
w256 $ go (0 :: W256) (3 :: Int)

setMemoryWord :: Word -> Word -> ByteString -> ByteString
setMemoryWord (C _ i) (C _ x) =
Expand All @@ -93,20 +100,26 @@ keccakBlob x = C (FromKeccak (ConcreteBuffer x)) (keccak x)
-- We also use bit operations instead of modulo and multiply.
-- (This operation was significantly slow.)
(^) :: W256 -> W256 -> W256
x0 ^ y0 | y0 < 0 = errorWithoutStackTrace "Negative exponent"
| y0 == 0 = 1
| otherwise = f x0 y0
where
f x y | not (testBit y 0) = f (x * x) (y `shiftR` 1)
| y == 1 = x
| otherwise = g (x * x) ((y - 1) `shiftR` 1) x
g x y z | not (testBit y 0) = g (x * x) (y `shiftR` 1) z
| y == 1 = x * z
| otherwise = g (x * x) ((y - 1) `shiftR` 1) (x * z)
x0 ^ y0
| y0 < 0 = errorWithoutStackTrace "Negative exponent"
| y0 == 0 = 1
| otherwise = f x0 y0
where
f x y
| not (testBit y 0) = f (x * x) (y `shiftR` 1)
| y == 1 = x
| otherwise = g (x * x) ((y - 1) `shiftR` 1) x
g x y z
| not (testBit y 0) = g (x * x) (y `shiftR` 1) z
| y == 1 = x * z
| otherwise = g (x * x) ((y - 1) `shiftR` 1) (x * z)

createAddress :: Addr -> W256 -> Addr
createAddress a n = num $ keccak $ rlpList [rlpWord160 a, rlpWord256 n]

create2Address :: Addr -> W256 -> ByteString -> Addr
create2Address a s b = num $ keccak $ mconcat
[BS.singleton 0xff, word160Bytes a, word256Bytes $ num s, word256Bytes $ keccak b]
create2Address a s b =
num $
keccak $
mconcat
[BS.singleton 0xff, word160Bytes a, word256Bytes $ num s, word256Bytes $ keccak b]
174 changes: 87 additions & 87 deletions src/hevm/src/EVM/Dapp.hs
View file
Original file line number Diff line number Diff line change
@@ -1,50 +1,61 @@
{-# Language TemplateHaskell #-}
{-# Language OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module EVM.Dapp where

import EVM (Trace, traceCodehash, traceOpIx, Env)
import EVM.ABI (Event, AbiType)
import EVM.Debug (srcMapCodePos)
import EVM.Solidity (SolcContract, CodeType (..), SourceCache (..), SrcMap, Method)
import EVM.Solidity (contractName, methodInputs)
import EVM.Solidity (runtimeCodehash, creationCodehash, abiMap)
import EVM.Solidity (runtimeSrcmap, sourceAsts, creationSrcmap, eventMap)
import EVM.Solidity (methodSignature, astIdMap, astSrcMap)
import EVM.Types (W256, abiKeccak)

import Control.Applicative ((<$>))
import Control.Arrow ((>>>))
import Control.Lens
import Data.Aeson (Value)
import Data.Bifunctor (first)
import Data.Text (Text, isPrefixOf, pack, unpack)
import Data.Text.Encoding (encodeUtf8)
import Data.Map (Map, toList)
import qualified Data.Map as Map
import Data.Maybe (fromJust, isJust)
import Data.Monoid ((<>))
import Data.Maybe (isJust, fromJust)
import qualified Data.Sequence as Seq
import Data.Text (Text, isPrefixOf, pack, unpack)
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word32)

import Control.Applicative ((<$>))
import Control.Arrow ((>>>))
import Control.Lens

import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import EVM (Env, Trace, traceCodehash, traceOpIx)
import EVM.ABI (AbiType, Event)
import EVM.Debug (srcMapCodePos)
import EVM.Solidity
( CodeType (..),
Method,
SolcContract,
SourceCache (..),
SrcMap,
abiMap,
astIdMap,
astSrcMap,
contractName,
creationCodehash,
creationSrcmap,
eventMap,
methodInputs,
methodSignature,
runtimeCodehash,
runtimeSrcmap,
sourceAsts,
)
import EVM.Types (W256, abiKeccak)
import qualified Text.Regex.TDFA as Regex

data DappInfo = DappInfo
{ _dappRoot :: FilePath
, _dappSolcByName :: Map Text SolcContract
, _dappSolcByHash :: Map W256 (CodeType, SolcContract)
, _dappSources :: SourceCache
, _dappUnitTests :: [(Text, [(Test, [AbiType])])]
, _dappAbiMap :: Map Word32 Method
, _dappEventMap :: Map W256 Event
, _dappAstIdMap :: Map Int Value
, _dappAstSrcMap :: SrcMap -> Maybe Value
{ _dappRoot :: FilePath,
_dappSolcByName :: Map Text SolcContract,
_dappSolcByHash :: Map W256 (CodeType, SolcContract),
_dappSources :: SourceCache,
_dappUnitTests :: [(Text, [(Test, [AbiType])])],
_dappAbiMap :: Map Word32 Method,
_dappEventMap :: Map W256 Event,
_dappAstIdMap :: Map Int Value,
_dappAstSrcMap :: SrcMap -> Maybe Value
}

data DappContext = DappContext
{ _contextInfo :: DappInfo
, _contextEnv :: Env
{ _contextInfo :: DappInfo,
_contextEnv :: Env
}

data Test = ConcreteTest Text | SymbolicTest Text
Expand All @@ -55,33 +66,27 @@ makeLenses ''DappContext
instance Show Test where
show t = unpack $ extractSig t

dappInfo
:: FilePath -> Map Text SolcContract -> SourceCache -> DappInfo
dappInfo ::
FilePath -> Map Text SolcContract -> SourceCache -> DappInfo
dappInfo root solcByName sources =
let
solcs = Map.elems solcByName
astIds = astIdMap $ snd <$> toList (view sourceAsts sources)

in DappInfo
{ _dappRoot = root
, _dappUnitTests = findAllUnitTests solcs
, _dappSources = sources
, _dappSolcByName = solcByName
, _dappSolcByHash =
let
f g k = Map.fromList [(view g x, (k, x)) | x <- solcs]
in
mappend
(f runtimeCodehash Runtime)
(f creationCodehash Creation)

-- Sum up the ABI maps from all the contracts.
, _dappAbiMap = mconcat (map (view abiMap) solcs)
, _dappEventMap = mconcat (map (view eventMap) solcs)

, _dappAstIdMap = astIds
, _dappAstSrcMap = astSrcMap astIds
}
let solcs = Map.elems solcByName
astIds = astIdMap $ snd <$> toList (view sourceAsts sources)
in DappInfo
{ _dappRoot = root,
_dappUnitTests = findAllUnitTests solcs,
_dappSources = sources,
_dappSolcByName = solcByName,
_dappSolcByHash =
let f g k = Map.fromList [(view g x, (k, x)) | x <- solcs]
in mappend
(f runtimeCodehash Runtime)
(f creationCodehash Creation),
-- Sum up the ABI maps from all the contracts.
_dappAbiMap = mconcat (map (view abiMap) solcs),
_dappEventMap = mconcat (map (view eventMap) solcs),
_dappAstIdMap = astIds,
_dappAstSrcMap = astSrcMap astIds
}

emptyDapp :: DappInfo
emptyDapp = dappInfo "" mempty (SourceCache mempty mempty mempty)
Expand Down Expand Up @@ -110,55 +115,50 @@ mkTest sig

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
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 ->
case preview (abiMap . ix unitTestMarkerAbi) c of
Nothing -> []
Just _ ->
Just _ ->
let testNames = unitTestMethodsFiltered (regexMatches match) c
in [(view contractName c, testNames) | not (null testNames)]
in [(view contractName c, testNames) | not (null testNames)]

unitTestMethodsFiltered :: (Text -> Bool) -> (SolcContract -> [(Test, [AbiType])])
unitTestMethodsFiltered matcher c =
let
testName method = (view contractName c) <> "." <> (extractSig (fst method))
in
filter (matcher . testName) (unitTestMethods c)
let testName method = view contractName c <> "." <> extractSig (fst method)
in filter (matcher . testName) (unitTestMethods c)

unitTestMethods :: SolcContract -> [(Test, [AbiType])]
unitTestMethods =
view abiMap
>>> Map.elems
>>> map (\f -> (mkTest $ view methodSignature f, snd <$> view methodInputs f))
>>> filter (isJust . fst)
>>> fmap (first fromJust)
>>> Map.elems
>>> map (\f -> (mkTest $ view methodSignature f, snd <$> view methodInputs f))
>>> filter (isJust . fst)
>>> fmap (first fromJust)

extractSig :: Test -> Text
extractSig (ConcreteTest sig) = sig
extractSig (SymbolicTest sig) = sig

traceSrcMap :: DappInfo -> Trace -> Maybe SrcMap
traceSrcMap dapp trace =
let
h = view traceCodehash trace
i = view traceOpIx trace
in case preview (dappSolcByHash . ix h) dapp of
Nothing ->
Nothing
Just (Creation, solc) ->
i >>= \i' -> preview (creationSrcmap . ix i') solc
Just (Runtime, solc) ->
i >>= \i' -> preview (runtimeSrcmap . ix i') solc
let h = view traceCodehash trace
i = view traceOpIx trace
in case preview (dappSolcByHash . ix h) dapp of
Nothing ->
Nothing
Just (Creation, solc) ->
i >>= \i' -> preview (creationSrcmap . ix i') solc
Just (Runtime, solc) ->
i >>= \i' -> preview (runtimeSrcmap . ix i') solc

showTraceLocation :: DappInfo -> Trace -> Either Text Text
showTraceLocation dapp trace =
Expand Down
Loading

0 comments on commit 7349aa6

Please sign in to comment.