Add labels to call sequence (#1314)

* Add labels to call sequence

hevm already supports the `vm.label(address, string)` cheatcode, but
Echidna has not made use of the labels so far in its output. This adds
some basic support when printing call sequences. When available, it
will show the corresponding label next to any from/to address, or
next to any address arguments.

* Fix hlint warnings

lib/Echidna/ABI.hs

@@ -65,11 +65,11 @@ makeArrayAbiValues b =
      fmap (\n -> AbiBytes n . BS.append b $ BS.replicate (n - size) 0) [size..32]
 
 -- | Pretty-print some 'AbiValue'.
-ppAbiValue :: AbiValue -> String
-ppAbiValue = \case
+ppAbiValue :: Map Addr Text -> AbiValue -> String
+ppAbiValue labels = \case
   AbiUInt _ n         -> show n
   AbiInt  _ n         -> show n
-  AbiAddress n        -> "0x" <> showHex n ""
+  AbiAddress n        -> ppAddr labels n
   AbiBool b           -> if b then "true" else "false"
   AbiBytes _ b        -> show b
   AbiBytesDynamic b   -> show b
@@ -78,7 +78,15 @@ ppAbiValue = \case
   AbiArray _ _ v      -> "[" <> commaSeparated v <> "]"
   AbiTuple v          -> "(" <> commaSeparated v <> ")"
   AbiFunction v       -> show v
-  where commaSeparated v = intercalate ", " (ppAbiValue <$> toList v)
+  where
+    commaSeparated v = intercalate ", " $ ppAbiValue labels <$> toList v
+
+ppAddr :: Map Addr Text -> Addr -> String
+ppAddr labels addr = "0x" <> showHex addr "" <> label
+  where
+    label = case Map.lookup addr labels of
+      Nothing -> ""
+      Just l -> " «" <> T.unpack l <> "»"
 
 -- | Get the signature from a Solidity function.
 signatureCall :: SolCall -> SolSignature

lib/Echidna/Output/JSON.hs

@@ -144,6 +144,6 @@ mapTest dappInfo test =
 
   mapCall = \case
     SolCreate _          -> ("<CREATE>", Nothing)
-    SolCall (name, args) -> (name, Just $ ppAbiValue <$> args)
+    SolCall (name, args) -> (name, Just $ ppAbiValue <$> mempty <*> args)
     NoCall               -> ("*wait*", Nothing)
     SolCalldata x        -> (decodeUtf8 $ "0x" <> BS16.encode x, Nothing)

lib/Echidna/Pretty.hs

@@ -3,21 +3,24 @@ module Echidna.Pretty where
 import Data.ByteString.Base16 qualified as BS16
 import Data.ByteString.Char8 qualified as BSC8
 import Data.List (intercalate)
-import Data.Text (unpack)
+import Data.Map (Map)
+import Data.Text (Text, unpack)
+
+import EVM.Types (Addr)
 
 import Echidna.ABI (ppAbiValue)
 import Echidna.Types.Signature (SolCall)
 import Echidna.Types.Tx (TxCall(..))
 
 -- | Pretty-print some 'AbiCall'.
-ppSolCall :: SolCall -> String
-ppSolCall (t, vs) =
+ppSolCall :: Map Addr Text -> SolCall -> String
+ppSolCall labels (t, vs) =
   (if t == "" then unpack "*fallback*" else unpack t)
-  ++ "(" ++ intercalate "," (ppAbiValue <$> vs) ++ ")"
+  ++ "(" ++ intercalate "," (ppAbiValue labels <$> vs) ++ ")"
 
 -- | Pretty-print some 'TxCall'
-ppTxCall :: TxCall -> String
-ppTxCall (SolCreate _)    = "<CREATE>"
-ppTxCall (SolCall x)      = ppSolCall x
-ppTxCall NoCall           = "*wait*"
-ppTxCall (SolCalldata x)  = BSC8.unpack $ "0x" <> BS16.encode x
+ppTxCall :: Map Addr Text -> TxCall -> String
+ppTxCall _ (SolCreate _)    = "<CREATE>"
+ppTxCall labels (SolCall x) = ppSolCall labels x
+ppTxCall _ NoCall           = "*wait*"
+ppTxCall _ (SolCalldata x)  = BSC8.unpack $ "0x" <> BS16.encode x

lib/Echidna/UI/Report.hs

@@ -27,7 +27,7 @@ import Echidna.Utility (timePrefix)
 
 import EVM.Format (showTraceTree, contractNamePart)
 import EVM.Solidity (SolcContract(..))
-import EVM.Types (W256, VM, VMType(Concrete), Addr, Expr (LitAddr))
+import EVM.Types (W256, VM(labels), VMType(Concrete), Addr, Expr (LitAddr))
 
 ppLogLine :: MonadReader Env m => VM Concrete RealWorld -> (LocalTime, CampaignEvent) -> m String
 ppLogLine vm (time, event@(WorkerEvent workerId FuzzWorker _)) =
@@ -71,12 +71,19 @@ ppTx vm printName tx = do
   names <- asks (.cfg.namesConf)
   tGas  <- asks (.cfg.txConf.txGas)
   pure $
-    unpack (maybe "" (<> ".") contractName) <> ppTxCall tx.call
-    <> (if not printName then "" else names Sender tx.src <> names Receiver tx.dst)
+    unpack (maybe "" (<> ".") contractName) <> ppTxCall vm.labels tx.call
+    <> (if not printName then "" else prettyName names Sender tx.src <> prettyName 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
+  where
+    prettyName names t addr = case names t addr of
+      "" -> ""
+      s -> s <> label addr
+    label addr = case Map.lookup addr vm.labels of
+      Nothing -> ""
+      Just l -> " «" <> T.unpack l <> "»"
 
 contractNameForAddr :: MonadReader Env m => VM Concrete RealWorld -> Addr -> m Text
 contractNameForAddr vm addr = do