{-# Language TemplateHaskell #-}
{-# Language OverloadedStrings #-}

module EVM.Dapp where

import EVM (Trace, traceContract, traceOpIx, ContractCode(..), Contract(..), codehash, contractcode)
import EVM.ABI (Event, AbiType)
import EVM.Debug (srcMapCodePos)
import EVM.Solidity
import EVM.Types (W256, abiKeccak, keccak, Buffer(..), Addr)
import EVM.Concrete

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
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, elems)
import Data.List (sort)
import Data.Maybe (isJust, fromJust)
import Data.Word (Word32)

import Control.Arrow ((>>>))
import Control.Lens

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
  { DappInfo -> FilePath
_dappRoot       :: FilePath
  , DappInfo -> Map Text SolcContract
_dappSolcByName :: Map Text SolcContract
  , DappInfo -> Map W256 (CodeType, SolcContract)
_dappSolcByHash :: Map W256 (CodeType, SolcContract)
  , DappInfo -> [(Code, SolcContract)]
_dappSolcByCode :: [(Code, SolcContract)] -- for contracts with `immutable` vars.
  , DappInfo -> SourceCache
_dappSources    :: SourceCache
  , DappInfo -> [(Text, [(Test, [AbiType])])]
_dappUnitTests  :: [(Text, [(Test, [AbiType])])]
  , DappInfo -> Map Word32 Method
_dappAbiMap     :: Map Word32 Method
  , DappInfo -> Map W256 Event
_dappEventMap   :: Map W256 Event
  , DappInfo -> Map Int Value
_dappAstIdMap   :: Map Int Value
  , DappInfo -> SrcMap -> Maybe Value
_dappAstSrcMap  :: SrcMap -> Maybe Value
  }

-- | bytecode modulo immutables, to identify contracts
data Code =
  Code {
    Code -> ByteString
raw :: ByteString,
    Code -> [Reference]
immutableLocations :: [Reference]
  }
  deriving Int -> Code -> ShowS
[Code] -> ShowS
Code -> FilePath
(Int -> Code -> ShowS)
-> (Code -> FilePath) -> ([Code] -> ShowS) -> Show Code
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
_contextInfo :: DappInfo
  , DappContext -> Map Addr Contract
_contextEnv  :: Map Addr Contract
  }

data Test = ConcreteTest Text | SymbolicTest Text | InvariantTest Text

makeLenses ''DappInfo
makeLenses ''DappContext

instance Show Test where
  show :: Test -> FilePath
show Test
t = Text -> FilePath
unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Test -> Text
extractSig Test
t

dappInfo
  :: FilePath -> Map Text SolcContract -> SourceCache -> DappInfo
dappInfo :: FilePath -> Map Text SolcContract -> SourceCache -> DappInfo
dappInfo FilePath
root Map Text SolcContract
solcByName SourceCache
sources =
  let
    solcs :: [SolcContract]
solcs = Map Text SolcContract -> [SolcContract]
forall k a. Map k a -> [a]
Map.elems Map Text SolcContract
solcByName
    astIds :: Map Int Value
astIds = [Value] -> Map Int Value
forall (f :: * -> *). Foldable f => f Value -> Map Int Value
astIdMap ([Value] -> Map Int Value) -> [Value] -> Map Int Value
forall a b. (a -> b) -> a -> b
$ (Text, Value) -> Value
forall a b. (a, b) -> b
snd ((Text, Value) -> Value) -> [(Text, Value)] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text Value -> [(Text, Value)]
forall k a. Map k a -> [(k, a)]
toList (Getting (Map Text Value) SourceCache (Map Text Value)
-> SourceCache -> Map Text Value
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Text Value) SourceCache (Map Text Value)
Lens' SourceCache (Map Text Value)
sourceAsts SourceCache
sources)
    immutables :: [SolcContract]
