Merge pull request #446 from ethereum/arcz/fix-traces

Fix trace source mapping and indexed event args

CHANGELOG.md

@@ -29,6 +29,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Partial support for dynamic jumps when the jump destination can be computed
   given already available information
 
+## Fixed
+
+- Traces now correctly perform source mapping to display contract details
+- Event traces now correctly display indexed arguments and argument names
+
 ## [0.52.0] - 2023-10-26
 
 This is a major breaking release that removes several user facing features and includes non trivial

src/EVM/Format.hs

@@ -18,7 +18,6 @@ module EVM.Format
   , showWordExact
   , showWordExplanation
   , parenthesise
-  , unindexed
   , showValue
   , textValues
   , showAbiValue
@@ -39,7 +38,7 @@ import Prelude hiding (LT, GT)
 import EVM.Types
 import EVM (traceForest, traceForest', traceContext, cheatCode)
 import EVM.ABI (getAbiSeq, parseTypeName, AbiValue(..), AbiType(..), SolError(..), Indexed(..), Event(..))
-import EVM.Dapp (DappContext(..), DappInfo(..), showTraceLocation)
+import EVM.Dapp (DappContext(..), DappInfo(..), findSrc, showTraceLocation)
 import EVM.Expr qualified as Expr
 import EVM.Solidity (SolcContract(..), Method(..), contractName, abiMap)
 
@@ -54,10 +53,10 @@ import Data.ByteString.Lazy (toStrict, fromStrict)
 import Data.Char qualified as Char
 import Data.DoubleWord (signedWord)
 import Data.Foldable (toList)
-import Data.List (isPrefixOf)
+import Data.List (isPrefixOf, sort)
 import Data.Map (Map)
 import Data.Map qualified as Map
-import Data.Maybe (catMaybes, fromMaybe, fromJust)
+import Data.Maybe (catMaybes, fromMaybe)
 import Data.Text (Text, pack, unpack, intercalate, dropEnd, splitOn)
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as T
@@ -112,15 +111,9 @@ showAbiValue (AbiString bs) = formatBytes bs
 showAbiValue (AbiBytesDynamic bs) = formatBytes bs
 showAbiValue (AbiBytes _ bs) = formatBinary bs
 showAbiValue (AbiAddress addr) =
-  let dappinfo = ?context.info
-      contracts = ?context.env
-      name = case Map.lookup (LitAddr addr) contracts of
+  let name = case Map.lookup (LitAddr addr) ?context.env of
         Nothing -> ""
-        Just contract ->
-          let hash = maybeLitWord contract.codehash
-          in case hash of
-               Just h -> maybeContractName' (preview (ix h % _2) dappinfo.solcByHash)
-               Nothing -> ""
+        Just contract -> maybeContractName' (findSrc contract ?context.info)
   in
     name <> "@" <> (pack $ show addr)
 showAbiValue v = pack $ show v
@@ -204,9 +197,6 @@ showTraceTree' dapp leaf =
       traces = fmap (fmap (unpack . showTrace dapp (traceContext leaf))) forest
   in pack $ concatMap showTree traces
 
-unindexed :: [(Text, AbiType, Indexed)] -> [AbiType]
-unindexed ts = [t | (_, t, NotIndexed) <- ts]
-
 showTrace :: DappInfo -> Map (Expr EAddr) Contract -> Trace -> Text
 showTrace dapp env trace =
   let ?context = DappContext { info = dapp, env = env }
@@ -215,37 +205,17 @@ showTrace dapp env trace =
       case showTraceLocation dapp trace of
         Left x -> " \x1b[1m" <> x <> "\x1b[0m"
         Right x -> " \x1b[1m(" <> x <> ")\x1b[0m"
-    fullAbiMap = dapp.abiMap
   in case trace.tracedata of
     EventTrace _ bytes topics ->
-      let logn = mconcat
-            [ "\x1b[36m"
-            , "log" <> (pack (show (length topics)))
-            , parenthesise ((map (pack . show) topics) ++ [formatSBinary bytes])
-            , "\x1b[0m"
-            ] <> pos
-          knownTopic name types = mconcat
-            [ "\x1b[36m"
-            , name
-            , showValues (unindexed types) bytes
-            -- todo: show indexed
-            , "\x1b[0m"
-            ] <> pos
-          lognote sig usr = mconcat
-            [ "\x1b[36m"
-            , "LogNote"
-            , parenthesise [sig, usr, "..."]
-            , "\x1b[0m"
-            ] <> pos
-      in case topics of
+      case topics of
         [] ->
           logn
-        (t1:_) ->
-          case maybeLitWord t1 of
+        firstTopic:restTopics ->
+          case maybeLitWord firstTopic of
             Just topic ->
               case Map.lookup topic dapp.eventMap of
-                Just (Event name _ types) ->
-                  knownTopic name types
+                Just (Event name _ argInfos) ->
+                  showEvent name argInfos restTopics
                 Nothing ->
                   case topics of
                     [_, t2, _, _] ->
@@ -274,6 +244,55 @@ showTrace dapp env trace =
                       logn
             Nothing ->
               logn
+      where
+        logn = mconcat
+          [ "\x1b[36m"
+          , "log" <> (pack (show (length topics)))
+          , parenthesise ((map (pack . show) topics) ++ [formatSBinary bytes])
+          , "\x1b[0m"
+          ] <> pos
+
+        showEvent eventName argInfos indexedTopics = mconcat
+          [ "\x1b[36m"
+          , eventName
+          , parenthesise (snd <$> sort (unindexedArgs <> indexedArgs))
+          , "\x1b[0m"
+          ] <> pos
+          where
+          -- We maintain the original position of event arguments since indexed
+          -- and not indexed arguments can be interleaved.
+          unindexedArgs :: [(Int, Text)]
+          unindexedArgs =
+            let (positions, names, abiTypes) = unzip3 (filterArgInfos NotIndexed)
+            in zip positions (zipWith withName names (textValues abiTypes bytes))
+
+          indexedArgs :: [(Int, Text)]
+          indexedArgs =
+            let (positions, names, abiTypes) = unzip3 (filterArgInfos Indexed)
+            in zip positions (zipWith withName names (zipWith showTopic abiTypes indexedTopics))
+            where
+            showTopic :: AbiType -> Expr EWord -> Text
+            showTopic abiType topic =
+              case maybeLitWord (Expr.concKeccakSimpExpr topic) of
+                Just w -> head $ textValues [abiType] (ConcreteBuf (word256Bytes w))
+                _ -> "<symbolic>"
+
+          withName :: Text -> Text -> Text
+          withName "" value = value
+          withName argName value = argName <> "=" <> value
+
+          filterArgInfos :: Indexed -> [(Int, Text, AbiType)]
+          filterArgInfos which =
+            [ (i, argName, argType) | (i, (argName, argType, indexed)) <- zip [0..] argInfos
+                                    , indexed == which
+            ]
+
+        lognote sig usr = mconcat
+          [ "\x1b[36m"
+          , "LogNote"
+          , parenthesise [sig, usr, "..."]
+          , "\x1b[0m"
+          ] <> pos
 
     ErrorTrace e ->
       case e of
@@ -282,9 +301,9 @@ showTrace dapp env trace =
         _ ->
           "\x1b[91merror\x1b[0m " <> pack (show e) <> pos
 
-    ReturnTrace out (CallContext _ _ _ _ _ (Just abi) _ _ _) ->
+    ReturnTrace out (CallContext { abi = Just abi }) ->
       "← " <>
-        case Map.lookup (unsafeInto abi) fullAbiMap of
+        case Map.lookup (unsafeInto abi) dapp.abiMap of
           Just m  ->
             case unzip m.output of
               ([], []) ->
@@ -300,29 +319,23 @@ showTrace dapp env trace =
       in "← " <> formatExpr l <> " bytes of code"
     EntryTrace t ->
       t
-    FrameTrace (CreationContext addr (Lit hash) _ _ ) -> -- FIXME: irrefutable pattern
-      "create "
-      <> maybeContractName (preview (ix hash % _2) dapp.solcByHash)
-      <> "@" <> formatAddr addr
-      <> pos
-    FrameTrace (CreationContext addr _ _ _ ) ->
+    FrameTrace (CreationContext { address }) ->
       "create "
-      <> "<unknown contract>"
-      <> "@" <> formatAddr addr
+      <> maybeContractName (findSrcFromAddr address)
+      <> "@" <> formatAddr address
       <> pos
-    FrameTrace (CallContext target context _ _ hash abi calldata _ _) ->
+    FrameTrace (CallContext { target, context, abi, calldata }) ->
       let calltype = if target == context
                      then "call "
                      else "delegatecall "
-          hash' = fromJust $ maybeLitWord $ Expr.concKeccakSimpExpr hash
-      in case preview (ix hash' % _2) dapp.solcByHash of
+      in case findSrcFromAddr target of
         Nothing ->
           calltype
             <> case target of
                  LitAddr 0x7109709ECfa91a80626fF3989D68f67F5b1DD12D -> "HEVM"
                  _ -> formatAddr target
             <> pack "::"
-            <> case Map.lookup (unsafeInto (fromMaybe 0x00 abi)) fullAbiMap of
+            <> case Map.lookup (unsafeInto (fromMaybe 0x00 abi)) dapp.abiMap of
                  Just m  ->
                    "\x1b[1m"
                    <> m.name
@@ -345,6 +358,10 @@ showTrace dapp env trace =
                  (abi >>= fmap getAbiTypes . maybeAbiName solc)
             <> "\x1b[0m"
             <> pos
+    where
+    findSrcFromAddr addr = do
+      contract <- Map.lookup addr env
+      findSrc contract dapp
 
 formatAddr :: Expr EAddr -> Text
 formatAddr = \case

src/EVM/UnitTest.hs

@@ -345,8 +345,8 @@ formatTestLog _ (GVar _) = internalError "unexpected global variable"
 formatTestLog events (LogEntry _ args (topic:_)) =
   case maybeLitWord topic >>= \t1 -> (Map.lookup t1 events) of
     Nothing -> Nothing
-    Just (Event name _ types) ->
-      case (name <> parenthesise (abiTypeSolidity <$> (unindexed types))) of
+    Just (Event name _ argInfos) ->
+      case (name <> parenthesise (abiTypeSolidity <$> argTypes)) of
         "log(string)" -> Just $ unquote $ showValue AbiStringType args
 
         -- log_named_x(string, x)
@@ -379,12 +379,12 @@ formatTestLog events (LogEntry _ args (topic:_)) =
         _ -> Nothing
 
         where
-          ts = unindexed types
+          argTypes = [argType | (_, argType, NotIndexed) <- argInfos]
           unquote = Text.dropAround (\c -> c == '"' || c == '«' || c == '»')
           log_unnamed =
-            Just $ showValue (head ts) args
+            Just $ showValue (head argTypes) args
           log_named =
-            let (key, val) = case take 2 (textValues ts args) of
+            let (key, val) = case take 2 (textValues argTypes args) of
                   [k, v] -> (k, v)
                   _ -> internalError "shouldn't happen"
             in Just $ unquote key <> ": " <> val
@@ -393,7 +393,7 @@ formatTestLog events (LogEntry _ args (topic:_)) =
           log_named_decimal =
             case args of
               (ConcreteBuf b) ->
-                case toList $ runGet (getAbiSeq (length ts) ts) (BSLazy.fromStrict b) of
+                case toList $ runGet (getAbiSeq (length argTypes) argTypes) (BSLazy.fromStrict b) of
                   [key, (AbiUInt 256 val), (AbiUInt 256 dec)] ->
                     Just $ (unquote (showAbiValue key)) <> ": " <> showDecimal dec val
                   [key, (AbiInt 256 val), (AbiUInt 256 dec)] ->