{-# Language DataKinds #-}
{-# Language ImplicitParams #-}

module EVM.Format
  ( formatExpr
  , formatSomeExpr
  , formatPartial
  , contractNamePart
  , contractPathPart
  , showError
  , showTree
  , showTraceTree
  , showValues
  , prettyvmresult
  , showCall
  , showWordExact
  , showWordExplanation
  , parenthesise
  , unindexed
  , showValue
  , textValues
  , showAbiValue
  , prettyIfConcreteWord
  , formatBytes
  , formatBinary
  , indent
  , strip0x
  , strip0x'
  , hexByteString
  , hexText
  , bsToHex
  ) where

import Prelude hiding (Word)

import EVM.Types
import EVM (cheatCode, traceForest)
import EVM.ABI (getAbiSeq, parseTypeName, AbiValue(..), AbiType(..), SolError(..), Indexed(..), Event(..))
import EVM.Dapp (DappContext(..), DappInfo(..), showTraceLocation)
import EVM.Expr qualified as Expr
import EVM.Hexdump (prettyHex, paddedShowHex)
import EVM.Solidity (SolcContract(..), Method(..), contractName, abiMap)

import Control.Arrow ((>>>))
import Optics.Core
import Data.Binary.Get (runGetOrFail)
import Data.Bits (shiftR)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Builder (byteStringHex, toLazyByteString)
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.Map qualified as Map
import Data.Maybe (catMaybes, fromMaybe, fromJust)
import Data.Text (Text, pack, unpack, intercalate, dropEnd, splitOn)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Tree.View (showTree)
import Data.Vector (Vector)
import Numeric (showHex)
import Data.ByteString.Char8 qualified as Char8
import Data.ByteString.Base16 qualified as BS16

data Signedness = Signed | Unsigned
  deriving (Int -> Signedness -> ShowS
[Signedness] -> ShowS
Signedness -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Signedness] -> ShowS
$cshowList :: [Signedness] -> ShowS
show :: Signedness -> [Char]
$cshow :: Signedness -> [Char]
showsPrec :: Int -> Signedness -> ShowS
$cshowsPrec :: Int -> Signedness -> ShowS
Show)

showDec :: Signedness -> W256 -> Text
showDec :: Signedness -> W256 -> Text
showDec Signedness
signed (W256 Word256
w)
  | Integer
i forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
num Addr
cheatCode = Text
"<hevm cheat address>"
  | (Integer
i :: Integer) forall a. Eq a => a -> a -> Bool
== Integer
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
256 :: Integer) forall a. Num a => a -> a -> a
- Integer
1 = Text
"MAX_UINT256"
  | Bool
otherwise = [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Integer
i :: Integer))
  where
    i :: Integer
i = case Signedness
signed of
          Signedness
Signed   -> forall a b. (Integral a, Num b) => a -> b
num (forall w. BinaryWord w => w -> SignedWord w
signedWord Word256
w)
          Signedness
Unsigned -> forall a b. (Integral a, Num b) => a -> b
num Word256
w

showWordExact :: W256 -> Text
showWordExact :: W256 -> Text
showWordExact W256
w = forall a. (Num a, Integral a, Show a) => a -> Text
humanizeInteger (forall a. Integral a => a -> Integer
toInteger W256
w)

showWordExplanation :: W256 -> DappInfo -> Text
showWordExplanation :: W256 -> DappInfo -> Text
showWordExplanation W256
w DappInfo
_ | W256
w forall a. Ord a => a -> a -> Bool
> W256
0xffffffff = Signedness -> W256 -> Text
showDec Signedness
Unsigned W256
w
showWordExplanation W256
w DappInfo
dapp =
  case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall a b. (Integral a, Num b) => a -> b
fromIntegral W256
w) DappInfo
dapp.abiMap of
    Maybe Method
Nothing -> Signedness -> W256 -> Text
showDec Signedness
Unsigned W256
w
    Just Method
x  -> Text
"keccak(\"" forall a. Semigroup a => a -> a -> a
<> Method
x.methodSignature forall a. Semigroup a => a -> a -> a
<> Text
"\")"

humanizeInteger :: (Num a, Integral a, Show a) => a -> Text
humanizeInteger :: forall a. (Num a, Integral a, Show a) => a -> Text
humanizeInteger =
  Text -> [Text] -> Text
T.intercalate Text
","
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.reverse
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> [Text]
T.chunksOf Int
3
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show

prettyIfConcreteWord :: Expr EWord -> Text
prettyIfConcreteWord :: Expr 'EWord -> Text
prettyIfConcreteWord = \case
  Lit W256