immutables = (SolcContract -> Bool) -> [SolcContract] -> [SolcContract]
forall a. (a -> Bool) -> [a] -> [a]
filter (Map W256 [Reference] -> Map W256 [Reference] -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Map W256 [Reference]
forall a. Monoid a => a
mempty (Map W256 [Reference] -> Bool)
-> (SolcContract -> Map W256 [Reference]) -> SolcContract -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolcContract -> Map W256 [Reference]
_immutableReferences) [SolcContract]
solcs

  in DappInfo :: FilePath
-> Map Text SolcContract
-> Map W256 (CodeType, SolcContract)
-> [(Code, SolcContract)]
-> SourceCache
-> [(Text, [(Test, [AbiType])])]
-> Map Word32 Method
-> Map W256 Event
-> Map Int Value
-> (SrcMap -> Maybe Value)
-> DappInfo
DappInfo
    { _dappRoot :: FilePath
_dappRoot = FilePath
root
    , _dappUnitTests :: [(Text, [(Test, [AbiType])])]
_dappUnitTests = [SolcContract] -> [(Text, [(Test, [AbiType])])]
findAllUnitTests [SolcContract]
solcs
    , _dappSources :: SourceCache
_dappSources = SourceCache
sources
    , _dappSolcByName :: Map Text SolcContract
_dappSolcByName = Map Text SolcContract
solcByName
    , _dappSolcByHash :: Map W256 (CodeType, SolcContract)
_dappSolcByHash =
        let
          f :: Getting W256 SolcContract W256
-> CodeType -> Map W256 (CodeType, SolcContract)
f Getting W256 SolcContract W256
g CodeType
k = [(W256, (CodeType, SolcContract))]
-> Map W256 (CodeType, SolcContract)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Getting W256 SolcContract W256 -> SolcContract -> W256
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting W256 SolcContract W256
g SolcContract
x, (CodeType
k, SolcContract
x)) | SolcContract
x <- [SolcContract]
solcs]
        in
          Map W256 (CodeType, SolcContract)
-> Map W256 (CodeType, SolcContract)
-> Map W256 (CodeType, SolcContract)
forall a. Monoid a => a -> a -> a
mappend
           (Getting W256 SolcContract W256
-> CodeType -> Map W256 (CodeType, SolcContract)
f Getting W256 SolcContract W256
Lens' SolcContract W256
runtimeCodehash  CodeType
Runtime)
           (Getting W256 SolcContract W256
-> CodeType -> Map W256 (CodeType, SolcContract)
f Getting W256 SolcContract W256
Lens' SolcContract W256
creationCodehash CodeType
Creation)
      -- contracts with immutable locations can't be id by hash
    , _dappSolcByCode :: [(Code, SolcContract)]
_dappSolcByCode =
      [(ByteString -> [Reference] -> Code
Code (SolcContract -> ByteString
_runtimeCode SolcContract
x) ([[Reference]] -> [Reference]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Reference]] -> [Reference]) -> [[Reference]] -> [Reference]
forall a b. (a -> b) -> a -> b
$ Map W256 [Reference] -> [[Reference]]
forall k a. Map k a -> [a]
elems (Map W256 [Reference] -> [[Reference]])
-> Map W256 [Reference] -> [[Reference]]
forall a b. (a -> b) -> a -> b
$ SolcContract -> Map W256 [Reference]
_immutableReferences SolcContract
x), SolcContract
x) | SolcContract
x <- [SolcContract]
immutables]
      -- Sum up the ABI maps from all the contracts.
    , _dappAbiMap :: Map Word32 Method
_dappAbiMap   = [Map Word32 Method] -> Map Word32 Method
forall a. Monoid a => [a] -> a
mconcat ((SolcContract -> Map Word32 Method)
-> [SolcContract] -> [Map Word32 Method]
forall a b. (a -> b) -> [a] -> [b]
map (Getting (Map Word32 Method) SolcContract (Map Word32 Method)
-> SolcContract -> Map Word32 Method
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Word32 Method) SolcContract (Map Word32 Method)
Lens' SolcContract (Map Word32 Method)
abiMap) [SolcContract]
solcs)
    , _dappEventMap :: Map W256 Event
