Display contract names in UI (#1181)

lib/Echidna/UI.hs

@@ -149,7 +149,7 @@ ui vm world dict initialCorpus = do
       liftIO $ killThread ticker
 
       states <- workerStates workers
-      liftIO . putStrLn =<< ppCampaign states
+      liftIO . putStrLn =<< ppCampaign vm states
 
       pure states
 #else
@@ -203,7 +203,7 @@ ui vm world dict initialCorpus = do
         JSON ->
           liftIO $ BS.putStr =<< Echidna.Output.JSON.encodeCampaign env states
         Text -> do
-          liftIO . putStrLn =<< ppCampaign states
+          liftIO . putStrLn =<< ppCampaign vm states
         None ->
           pure ()
       pure states

lib/Echidna/UI/Report.hs

@@ -7,13 +7,15 @@ import Data.IORef (readIORef)
 import Data.List (intercalate, nub, sortOn)
 import Data.Map (toList)
 import Data.Map qualified as Map
-import Data.Maybe (catMaybes, fromJust)
+import Data.Maybe (catMaybes, fromJust, fromMaybe)
 import Data.Text (Text, unpack)
 import Data.Text qualified as T
 import Data.Time (LocalTime)
+import Optics
 
 import Echidna.ABI (GenDict(..), encodeSig)
 import Echidna.Pretty (ppTxCall)
+import Echidna.SourceMapping (findSrcByMetadata)
 import Echidna.Types (Gas)
 import Echidna.Types.Campaign
 import Echidna.Types.Config
@@ -23,8 +25,9 @@ import Echidna.Types.Test (EchidnaTest(..), TestState(..), TestType(..))
 import Echidna.Types.Tx (Tx(..), TxCall(..), TxConf(..))
 import Echidna.Utility (timePrefix)
 
-import EVM.Format (showTraceTree)
-import EVM.Types (W256, VM)
+import EVM.Format (showTraceTree, contractNamePart)
+import EVM.Solidity (SolcContract(..))
+import EVM.Types (W256, VM, Addr, Expr (LitAddr))
 
 ppLogLine :: (LocalTime, CampaignEvent) -> String
 ppLogLine (time, event@(WorkerEvent workerId _)) =
@@ -32,11 +35,11 @@ ppLogLine (time, event@(WorkerEvent workerId _)) =
 ppLogLine (time, event) =
   timePrefix time <> " " <> ppCampaignEvent event
 
-ppCampaign :: (MonadIO m, MonadReader Env m) => [WorkerState] -> m String
-ppCampaign workerStates = do
+ppCampaign :: (MonadIO m, MonadReader Env m) => VM RealWorld -> [WorkerState] -> m String
+ppCampaign vm workerStates = do
   tests <- liftIO . readIORef =<< asks (.testsRef)
   testsPrinted <- ppTests tests
-  gasInfoPrinted <- ppGasInfo workerStates
+  gasInfoPrinted <- ppGasInfo vm workerStates
   coveragePrinted <- ppCoverage
   let seedPrinted = "Seed: " <> show (head workerStates).genDict.defSeed
   corpusPrinted <- ppCorpus
@@ -50,20 +53,34 @@ ppCampaign workerStates = do
 
 -- | Given rules for pretty-printing associated address, and whether to print
 -- them, pretty-print a 'Transaction'.
-ppTx :: MonadReader Env m => Bool -> Tx -> m String
-ppTx _ Tx { call = NoCall, delay } =
+ppTx :: MonadReader Env m => VM RealWorld -> Bool -> Tx -> m String
+ppTx _ _ Tx { call = NoCall, delay } =
   pure $ "*wait*" <> ppDelay delay
-ppTx printName tx = do
+ppTx vm printName tx = do
+  contractName <- case tx.call of
+    SolCall _ -> Just <$> contractNameForAddr vm tx.dst
+    _ -> pure Nothing
   names <- asks (.cfg.namesConf)
   tGas  <- asks (.cfg.txConf.txGas)
   pure $
-    ppTxCall tx.call
+    unpack (maybe "" (<> ".") contractName) <> ppTxCall tx.call
     <> (if not printName then "" else names Sender tx.src <> names Receiver tx.dst)
     <> (if tx.gas == tGas then "" else " Gas: " <> show tx.gas)
     <> (if tx.gasprice == 0 then "" else " Gas price: " <> show tx.gasprice)
     <> (if tx.value == 0 then "" else " Value: " <> show tx.value)
     <> ppDelay tx.delay
 
+contractNameForAddr :: MonadReader Env m => VM RealWorld -> Addr -> m Text
+contractNameForAddr vm addr = do
+  dapp <- asks (.dapp)
+  maybeName <- case Map.lookup (LitAddr addr) (vm ^. #env % #contracts) of
+    Just contract ->
+      case findSrcByMetadata contract dapp of
+        Just solcContract -> pure $ Just $ contractNamePart solcContract.contractName
+        Nothing -> pure Nothing
+    Nothing -> pure Nothing
+  pure $ fromMaybe (T.pack $ show addr) maybeName
+
 ppDelay :: (W256, W256) -> [Char]
 ppDelay (time, block) =
   (if time == 0 then "" else " Time delay: " <> show (toInteger time) <> " seconds")
@@ -84,19 +101,19 @@ ppCorpus = do
   pure $ "Corpus size: " <> show (corpusSize corpus)
 
 -- | Pretty-print the gas usage information a 'Campaign' has obtained.
-ppGasInfo :: MonadReader Env m => [WorkerState] -> m String
-ppGasInfo workerStates = do
+ppGasInfo :: MonadReader Env m => VM RealWorld -> [WorkerState] -> m String
+ppGasInfo vm workerStates = do
   let gasInfo = Map.unionsWith max ((.gasInfo) <$> workerStates)
-  items <- mapM ppGasOne $ sortOn (\(_, (n, _)) -> n) $ toList gasInfo
+  items <- mapM (ppGasOne vm) $ sortOn (\(_, (n, _)) -> n) $ toList gasInfo
   pure $ intercalate "" items
 
 -- | Pretty-print the gas usage for a function.
-ppGasOne :: MonadReader Env m => (Text, (Gas, [Tx])) -> m String
-ppGasOne ("", _)      = pure ""
-ppGasOne (func, (gas, txs)) = do
+ppGasOne :: MonadReader Env m => VM RealWorld -> (Text, (Gas, [Tx])) -> m String
+ppGasOne _  ("", _)      = pure ""
+ppGasOne vm (func, (gas, txs)) = do
   let header = "\n" <> unpack func <> " used a maximum of " <> show gas <> " gas\n"
                <> "  Call sequence:\n"
-  prettyTxs <- mapM (ppTx $ length (nub $ (.src) <$> txs) /= 1) txs
+  prettyTxs <- mapM (ppTx vm $ length (nub $ (.src) <$> txs) /= 1) txs
   pure $ header <> unlines (("    " <>) <$> prettyTxs)
 
 -- | Pretty-print the status of a solved test.
@@ -106,7 +123,7 @@ ppFail b vm xs = do
   let status = case b of
         Nothing    -> ""
         Just (n,m) -> ", shrinking " <> progress n m
-  prettyTxs <- mapM (ppTx $ length (nub $ (.src) <$> xs) /= 1) xs
+  prettyTxs <- mapM (ppTx vm $ length (nub $ (.src) <$> xs) /= 1) xs
   dappInfo <- asks (.dapp)
   pure $ "failed!💥  \n  Call sequence" <> status <> ":\n"
          <> unlines (("    " <>) <$> prettyTxs) <> "\n"
@@ -123,7 +140,7 @@ ppFailWithTraces b finalVM results = do
         Just (n,m) -> ", shrinking " <> progress n m
   let printName = length (nub $ (.src) <$> xs) /= 1
   prettyTxs <- forM results $ \(tx, vm) -> do
-    txPrinted <- ppTx printName tx
+    txPrinted <- ppTx vm printName tx
     pure $ txPrinted <> "\nTraces:\n" <> T.unpack (showTraceTree dappInfo vm)
   pure $ "failed!💥  \n  Call sequence" <> status <> ":\n"
          <> unlines (("    " <>) <$> prettyTxs) <> "\n"
@@ -157,7 +174,7 @@ ppOptimized b vm xs = do
   let status = case b of
         Nothing    -> ""
         Just (n,m) -> ", shrinking " <> progress n m
-  prettyTxs <- mapM (ppTx $ length (nub $ (.src) <$> xs) /= 1) xs
+  prettyTxs <- mapM (ppTx vm $ length (nub $ (.src) <$> xs) /= 1) xs
   dappInfo <- asks (.dapp)
   pure $ "\n  Call sequence" <> status <> ":\n"
          <> unlines (("    " <>) <$> prettyTxs) <> "\n"

lib/Echidna/UI/Widgets.hs

@@ -312,7 +312,7 @@ failWidget
   -> m (Widget Name, Widget Name)
 failWidget _ [] _  _  _= pure (failureBadge, str "*no transactions made*")
 failWidget b xs vm _ r = do
-  s <- seqWidget xs
+  s <- seqWidget vm xs
   traces <- tracesWidget vm
   pure
     ( failureBadge <+> str (" with " ++ show r)
@@ -349,7 +349,7 @@ maxWidget
   -> m (Widget Name, Widget Name)
 maxWidget _ [] _  _ = pure (failureBadge, str "*no transactions made*")
 maxWidget b xs vm v = do
-  s <- seqWidget xs
+  s <- seqWidget vm xs
   traces <- tracesWidget vm
   pure
     ( maximumBadge <+> str (" max value: " ++ show v)
@@ -362,10 +362,10 @@ maxWidget b xs vm v = do
       str "Current action: " <+>
         withAttr (attrName "working") (str ("shrinking " ++ progress n m))
 
-seqWidget :: MonadReader Env m => [Tx] -> m (Widget Name)
-seqWidget xs = do
-  ppTxs <- mapM (ppTx $ length (nub $ (.src) <$> xs) /= 1) xs
-  let ordinals = str . printf "%d." <$> [1 :: Int ..]
+seqWidget :: MonadReader Env m => VM RealWorld -> [Tx] -> m (Widget Name)
+seqWidget vm xs = do
+  ppTxs <- mapM (ppTx vm $ length (nub $ (.src) <$> xs) /= 1) xs
+  let ordinals = str . printf "%d. " <$> [1 :: Int ..]
   pure $
     foldl (<=>) emptyWidget $
       zipWith (<+>) ordinals (withAttr (attrName "tx") . strBreak <$> ppTxs)