w -> [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
"0x" forall a. Semigroup a => a -> a -> a
<> forall a. (Integral a, Show a) => a -> ShowS
showHex W256
w [Char]
""
  Expr 'EWord
w -> [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Expr 'EWord
w

showAbiValue :: (?context :: DappContext) => AbiValue -> Text
showAbiValue :: (?context::DappContext) => AbiValue -> Text
showAbiValue (AbiString ByteString
bs) = ByteString -> Text
formatBytes ByteString
bs
showAbiValue (AbiBytesDynamic ByteString
bs) = ByteString -> Text
formatBytes ByteString
bs
showAbiValue (AbiBytes Int
_ ByteString
bs) = ByteString -> Text
formatBinary ByteString
bs
showAbiValue (AbiAddress Addr
addr) =
  let dappinfo :: DappInfo
dappinfo = ?context::DappContext
?context.info
      contracts :: Map Addr Contract
contracts = ?context::DappContext
?context.env
      name :: Text
name = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Addr
addr Map Addr Contract
contracts of
        Maybe Contract
Nothing -> Text
""
        Just Contract
contract ->
          let hash :: Maybe W256
hash = Expr 'EWord -> Maybe W256
maybeLitWord Contract
contract.codehash
          in case Maybe W256
hash of
               Just W256
h -> Maybe SolcContract -> Text
maybeContractName' (forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix W256
h forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s t a b. Field2 s t a b => Lens s t a b
_2) DappInfo
dappinfo.solcByHash)
               Maybe W256
Nothing -> Text
""
  in
    Text
name forall a. Semigroup a => a -> a -> a
<> Text
"@" forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Addr
addr)
showAbiValue AbiValue
v = [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show AbiValue
v

textAbiValues :: (?context :: DappContext) => Vector AbiValue -> [Text]
textAbiValues :: (?context::DappContext) => Vector AbiValue -> [Text]
textAbiValues Vector AbiValue
vs = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (?context::DappContext) => AbiValue -> Text
showAbiValue Vector AbiValue
vs)

textValues :: (?context :: DappContext) => [AbiType] -> Expr Buf -> [Text]
textValues :: (?context::DappContext) => [AbiType] -> Expr 'Buf -> [Text]
textValues [AbiType]
ts (ConcreteBuf ByteString
bs) =
  case forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, [Char]) (ByteString, ByteOffset, a)
runGetOrFail (Int -> [AbiType] -> Get (Vector AbiValue)
getAbiSeq (forall (t :: * -> *) a. Foldable t => t a -> Int
length [AbiType]
ts) [AbiType]
ts) (ByteString -> ByteString
fromStrict ByteString
bs) of
    Right (ByteString
_, ByteOffset
_, Vector AbiValue
xs) -> (?context::DappContext) => Vector AbiValue -> [Text]
textAbiValues Vector AbiValue
xs
    Left (ByteString
_, ByteOffset
_, [Char]
_)   -> [ByteString -> Text
formatBinary ByteString
bs]
textValues [AbiType]
ts Expr 'Buf
_ = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const Text
"<symbolic>") [AbiType]
ts

parenthesise :: [Text] -> Text
parenthesise :: [Text] -> Text
parenthesise [Text]
ts = Text
"(" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " [Text]
ts forall a. Semigroup a => a -> a -> a
<> Text
")"