_dappEventMap = [Map W256 Event] -> Map W256 Event
forall a. Monoid a => [a] -> a
mconcat ((SolcContract -> Map W256 Event)
-> [SolcContract] -> [Map W256 Event]
forall a b. (a -> b) -> [a] -> [b]
map (Getting (Map W256 Event) SolcContract (Map W256 Event)
-> SolcContract -> Map W256 Event
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map W256 Event) SolcContract (Map W256 Event)
Lens' SolcContract (Map W256 Event)
eventMap) [SolcContract]
solcs)

    , _dappAstIdMap :: Map Int Value
_dappAstIdMap  = Map Int Value
astIds
    , _dappAstSrcMap :: SrcMap -> Maybe Value
_dappAstSrcMap = Map Int Value -> SrcMap -> Maybe Value
astSrcMap Map Int Value
astIds
    }

emptyDapp :: DappInfo
emptyDapp :: DappInfo
emptyDapp = FilePath -> Map Text SolcContract -> SourceCache -> DappInfo
dappInfo FilePath
"" Map Text SolcContract
forall a. Monoid a => a
mempty ([(Text, ByteString)]
-> [Vector ByteString] -> Map Text Value -> SourceCache
SourceCache [(Text, ByteString)]
forall a. Monoid a => a
mempty [Vector ByteString]
forall a. Monoid a => a
mempty Map Text Value
forall a. Monoid a => a
mempty)

-- Dapp unit tests are detected by searching within abi methods
-- that begin with "test" or "prove", that are in a contract with
-- the "IS_TEST()" abi marker, for a given regular expression.
--
-- The regex is matched on the full test method name, including path
-- and contract, i.e. "path/to/file.sol:TestContract.test_name()".
--
-- Tests beginning with "test" are interpreted as concrete tests, whereas
-- tests beginning with "prove" are interpreted as symbolic tests.

unitTestMarkerAbi :: Word32
unitTestMarkerAbi :: Word32
unitTestMarkerAbi = ByteString -> Word32
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 = Test -> Maybe Test
forall a. a -> Maybe a
Just (Text -> Test
ConcreteTest Text
sig)
  | Text
"prove" Text -> Text -> Bool
`isPrefixOf` Text
sig = Test -> Maybe Test
forall a. a -> Maybe a
Just (Text -> Test
SymbolicTest Text
sig)
  | Text
"invariant" Text -> Text -> Bool
`isPrefixOf` Text
sig = Test -> Maybe Test
forall a. a -> Maybe a
Just (Text -> Test
InvariantTest Text
sig)
  | Bool
otherwise = Maybe Test
forall a. Maybe a
Nothing

regexMatches :: Text -> Text -> Bool
regexMatches :: Text -> Text -> Bool
regexMatches Text
regexSource =
  let
    compOpts :: CompOption
compOpts =
      CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
Regex.defaultCompOpt { lastStarGreedy :: Bool
Regex.lastStarGreedy = Bool
True }
    execOpts :: ExecOption
execOpts =
      ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
Regex.defaultExecOpt { captureGroups :: Bool
Regex.captureGroups = Bool
False }
    regex :: Regex
regex = CompOption -> ExecOption -> FilePath -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
Regex.makeRegexOpts CompOption
compOpts ExecOption
execOpts (Text -> FilePath
unpack Text
regexSource)
  in
    Regex -> Seq Char -> Bool
forall regex source.
RegexLike regex source =>
regex -> source -> Bool
Regex.matchTest Regex
regex (Seq Char -> Bool) -> (Text -> Seq Char) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Seq Char
forall a. [a] -> Seq a
Seq.fromList (FilePath -> Seq Char) -> (Text -> FilePath) -> Text -> Seq Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack

findUnitTests :: Text -> ([SolcContract] -> [(Text, [(Test, [AbiType])])])
findUnitTests :: Text -> [SolcContract] -> [(Text, [(Test, [AbiType])])]
findUnitTests Text
match =
  (SolcContract -> [(Text, [(Test, [AbiType])])])
-> [SolcContract] -> [(Text, [(Test, [AbiType])])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SolcContract -> [(Text, [(Test, [AbiType])])])
 -> [SolcContract] -> [(Text, [(Test, [AbiType])])])
-> (SolcContract -> [(Text, [(Test, [AbiType])])])
-> [SolcContract]
-> [(Text, [(Test, [AbiType])])]
forall a b. (a -> b) -> a -> b
$ \SolcContract
c ->
    case Getting (First Method) SolcContract Method
-> SolcContract -> Maybe Method
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Map Word32 Method -> Const (First Method) (Map Word32 Method))
-> SolcContract -> Const (First Method) SolcContract
Lens' SolcContract (Map Word32 Method)
abiMap ((Map Word32 Method -> Const (First Method) (Map Word32 Method))
 -> SolcContract -> Const (First Method) SolcContract)
-> ((Method -> Const (First Method) Method)
    -> Map Word32 Method -> Const (First Method) (Map Word32 Method))
-> Getting (First Method) SolcContract Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Word32 Method)
-> Traversal' (Map Word32 Method) (IxValue (Map Word32 Method))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Word32
Index (Map Word32 Method)
unitTestMarkerAbi) SolcContract
c 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 [(Getting Text SolcContract Text -> SolcContract -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text SolcContract Text
Lens' SolcContract Text
contractName SolcContract
c, [(Test, [AbiType])]
testNames) | Bool -> Bool
not ([(Test, [AbiType])] -> Bool
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 = (Getting Text SolcContract Text -> SolcContract -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text SolcContract Text
Lens' SolcContract Text
contractName SolcContract
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Test -> Text
extractSig ((Test, [AbiType]) -> Test
forall a b. (a, b) -> a
fst (Test, [AbiType])
method))
  in
    ((Test, [AbiType]) -> Bool)
-> [(Test, [AbiType])] -> [(Test, [AbiType])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Bool
matcher (Text -> Bool)
-> ((Test, [AbiType]) -> Text) -> (Test, [AbiType]) -> Bool
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 =
  Getting (Map Word32 Method) SolcContract (Map Word32 Method)
-> SolcContract -> Map Word32 Method
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Word32 Method) SolcContract (Map Word32 Method)
Lens' SolcContract (Map Word32 Method)
abiMap
  (SolcContract -> Map Word32 Method)
-> (Map Word32 Method -> [(Test, [AbiType])])
-> SolcContract
-> [(Test, [AbiType])]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Map Word32 Method -> [Method]
forall k a. Map k a -> [a]
Map.elems
  (Map Word32 Method -> [Method])
-> ([Method] -> [(Test, [AbiType])])
-> Map Word32 Method
-> [(Test, [AbiType])]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Method -> (Maybe Test, [AbiType]))
-> [Method] -> [(Maybe Test, [AbiType])]
forall a b. (a -> b) -> [a] -> [b]
map (\Method
f -> (Text -> Maybe Test
mkTest (Text -> Maybe Test) -> Text -> Maybe Test
forall a b. (a -> b) -> a -> b
$ Getting Text Method Text -> Method -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Method Text
Lens' Method Text
methodSignature Method
f, (Text, AbiType) -> AbiType
forall a b. (a, b) -> b
snd ((Text, AbiType) -> AbiType) -> [(Text, AbiType)] -> [AbiType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting [(Text, AbiType)] Method [(Text, AbiType)]
-> Method -> [(Text, AbiType)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(Text, AbiType)] Method [(Text, AbiType)]
Lens' Method [(Text, AbiType)]
methodInputs Method
f))
  ([Method] -> [(Maybe Test, [AbiType])])
-> ([(Maybe Test, [AbiType])] -> [(Test, [AbiType])])
-> [Method]
-> [(Test, [AbiType])]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Maybe Test, [AbiType]) -> Bool)
-> [(Maybe Test, [AbiType])] -> [(Maybe Test, [AbiType])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Test -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Test -> Bool)
-> ((Maybe Test, [AbiType]) -> Maybe Test)
-> (Maybe Test, [AbiType])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Test, [AbiType]) -> Maybe Test
forall a b. (a, b) -> a
fst)
  ([(Maybe Test, [AbiType])] -> [(Maybe Test, [AbiType])])