showValues :: (?context :: DappContext) => [AbiType] -> Expr Buf -> Text
showValues :: (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
showValues [AbiType]
ts Expr 'Buf
b = [Text] -> Text
parenthesise forall a b. (a -> b) -> a -> b
$ (?context::DappContext) => [AbiType] -> Expr 'Buf -> [Text]
textValues [AbiType]
ts Expr 'Buf
b

showValue :: (?context :: DappContext) => AbiType -> Expr Buf -> Text
showValue :: (?context::DappContext) => AbiType -> Expr 'Buf -> Text
showValue AbiType
t Expr 'Buf
b = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ (?context::DappContext) => [AbiType] -> Expr 'Buf -> [Text]
textValues [AbiType
t] Expr 'Buf
b

showCall :: (?context :: DappContext) => [AbiType] -> Expr Buf -> Text
showCall :: (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
showCall [AbiType]
ts (ConcreteBuf ByteString
bs) = (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
showValues [AbiType]
ts forall a b. (a -> b) -> a -> b
$ ByteString -> Expr 'Buf
ConcreteBuf (Int -> ByteString -> ByteString
BS.drop Int
4 ByteString
bs)
showCall [AbiType]
_ Expr 'Buf
_ = Text
"<symbolic>"

showError :: (?context :: DappContext) => Expr Buf -> Text
showError :: (?context::DappContext) => Expr 'Buf -> Text
showError (ConcreteBuf ByteString
bs) =
  let dappinfo :: DappInfo
dappinfo = ?context::DappContext
?context.info
      bs4 :: ByteString
bs4 = Int -> ByteString -> ByteString
BS.take Int
4 ByteString
bs
  in case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ByteString -> W256
word ByteString
bs4) DappInfo
dappinfo.errorMap of
      Just (SolError Text
errName [AbiType]
ts) -> Text
errName forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
showCall [AbiType]
ts (ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs)
      Maybe SolError
Nothing -> case ByteString
bs4 of
                  -- Method ID for Error(string)
                  ByteString
"\b\195y\160" -> (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
showCall [AbiType
AbiStringType] (ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs)
                  -- Method ID for Panic(uint256)
                  ByteString
"NH{q"        -> Text
"Panic" forall a. Semigroup a => a -> a -> a
<> (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
showCall [Int -> AbiType
AbiUIntType Int
256] (ByteString -> Expr 'Buf
ConcreteBuf ByteString
bs)
                  ByteString
_             -> ByteString -> Text
formatBinary ByteString
bs
showError Expr 'Buf
b = [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Expr 'Buf
b

-- the conditions under which bytes will be decoded and rendered as a string
isPrintable :: ByteString -> Bool
isPrintable :: ByteString -> Bool
isPrintable =
  ByteString -> Either UnicodeException Text
T.decodeUtf8' forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      (forall a b. a -> b -> a
const Bool
False)
      ((Char -> Bool) -> Text -> Bool
T.all (\Char
c-> Char -> Bool
Char.isPrint Char
c Bool -> Bool -> Bool
&& (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
Char.isControl) Char
c))

formatBytes :: ByteString -> Text
formatBytes :: ByteString -> Text
formatBytes ByteString
b =
  let (ByteString
s, ByteString
_) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd (forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
b
  in
    if ByteString -> Bool
isPrintable ByteString
s
    then ByteString -> Text
formatBString ByteString
s
    else ByteString -> Text
formatBinary ByteString
b

-- a string that came from bytes, displayed with special quotes
formatBString :: ByteString -> Text
formatBString :: ByteString -> Text
formatBString ByteString
b = forall a. Monoid a => [a] -> a
mconcat [ Text
"«",  (Char -> Bool) -> Text -> Text
T.dropAround (forall a. Eq a => a -> a -> Bool
==Char
'"') ([Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ ByteString -> [Char]
formatString ByteString
b), Text
"»" ]

formatBinary :: ByteString -> Text
formatBinary :: ByteString -> Text
formatBinary =
  forall a. Semigroup a => a -> a -> a
(<>) Text
"0x" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
byteStringHex

formatSBinary :: Expr Buf -> Text
formatSBinary :: Expr 'Buf -> Text
formatSBinary (ConcreteBuf ByteString
bs) = ByteString -> Text
formatBinary ByteString
bs
formatSBinary (AbstractBuf Text
t) = Text
"<" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
" abstract buf>"
formatSBinary Expr 'Buf
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"formatSBinary: implement me"

showTraceTree :: DappInfo -> VM -> Text
showTraceTree :: DappInfo -> VM -> Text
showTraceTree DappInfo
dapp VM
vm =
  let forest :: Forest Trace
forest = VM -> Forest Trace
traceForest VM
vm
      traces :: [Tree [Char]]
traces = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> [Char]
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. DappInfo -> VM -> Trace -> Text
showTrace DappInfo
dapp VM
vm)) Forest Trace
forest
  in [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree [Char] -> [Char]
showTree [Tree [Char]]
traces

unindexed :: [(Text, AbiType, Indexed)] -> [AbiType]
unindexed :: [(Text, AbiType, Indexed)] -> [AbiType]
unindexed [(Text, AbiType, Indexed)]
ts = [AbiType
t | (Text
_, AbiType
t, Indexed
NotIndexed) <- [(Text, AbiType, Indexed)]
ts]

showTrace :: DappInfo -> VM -> Trace -> Text
showTrace :: DappInfo -> VM -> Trace -> Text
showTrace DappInfo
dapp VM
vm Trace
trace =
  let ?context = DappContext { $sel:info:DappContext :: DappInfo
info = DappInfo
dapp, $sel:env:DappContext :: Map Addr Contract
env = VM
vm.env.contracts }
  in let
    pos :: Text
pos =
      case DappInfo -> Trace -> Either Text Text
showTraceLocation DappInfo
dapp Trace
trace of
        Left Text
x -> Text
" \x1b[1m" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
"\x1b[0m"
        Right Text
x -> Text
" \x1b[1m(" forall a. Semigroup a => a -> a -> a
<> Text
x forall a. Semigroup a => a -> a -> a
<> Text
")\x1b[0m"
    fullAbiMap :: Map FunctionSelector Method
fullAbiMap = DappInfo
dapp.abiMap
  in case Trace
trace.tracedata of
    EventTrace Expr 'EWord
_ Expr 'Buf
bytes [Expr 'EWord]
topics ->
      let logn :: Text
logn = forall a. Monoid a => [a] -> a
mconcat
            [ Text
"\x1b[36m"
            , Text
"log" forall a. Semigroup a => a -> a -> a
<> ([Char] -> Text
pack (forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr 'EWord]
topics)))
            , [Text] -> Text
parenthesise ((forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) [Expr 'EWord]
topics) forall a. [a] -> [a] -> [a]
++ [Expr 'Buf -> Text
formatSBinary Expr 'Buf
bytes])
            , Text
"\x1b[0m"
            ] forall a. Semigroup a => a -> a -> a
<> Text
pos
          knownTopic :: Text -> [(Text, AbiType, Indexed)] -> Text
knownTopic Text
name [(Text, AbiType, Indexed)]
types = forall a. Monoid a => [a] -> a
mconcat
            [ Text
"\x1b[36m"
            , Text
name
            , (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
showValues ([(Text, AbiType, Indexed)] -> [AbiType]
unindexed [(Text, AbiType, Indexed)]
types) Expr 'Buf
bytes
            -- todo: show indexed
            , Text
"\x1b[0m"
            ] forall a. Semigroup a => a -> a -> a
<> Text
pos
          lognote :: Text -> Text -> Text
lognote Text
sig Text
usr = forall a. Monoid a => [a] -> a
mconcat
            [ Text
"\x1b[36m"
            , Text
"LogNote"
            , [Text] -> Text
parenthesise [Text
sig, Text
usr, Text
"..."]
            , Text
"\x1b[0m"
            ] forall a. Semigroup a => a -> a -> a
<> Text
pos
      in case [Expr 'EWord]
topics of
        [] ->
          Text
logn
        (Expr 'EWord
t1:[Expr 'EWord]
_) ->
          case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
t1 of
            Just W256
topic ->
              case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup W256
topic DappInfo
dapp.eventMap of
                Just (Event Text
name Anonymity
_ [(Text, AbiType, Indexed)]
types) ->
                  Text -> [(Text, AbiType, Indexed)] -> Text
knownTopic Text
name [(Text, AbiType, Indexed)]
types
                Maybe Event
Nothing ->
                  case [Expr 'EWord]
topics of
                    [Expr 'EWord
_, Expr 'EWord
t2, Expr 'EWord
_, Expr 'EWord
_] ->
                      -- check for ds-note logs.. possibly catching false positives
                      -- event LogNote(
                      --     bytes4   indexed  sig,
                      --     address  indexed  usr,
                      --     bytes32  indexed  arg1,
                      --     bytes32  indexed  arg2,
                      --     bytes             data
                      -- ) anonymous;
                      let
                        sig :: FunctionSelector
sig = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
shiftR W256
topic Int
224 :: FunctionSelector
                        usr :: Text
usr = case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
t2 of
                          Just W256
w ->
                            [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show (forall a b. (Integral a, Num b) => a -> b
fromIntegral W256
w :: Addr)
                          Maybe W256
Nothing  ->
                            Text
"<symbolic>"
                      in
                        case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FunctionSelector
sig DappInfo
dapp.abiMap of
                          Just Method
m ->
                            Text -> Text -> Text
lognote Method
m.methodSignature Text
usr
                          Maybe Method
Nothing ->
                            Text
logn
                    [Expr 'EWord]
_ ->
                      Text
logn
            Maybe W256
Nothing ->
              Text
logn

    QueryTrace Query
q ->
      case Query
q of
        PleaseFetchContract Addr
addr Contract -> EVM ()
_ ->
          Text
"fetch contract " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall a. Show a => a -> [Char]
show Addr
addr) forall a. Semigroup a => a -> a -> a
<> Text
pos
        PleaseFetchSlot Addr
addr W256
slot W256 -> EVM ()
_ ->
          Text
"fetch storage slot " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall a. Show a => a -> [Char]
show W256
slot) forall a. Semigroup a => a -> a -> a
<> Text
" from " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall a. Show a => a -> [Char]
show Addr
addr) forall a. Semigroup a => a -> a -> a
<> Text
pos
        PleaseAskSMT {} ->
          Text
"ask smt" forall a. Semigroup a => a -> a -> a
<> Text
pos
        --PleaseMakeUnique {} ->
          --"make unique value" <> pos
        PleaseDoFFI [[Char]]
cmd ByteString -> EVM ()
_ ->
          Text
"execute ffi " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall a. Show a => a -> [Char]
show [[Char]]
cmd) forall a. Semigroup a => a -> a -> a
<> Text
pos

    ErrorTrace EvmError
e ->
      case EvmError
e of
        Revert Expr 'Buf
out ->
          Text
"\x1b[91merror\x1b[0m " forall a. Semigroup a => a -> a -> a
<> Text
"Revert " forall a. Semigroup a => a -> a -> a
<> (?context::DappContext) => Expr 'Buf -> Text
showError Expr 'Buf
out forall a. Semigroup a => a -> a -> a
<> Text
pos
        EvmError
_ ->
          Text
"\x1b[91merror\x1b[0m " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall a. Show a => a -> [Char]
show EvmError
e) forall a. Semigroup a => a -> a -> a
<> Text
pos

    ReturnTrace Expr 'Buf
out (CallContext Addr
_ Addr
_ W256
_ W256
_ Expr 'EWord
_ (Just W256
abi) Expr 'Buf
_ (Map Addr Contract, Expr 'Storage)
_ SubState
_) ->
      Text
"← " forall a. Semigroup a => a -> a -> a
<>
        case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall a b. (Integral a, Num b) => a -> b
fromIntegral W256
abi) Map FunctionSelector Method
fullAbiMap of
          Just Method
m  ->
            case forall a b. [(a, b)] -> ([a], [b])
unzip Method
m.output of
              ([], []) ->
                Expr 'Buf -> Text
formatSBinary Expr 'Buf
out
              ([Text]
_, [AbiType]
ts) ->
                (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
showValues [AbiType]
ts Expr 'Buf
out
          Maybe Method
Nothing ->
            Expr 'Buf -> Text
formatSBinary Expr 'Buf
out
    ReturnTrace Expr 'Buf
out (CallContext {}) ->
      Text
"← " forall a. Semigroup a => a -> a -> a
<> Expr 'Buf -> Text
formatSBinary Expr 'Buf
out
    ReturnTrace Expr 'Buf
out (CreationContext {}) ->
      let l :: Expr 'EWord
l = Expr 'Buf -> Expr 'EWord
Expr.bufLength Expr 'Buf
out
      in Text
"← " forall a. Semigroup a => a -> a -> a
<> forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
l forall a. Semigroup a => a -> a -> a
<> Text
" bytes of code"
    EntryTrace Text
t ->
      Text
t
    FrameTrace (CreationContext Addr
addr (Lit W256
hash) Map Addr Contract
_ SubState
_ ) -> -- FIXME: irrefutable pattern
      Text
"create "
      forall a. Semigroup a => a -> a -> a
<> Maybe SolcContract -> Text
maybeContractName (forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix W256
hash forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s t a b. Field2 s t a b => Lens s t a b
_2) DappInfo
dapp.solcByHash)
      forall a. Semigroup a => a -> a -> a
<> Text
"@" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall a. Show a => a -> [Char]
show Addr
addr)
      forall a. Semigroup a => a -> a -> a
<> Text
pos
    FrameTrace (CreationContext Addr
addr Expr 'EWord
_ Map Addr Contract
_ SubState
_ ) ->
      Text
"create "
      forall a. Semigroup a => a -> a -> a
<> Text
"<unknown contract>"
      forall a. Semigroup a => a -> a -> a
<> Text
"@" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall a. Show a => a -> [Char]
show Addr
addr)
      forall a. Semigroup a => a -> a -> a
<> Text
pos
    FrameTrace (CallContext Addr
target Addr
context W256
_ W256
_ Expr 'EWord
hash Maybe W256
abi Expr 'Buf
calldata (Map Addr Contract, Expr 'Storage)
_ SubState
_) ->
      let calltype :: Text
calltype = if Addr
target forall a. Eq a => a -> a -> Bool
== Addr
context
                     then Text
"call "
                     else Text
"delegatecall "
          hash' :: W256
hash' = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
hash
      in case forall k (is :: IxList) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (forall m. Ixed m => Index m -> Optic' (IxKind m) NoIx m (IxValue m)
ix W256
hash' forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% forall s t a b. Field2 s t a b => Lens s t a b
_2) DappInfo
dapp.solcByHash of
        Maybe SolcContract
Nothing ->
          Text
calltype
            forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack (forall a. Show a => a -> [Char]
show Addr
target)
            forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
pack [Char]
"::"
            forall a. Semigroup a => a -> a -> a
<> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. a -> Maybe a -> a
fromMaybe W256
0x00 Maybe W256
abi)) Map FunctionSelector Method
fullAbiMap of
                 Just Method
m  ->
                   Text
"\x1b[1m"
                   forall a. Semigroup a => a -> a -> a
<> Method
m.name
                   forall a. Semigroup a => a -> a -> a
<> Text
"\x1b[0m"
                   forall a. Semigroup a => a -> a -> a
<> (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
showCall (forall a. [Maybe a] -> [a]
catMaybes (Text -> [Maybe AbiType]
getAbiTypes Method
m.methodSignature)) Expr 'Buf
calldata
                 Maybe Method
Nothing ->
                   Expr 'Buf -> Text
formatSBinary Expr 'Buf
calldata
            forall a. Semigroup a => a -> a -> a
<> Text
pos

        Just SolcContract
solc ->
          Text
calltype
            forall a. Semigroup a => a -> a -> a
<> Text
"\x1b[1m"
            forall a. Semigroup a => a -> a -> a
<> Text -> Text
contractNamePart SolcContract
solc.contractName
            forall a. Semigroup a => a -> a -> a
<> Text
"::"
            forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"[fallback function]"
                 (forall a. a -> Maybe a -> a
fromMaybe Text
"[unknown method]" forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolcContract -> W256 -> Maybe Text
maybeAbiName SolcContract
solc)
                 Maybe W256
abi
            forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text
"(" forall a. Semigroup a => a -> a -> a
<> Expr 'Buf -> Text
formatSBinary Expr 'Buf
calldata forall a. Semigroup a => a -> a -> a
<> Text
")")
                 (\[Maybe AbiType]
x -> (?context::DappContext) => [AbiType] -> Expr 'Buf -> Text
showCall (forall a. [Maybe a] -> [a]
catMaybes [Maybe AbiType]
x) Expr 'Buf
calldata)
                 (Maybe W256
abi forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [Maybe AbiType]
getAbiTypes forall b c a. (b -> c) -> (a -> b) -> a -> c
. SolcContract -> W256 -> Maybe Text
maybeAbiName SolcContract
solc)
            forall a. Semigroup a => a -> a -> a
<> Text
"\x1b[0m"
            forall a. Semigroup a => a -> a -> a
<> Text
pos

getAbiTypes :: Text -> [Maybe AbiType]
getAbiTypes :: Text -> [Maybe AbiType]
getAbiTypes Text
abi = forall a b. (a -> b) -> [a] -> [b]
map (Vector AbiType -> Text -> Maybe AbiType
parseTypeName forall a. Monoid a => a
mempty) [Text]
types
  where
    types :: [Text]
types =
      forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Text
"") forall a b. (a -> b) -> a -> b
$
        Text -> Text -> [Text]
splitOn Text
"," (Int -> Text -> Text
dropEnd Int
1 (forall a. [a] -> a
last (Text -> Text -> [Text]
splitOn Text
"(" Text
abi)))

maybeContractName :: Maybe SolcContract -> Text
maybeContractName :: Maybe SolcContract -> Text
maybeContractName =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"<unknown contract>" (Text -> Text
contractNamePart forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.contractName))

maybeContractName' :: Maybe SolcContract -> Text
maybeContractName' :: Maybe SolcContract -> Text
maybeContractName' =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text -> Text
contractNamePart forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.contractName))

maybeAbiName :: SolcContract -> W256 -> Maybe Text
maybeAbiName :: SolcContract -> W256 -> Maybe Text
maybeAbiName SolcContract
solc W256
abi = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall a b. (Integral a, Num b) => a -> b
fromIntegral W256
abi) SolcContract
solc.abiMap forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (.methodSignature)

contractNamePart :: Text -> Text
contractNamePart :: Text -> Text
contractNamePart Text
x = (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
':') Text
x forall a. [a] -> Int -> a
!! Int
1

contractPathPart :: Text -> Text
contractPathPart :: Text -> Text
contractPathPart Text
x = (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
':') Text
x forall a. [a] -> Int -> a
!! Int
0

prettyError :: EvmError -> String
prettyError :: EvmError -> [Char]
prettyError = \case
  EvmError
IllegalOverflow -> [Char]
"Illegal overflow"
  EvmError
SelfDestruction -> [Char]
"Self destruct"
  EvmError
StackLimitExceeded -> [Char]
"Stack limit exceeded"
  EvmError
InvalidMemoryAccess -> [Char]
"Invalid memory access"
  EvmError
BadJumpDestination -> [Char]
"Bad jump destination"
  EvmError
StackUnderrun -> [Char]
"Stack underrun"
  BalanceTooLow W256