-> ([(Maybe Test, [AbiType])] -> [(Test, [AbiType])])
-> [(Maybe Test, [AbiType])]
-> [(Test, [AbiType])]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Maybe Test, [AbiType]) -> (Test, [AbiType]))
-> [(Maybe Test, [AbiType])] -> [(Test, [AbiType])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe Test -> Test)
-> (Maybe Test, [AbiType]) -> (Test, [AbiType])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Maybe Test -> Test
forall a. HasCallStack => Maybe a -> a
fromJust)

extractSig :: Test -> Text
extractSig :: Test -> Text
extractSig (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 =
  let
    h :: Contract
h = Getting Contract Trace Contract -> Trace -> Contract
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Contract Trace Contract
Lens' Trace Contract
traceContract Trace
trace
    i :: Int
i = Getting Int Trace Int -> Trace -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Trace Int
Lens' Trace Int
traceOpIx Trace
trace
  in DappInfo -> Contract -> Int -> Maybe SrcMap
srcMap DappInfo
dapp Contract
h Int
i

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 Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
contr of
    (InitCode Buffer
_) ->
      Getting (First SrcMap) SolcContract SrcMap
-> SolcContract -> Maybe SrcMap
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Seq SrcMap -> Const (First SrcMap) (Seq SrcMap))
-> SolcContract -> Const (First SrcMap) SolcContract
Lens' SolcContract (Seq SrcMap)
creationSrcmap ((Seq SrcMap -> Const (First SrcMap) (Seq SrcMap))
 -> SolcContract -> Const (First SrcMap) SolcContract)
-> ((SrcMap -> Const (First SrcMap) SrcMap)
    -> Seq SrcMap -> Const (First SrcMap) (Seq SrcMap))
-> Getting (First SrcMap) SolcContract SrcMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Seq SrcMap)
-> Traversal' (Seq SrcMap) (IxValue (Seq SrcMap))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Seq SrcMap)
opIndex) SolcContract
sol
    (RuntimeCode Buffer
_) ->
      Getting (First SrcMap) SolcContract SrcMap
-> SolcContract -> Maybe SrcMap
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Seq SrcMap -> Const (First SrcMap) (Seq SrcMap))
-> SolcContract -> Const (First SrcMap) SolcContract
Lens' SolcContract (Seq SrcMap)
runtimeSrcmap ((Seq SrcMap -> Const (First SrcMap) (Seq SrcMap))
 -> SolcContract -> Const (First SrcMap) SolcContract)
-> ((SrcMap -> Const (First SrcMap) SrcMap)
    -> Seq SrcMap -> Const (First SrcMap) (Seq SrcMap))
-> Getting (First SrcMap) SolcContract SrcMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Seq SrcMap)
-> Traversal' (Seq SrcMap) (IxValue (Seq SrcMap))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Seq SrcMap)
opIndex) SolcContract
sol

findSrc :: Contract -> DappInfo -> Maybe SolcContract
findSrc :: Contract -> DappInfo -> Maybe SolcContract
findSrc Contract
c DappInfo
dapp = case Getting
  (First (CodeType, SolcContract)) DappInfo (CodeType, SolcContract)
-> DappInfo -> Maybe (CodeType, SolcContract)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Map W256 (CodeType, SolcContract)
 -> Const
      (First (CodeType, SolcContract))
      (Map W256 (CodeType, SolcContract)))
-> DappInfo -> Const (First (CodeType, SolcContract)) DappInfo
Lens' DappInfo (Map W256 (CodeType, SolcContract))
dappSolcByHash ((Map W256 (CodeType, SolcContract)
  -> Const
       (First (CodeType, SolcContract))
       (Map W256 (CodeType, SolcContract)))
 -> DappInfo -> Const (First (CodeType, SolcContract)) DappInfo)