a W256
b -> [Char]
"Balance too low. value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show W256
a forall a. Semigroup a => a -> a -> a
<> [Char]
" balance: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show W256
b
  UnrecognizedOpcode Word8
a -> [Char]
"Unrecognized opcode: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Word8
a
  Revert (ConcreteBuf ByteString
msg) -> [Char]
"Revert: " forall a. Semigroup a => a -> a -> a
<> (Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ ByteString -> Text
formatBinary ByteString
msg)
  Revert Expr 'Buf
_ -> [Char]
"Revert: <symbolic>"
  OutOfGas Word64
a Word64
b -> [Char]
"Out of gas: have: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Word64
a forall a. Semigroup a => a -> a -> a
<> [Char]
" need: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Word64
b
  EvmError
StateChangeWhileStatic -> [Char]
"State change while static"
  EvmError
CallDepthLimitReached -> [Char]
"Call depth limit reached"
  MaxCodeSizeExceeded W256
a W256
b -> [Char]
"Max code size exceeded: max: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show W256
a forall a. Semigroup a => a -> a -> a
<> [Char]
" actual: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show W256
b
  MaxInitCodeSizeExceeded W256
a W256
b -> [Char]
"Max init code size exceeded: max: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show W256
a forall a. Semigroup a => a -> a -> a
<> [Char]
" actual: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show W256
b
  EvmError
InvalidFormat -> [Char]
"Invalid Format"
  EvmError
PrecompileFailure -> [Char]
"Precompile failure"
  EvmError
ReturnDataOutOfBounds -> [Char]
"Return data out of bounds"
  EvmError
NonceOverflow -> [Char]
"Nonce overflow"
  BadCheatCode FunctionSelector
a -> [Char]
"Bad cheat code: sig: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show FunctionSelector
a

prettyvmresult :: Expr End -> String
prettyvmresult :: Expr 'End -> [Char]
prettyvmresult (Failure [Prop]
_ (Revert (ConcreteBuf ByteString
""))) = [Char]
"Revert"
prettyvmresult (Success [Prop]
_ (ConcreteBuf ByteString
msg) Expr 'Storage
_) =
  if ByteString -> Bool
BS.null ByteString
msg
  then [Char]
"Stop"
  else [Char]
"Return: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (ByteString -> ByteStringS
ByteStringS ByteString
msg)
prettyvmresult (Success [Prop]
_ Expr 'Buf
_ Expr 'Storage
_) =
  [Char]
"Return: <symbolic>"
prettyvmresult (Failure [Prop]
_ EvmError
err) = EvmError -> [Char]
prettyError EvmError
err
prettyvmresult (Partial [Prop]
_ PartialExec
p) = Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ PartialExec -> Text
formatPartial PartialExec
p
prettyvmresult Expr 'End
r = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Internal Error: Invalid result: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Expr 'End
r