-> (((CodeType, SolcContract)
     -> Const (First (CodeType, SolcContract)) (CodeType, SolcContract))
    -> Map W256 (CodeType, SolcContract)
    -> Const
         (First (CodeType, SolcContract))
         (Map W256 (CodeType, SolcContract)))
-> Getting
     (First (CodeType, SolcContract)) DappInfo (CodeType, SolcContract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map W256 (CodeType, SolcContract))
-> Traversal'
     (Map W256 (CodeType, SolcContract))
     (IxValue (Map W256 (CodeType, SolcContract)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Getting W256 Contract W256 -> Contract -> W256
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting W256 Contract W256
Lens' Contract W256
codehash Contract
c)) DappInfo
dapp of
  Just (CodeType
_, SolcContract
v) -> SolcContract -> Maybe SolcContract
forall a. a -> Maybe a
Just SolcContract
v
  Maybe (CodeType, SolcContract)
Nothing -> ContractCode -> DappInfo -> Maybe SolcContract
lookupCode (Getting ContractCode Contract ContractCode
-> Contract -> ContractCode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ContractCode Contract ContractCode
Lens' Contract ContractCode
contractcode Contract
c) DappInfo
dapp


lookupCode :: ContractCode -> DappInfo -> Maybe SolcContract
lookupCode :: ContractCode -> DappInfo -> Maybe SolcContract
lookupCode (InitCode (SymbolicBuffer [SWord 8]
_)) DappInfo
_ = Maybe SolcContract
forall a. Maybe a
Nothing -- TODO: srcmaps for symbolic bytecode
lookupCode (RuntimeCode (SymbolicBuffer [SWord 8]
_)) DappInfo
_ = Maybe SolcContract
forall a. Maybe a
Nothing -- TODO: srcmaps for symbolic bytecode
lookupCode (InitCode (ConcreteBuffer ByteString
c)) DappInfo
a =
  (CodeType, SolcContract) -> SolcContract
forall a b. (a, b) -> b
snd ((CodeType, SolcContract) -> SolcContract)
-> Maybe (CodeType, SolcContract) -> Maybe SolcContract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (First (CodeType, SolcContract)) DappInfo (CodeType, SolcContract)
-> DappInfo -> Maybe (CodeType, SolcContract)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Map W256 (CodeType, SolcContract)
 -> Const
      (First (CodeType, SolcContract))
      (Map W256 (CodeType, SolcContract)))
-> DappInfo -> Const (First (CodeType, SolcContract)) DappInfo
Lens' DappInfo (Map W256 (CodeType, SolcContract))
dappSolcByHash ((Map W256 (CodeType, SolcContract)
  -> Const
       (First (CodeType, SolcContract))
       (Map W256 (CodeType, SolcContract)))
 -> DappInfo -> Const (First (CodeType, SolcContract)) DappInfo)
-> (((CodeType, SolcContract)
     -> Const (First (CodeType, SolcContract)) (CodeType, SolcContract))
    -> Map W256 (CodeType, SolcContract)
    -> Const
         (First (CodeType, SolcContract))
         (Map W256 (CodeType, SolcContract)))
-> Getting
     (First (CodeType, SolcContract)) DappInfo (CodeType, SolcContract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map W256 (CodeType, SolcContract))
-> Traversal'
     (Map W256 (CodeType, SolcContract))
     (IxValue (Map W256 (CodeType, SolcContract)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (ByteString -> W256
keccak (ByteString -> ByteString
stripBytecodeMetadata ByteString
c))) DappInfo
a
lookupCode (RuntimeCode (ConcreteBuffer ByteString
c)) DappInfo
a =
  case (CodeType, SolcContract) -> SolcContract
forall a b. (a, b) -> b
snd ((CodeType, SolcContract) -> SolcContract)
-> Maybe (CodeType, SolcContract) -> Maybe SolcContract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (First (CodeType, SolcContract)) DappInfo (CodeType, SolcContract)
-> DappInfo -> Maybe (CodeType, SolcContract)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Map W256 (CodeType, SolcContract)
 -> Const
      (First (CodeType, SolcContract))
      (Map W256 (CodeType, SolcContract)))