indent :: Int -> Text -> Text
indent :: Int -> Text -> Text
indent Int
n = Text -> Text
rstrip forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
T.replicate Int
n ([Char] -> Text
T.pack [Char
' ']) <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines

rstrip :: Text -> Text
rstrip :: Text -> Text
rstrip = Text -> Text
T.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (forall a. Eq a => a -> a -> Bool
==Char
'\n') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.reverse

formatError :: EvmError -> Text
formatError :: EvmError -> Text
formatError = \case
  Revert Expr 'Buf
buf -> [Text] -> Text
T.unlines
    [ Text
"(Revert"
    , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
buf
    , Text
")"
    ]
  EvmError
e -> [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show EvmError
e

formatPartial :: PartialExec -> Text
formatPartial :: PartialExec -> Text
formatPartial = \case
  (UnexpectedSymbolicArg Int
pc [Char]
msg [SomeExpr]
args) -> [Text] -> Text
T.unlines
    [ Text
"Unexpected Symbolic Arguments to Opcode"
    , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
      [ Text
"msg: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show [Char]
msg)
      , Text
"program counter: " forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
pc)
      , Text
"arguments: "
      , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SomeExpr -> Text
formatSomeExpr forall a b. (a -> b) -> a -> b
$ [SomeExpr]
args
      ]
    ]
  MaxIterationsReached Int
pc Addr
addr -> [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
"Max Iterations Reached in contract: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Addr
addr forall a. Semigroup a => a -> a -> a
<> [Char]
" pc: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
pc

formatSomeExpr :: SomeExpr -> Text
formatSomeExpr :: SomeExpr -> Text
formatSomeExpr (SomeExpr Expr a
e) = forall (a :: EType). Expr a -> Text
formatExpr Expr a
e

formatExpr :: Expr a -> Text
formatExpr :: forall (a :: EType). Expr a -> Text
formatExpr = forall (a :: EType). Expr a -> Text
go
  where
    go :: Expr a -> Text
    go :: forall (a :: EType). Expr a -> Text
go = \case
      Lit W256
w -> [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show W256
w
      LitByte Word8
w -> [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Word8
w

      ITE Expr 'EWord
c Expr 'End
t Expr 'End
f -> Text -> Text
rstrip forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$
        [ Text
"(ITE (" forall a. Semigroup a => a -> a -> a
<> forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
c forall a. Semigroup a => a -> a -> a
<> Text
")"
        , Int -> Text -> Text
indent Int
2 (forall (a :: EType). Expr a -> Text
formatExpr Expr 'End
t)
        , Int -> Text -> Text
indent Int
2 (forall (a :: EType). Expr a -> Text
formatExpr Expr 'End
f)
        , Text
")"]
      Success [Prop]
asserts Expr 'Buf
buf Expr 'Storage
store -> [Text] -> Text
T.unlines
        [ Text
"(Return"
        , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"Data:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
buf
          , Text
""
          , Text
"Store:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'Storage
store
          , Text
"Assertions:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show [Prop]
asserts
          ]
        , Text
")"
        ]
      Failure [Prop]
asserts EvmError
err -> [Text] -> Text
T.unlines
        [ Text
"(Failure"
        , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"Error:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ EvmError -> Text
formatError EvmError
err
          , Text
"Assertions:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show [Prop]
asserts
          ]
        , Text
")"
        ]

      IndexWord Expr 'EWord
idx Expr 'EWord
val -> [Text] -> Text
T.unlines
        [ Text
"(IndexWord"
        , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"idx:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
idx
          , Text
"val: "
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
val
          ]
        , Text
")"
        ]
      ReadWord Expr 'EWord
idx Expr 'Buf
buf -> [Text] -> Text
T.unlines
        [ Text
"(ReadWord"
        , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"idx:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
idx
          , Text
"buf: "
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
buf
          ]
        , Text
")"
        ]

      And Expr 'EWord
a Expr 'EWord
b -> [Text] -> Text
T.unlines
        [ Text
"(And"
        , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
a
          , forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
b
          ]
        , Text