-> DappInfo -> Const (First (CodeType, SolcContract)) DappInfo
Lens' DappInfo (Map W256 (CodeType, SolcContract))
dappSolcByHash ((Map W256 (CodeType, SolcContract)
  -> Const
       (First (CodeType, SolcContract))
       (Map W256 (CodeType, SolcContract)))
 -> DappInfo -> Const (First (CodeType, SolcContract)) DappInfo)
-> (((CodeType, SolcContract)
     -> Const (First (CodeType, SolcContract)) (CodeType, SolcContract))
    -> Map W256 (CodeType, SolcContract)
    -> Const
         (First (CodeType, SolcContract))
         (Map W256 (CodeType, SolcContract)))
-> Getting
     (First (CodeType, SolcContract)) DappInfo (CodeType, SolcContract)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map W256 (CodeType, SolcContract))
-> Traversal'
     (Map W256 (CodeType, SolcContract))
     (IxValue (Map W256 (CodeType, SolcContract)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (ByteString -> W256
keccak (ByteString -> ByteString
stripBytecodeMetadata ByteString
c))) DappInfo
a of
    Just SolcContract
x -> SolcContract -> Maybe SolcContract
forall (m :: * -> *) a. Monad m => a -> m a
return SolcContract
x
    Maybe SolcContract
Nothing -> (Code, SolcContract) -> SolcContract
forall a b. (a, b) -> b
snd ((Code, SolcContract) -> SolcContract)
-> Maybe (Code, SolcContract) -> Maybe SolcContract
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Code, SolcContract) -> Bool)
-> [(Code, SolcContract)] -> Maybe (Code, SolcContract)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ByteString -> Code -> Bool
compareCode ByteString
c (Code -> Bool)
-> ((Code, SolcContract) -> Code) -> (Code, SolcContract) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Code, SolcContract) -> Code
forall a b. (a, b) -> a
fst) (Getting [(Code, SolcContract)] DappInfo [(Code, SolcContract)]
-> DappInfo -> [(Code, SolcContract)]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [(Code, SolcContract)] DappInfo [(Code, SolcContract)]
Lens' DappInfo [(Code, SolcContract)]
dappSolcByCode DappInfo
a)

compareCode :: ByteString -> Code -> Bool
compareCode :: ByteString -> Code -> Bool
compareCode ByteString
raw (Code ByteString
template [Reference]
locs) =
  let holes' :: [(Int, Int)]
holes' = [(Int, Int)] -> [(Int, Int)]
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 -> Word -> Word -> Word -> ByteString -> ByteString
writeMemory (Int -> Word8 -> ByteString
BS.replicate Int
len' Word8
0) (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len') Word
0 (a -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
at') ByteString
bs
      refined :: ByteString
refined = ((Int, Int) -> ByteString -> ByteString)
-> ByteString -> [(Int, Int)] -> ByteString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
start, Int
len) ByteString
acc -> Int -> Int -> ByteString -> ByteString
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Int
BS.length ByteString
template Bool -> Bool -> Bool
&& ByteString
template ByteString -> ByteString -> Bool
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 -> Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"<no source map>"
    Just SrcMap
sm ->
      case SourceCache -> SrcMap -> Maybe (Text, Int)
srcMapCodePos (Getting SourceCache DappInfo SourceCache -> DappInfo -> SourceCache
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SourceCache DappInfo SourceCache
Lens' DappInfo SourceCache
dappSources DappInfo
dapp) SrcMap
sm of
        Maybe (Text, Int)
Nothing -> Text -> Either Text Text
forall a b. a -> Either a b
Left Text
"<source not found>"
        Just (Text
fileName, Int
lineIx) ->
          Text -> Either Text Text
forall a b. b -> Either a b
Right (Text
fileName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
lineIx))