")"
        ]

      -- Stores
      SLoad Expr 'EWord
addr Expr 'EWord
slot Expr 'Storage
store -> [Text] -> Text
T.unlines
        [ Text
"(SLoad"
        , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"addr:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
addr
          , Text
"slot:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
slot
          , Text
"store:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'Storage
store
          ]
        , Text
")"
        ]
      SStore Expr 'EWord
addr Expr 'EWord
slot Expr 'EWord
val Expr 'Storage
prev -> [Text] -> Text
T.unlines
        [ Text
"(SStore"
        , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"addr:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
addr
          , Text
"slot:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
slot
          , Text
"val:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
val
          ]
        , Text
")"
        , forall (a :: EType). Expr a -> Text
formatExpr Expr 'Storage
prev
        ]
      ConcreteStore Map W256 (Map W256 W256)
s -> [Text] -> Text
T.unlines
        [ Text
"(ConcreteStore"
        , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList) Map W256 (Map W256 W256)
s
        , Text
")"
        ]

      -- Buffers

      CopySlice Expr 'EWord
srcOff Expr 'EWord
dstOff Expr 'EWord
size Expr 'Buf
src Expr 'Buf
dst -> [Text] -> Text
T.unlines
        [ Text
"(CopySlice"
        , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"srcOffset: " forall a. Semigroup a => a -> a -> a
<> forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
srcOff
          , Text
"dstOffset: " forall a. Semigroup a => a -> a -> a
<> forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
dstOff
          , Text
"size:      " forall a. Semigroup a => a -> a -> a
<> forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
size
          , Text
"src:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
src
          ]
        , Text
")"
        , forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
dst
        ]
      WriteWord Expr 'EWord
idx Expr 'EWord
val Expr 'Buf
buf -> [Text] -> Text
T.unlines
        [ Text
"(WriteWord"
        , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"idx:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
idx
          , Text
"val:"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
val
          ]
        , Text
")"
        , forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
buf
        ]
      WriteByte Expr 'EWord
idx Expr 'Byte
val Expr 'Buf
buf -> [Text] -> Text
T.unlines
        [ Text
"(WriteByte"
        , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
          [ Text
"idx: " forall a. Semigroup a => a -> a -> a
<> forall (a :: EType). Expr a -> Text
formatExpr Expr 'EWord
idx
          , Text
"val: " forall a. Semigroup a => a -> a -> a
<> forall (a :: EType). Expr a -> Text
formatExpr Expr 'Byte
val
          ]
        , Text
")"
        , forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
buf
        ]
      ConcreteBuf ByteString
bs -> case ByteString
bs of
        ByteString
"" -> Text
"(ConcreteBuf \"\")"
        ByteString
_ -> [Text] -> Text
T.unlines
          [ Text
"(ConcreteBuf"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> [Char]
prettyHex Int
0 ByteString
bs
          , Text
")"
          ]


      -- Hashes
      Keccak Expr 'Buf
b -> [Text] -> Text
T.unlines
       [ Text
"(Keccak"
       , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
b
       , Text
")"
       ]

      Expr a
a -> [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Expr a
a

strip0x :: ByteString -> ByteString
strip0x :: ByteString -> ByteString
strip0x ByteString
bs = if ByteString
"0x" ByteString -> ByteString -> Bool
`Char8.isPrefixOf` ByteString
bs then Int -> ByteString -> ByteString
Char8.drop Int
2 ByteString
bs else ByteString
bs

strip0x' :: String -> String
strip0x' :: ShowS
strip0x' [Char]
s = if [Char]
"0x" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
s then forall a. Int -> [a] -> [a]
drop Int
2 [Char]
s else [Char]
s

hexByteString :: String -> ByteString -> ByteString
hexByteString :: [Char] -> ByteString -> ByteString
hexByteString [Char]
msg ByteString
bs =
  case ByteString -> Either Text ByteString
BS16.decodeBase16 ByteString
bs of
    Right ByteString
x -> ByteString
x
    Either Text ByteString
_ -> forall a. HasCallStack => [Char] -> a
error ([Char]
"invalid hex bytestring for " forall a. [a] -> [a] -> [a]
++ [Char]
msg)

hexText :: Text -> ByteString
hexText :: Text -> ByteString
hexText Text
t =
  case ByteString -> Either Text ByteString
BS16.decodeBase16 (Text -> ByteString
T.encodeUtf8 (Int -> Text -> Text
T.drop Int
2 Text
t)) of
    Right ByteString
x -> ByteString
x
    Either Text ByteString
_ -> forall a. HasCallStack => [Char] -> a
error ([Char]
"invalid hex bytestring " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
t)

bsToHex :: ByteString -> String
bsToHex :: ByteString -> [Char]
bsToHex ByteString
bs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. (Show a, Integral a) => Int -> a -> [Char]
paddedShowHex Int
2) (ByteString -> [Word8]
BS.unpack ByteString
bs)