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


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

import Prelude hiding (Word)

import qualified EVM
import EVM.Dapp (DappInfo (..), dappSolcByHash, dappAbiMap, showTraceLocation, dappEventMap, dappErrorMap)
import EVM.Dapp (DappContext (..), contextInfo, contextEnv)
import EVM (VM, cheatCode, traceForest, traceData, Error (..))
import EVM (Trace, TraceData (..), Query (..), FrameContext (..))
import EVM.Types (maybeLitWord, W256 (..), num, word, Expr(..), EType(..))
import EVM.Types (Addr, ByteStringS(..), Error(..))
import EVM.ABI (AbiValue (..), Event (..), AbiType (..), SolError (..))
import EVM.ABI (Indexed (NotIndexed), getAbiSeq)
import EVM.ABI (parseTypeName, formatString)
import EVM.Solidity (SolcContract(..), contractName, abiMap)
import EVM.Solidity (methodOutput, methodSignature, methodName)
import EVM.Hexdump

import Control.Arrow ((>>>))
import Control.Lens (view, preview, ix, _2, to, (^?!))
import Data.Binary.Get (runGetOrFail)
import Data.Bits       (shiftR)
import Data.ByteString (ByteString)
import Data.ByteString.Builder (byteStringHex, toLazyByteString)
import Data.ByteString.Lazy (toStrict, fromStrict)
import Data.DoubleWord (signedWord)
import Data.Foldable (toList)
import Data.Maybe (catMaybes, fromMaybe, fromJust)
import Data.Text (Text, pack, unpack, intercalate)
import Data.Text (dropEnd, splitOn)
import Data.Text.Encoding (decodeUtf8, decodeUtf8')
import Data.Tree.View (showTree)
import Data.Vector (Vector)
import Data.Word (Word32)
import Numeric (showHex)

import qualified Data.ByteString as BS
import qualified Data.Char as Char
import qualified Data.Map as Map
import qualified Data.Text as Text
import qualified EVM.Expr as Expr
import qualified Data.Text as T

data Signedness = Signed | Unsigned
  deriving (Int -> Signedness -> ShowS
[Signedness] -> ShowS
Signedness -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Signedness] -> ShowS
$cshowList :: [Signedness] -> ShowS
show :: Signedness -> String
$cshow :: Signedness -> String
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 = String -> Text
Text.pack (forall a. Show a => a -> String
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) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DappInfo (Map Word32 Method)
dappAbiMap DappInfo
dapp) of
    Maybe Method
Nothing -> Signedness -> W256 -> Text
showDec Signedness
Unsigned W256
w
    Just Method
x  -> Text
"keccak(\"" forall a. Semigroup a => a -> a -> a
<> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Method Text
methodSignature Method
x 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
Text.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
Text.reverse
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> [Text]
Text.chunksOf Int
3
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.reverse
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

prettyIfConcreteWord :: Expr EWord -> Text
prettyIfConcreteWord :: Expr 'EWord -> Text
prettyIfConcreteWord = \case
  Lit W256
w -> String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"0x" forall a. Semigroup a => a -> a -> a
<> forall a. (Integral a, Show a) => a -> ShowS
showHex W256
w String
""
  Expr 'EWord
w -> String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
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 = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DappContext DappInfo
contextInfo ?context::DappContext
?context
      contracts :: Map Addr Contract
contracts = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DappContext (Map Addr Contract)
contextEnv ?context::DappContext
?context
      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 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Contract (Expr 'EWord)
EVM.codehash Contract
contract
          in case Maybe W256
hash of
               Just W256
h -> Maybe SolcContract -> Text
maybeContractName' (forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Lens' DappInfo (Map W256 (CodeType, SolcContract))
dappSolcByHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix W256
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2) DappInfo
dappinfo)
               Maybe W256
Nothing -> Text
""
  in
    Text
name forall a. Semigroup a => a -> a -> a
<> Text
"@" forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Addr
addr)
showAbiValue AbiValue
v = String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
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, String) (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
_, String
_)   -> [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 = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DappContext DappInfo
contextInfo ?context::DappContext
?context
      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) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DappInfo (Map W256 SolError)
dappErrorMap DappInfo
dappinfo) 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 = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
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
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
Text.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
Text.dropAround (forall a. Eq a => a -> a -> Bool
==Char
'"') (String -> Text
pack forall a b. (a -> b) -> a -> b
$ ByteString -> String
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
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 => String -> a
error String
"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 String]
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 -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. DappInfo -> VM -> Trace -> Text
showTrace DappInfo
dapp VM
vm)) Forest Trace
forest
  in String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Tree String -> String
showTree [Tree String]
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 { _contextInfo :: DappInfo
_contextInfo = DappInfo
dapp, _contextEnv :: Map Addr Contract
_contextEnv = VM
vm forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Lens' VM Env
EVM.env forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Env (Map Addr Contract)
EVM.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 Word32 Method
fullAbiMap = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DappInfo (Map Word32 Method)
dappAbiMap DappInfo
dapp
  in case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Trace TraceData
traceData Trace
trace 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
<> (String -> Text
pack (forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr 'EWord]
topics)))
            , [Text] -> Text
parenthesise ((forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
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) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DappInfo (Map W256 Event)
dappEventMap DappInfo
dapp) 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 :: Word32
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 :: Word32
                        usr :: Text
usr = case Expr 'EWord -> Maybe W256
maybeLitWord Expr 'EWord
t2 of
                          Just W256
w ->
                            String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
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 Word32
sig (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DappInfo (Map Word32 Method)
dappAbiMap DappInfo
dapp) of
                          Just Method
m ->
                            Text -> Text -> Text
lognote (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Method Text
methodSignature Method
m) 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
<> String -> Text
pack (forall a. Show a => a -> String
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
<> String -> Text
pack (forall a. Show a => a -> String
show W256
slot) forall a. Semigroup a => a -> a -> a
<> Text
" from " forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (forall a. Show a => a -> String
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 [String]
cmd ByteString -> EVM ()
_ ->
          Text
"execute ffi " forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (forall a. Show a => a -> String
show [String]
cmd) forall a. Semigroup a => a -> a -> a
<> Text
pos

    ErrorTrace Error
e ->
      case Error
e of
        EVM.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
        Error
_ ->
          Text
"\x1b[91merror\x1b[0m " forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (forall a. Show a => a -> String
show Error
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 Word32 Method
fullAbiMap of
          Just Method
m  ->
            case forall a b. [(a, b)] -> ([a], [b])
unzip (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Method [(Text, AbiType)]
methodOutput Method
m) 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 s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Lens' DappInfo (Map W256 (CodeType, SolcContract))
dappSolcByHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix W256
hash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2) DappInfo
dapp)
      forall a. Semigroup a => a -> a -> a
<> Text
"@" forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (forall a. Show a => a -> String
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
<> String -> Text
pack (forall a. Show a => a -> String
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 s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Lens' DappInfo (Map W256 (CodeType, SolcContract))
dappSolcByHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix W256
hash' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2) DappInfo
dapp of
        Maybe SolcContract
Nothing ->
          Text
calltype
            forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (forall a. Show a => a -> String
show Addr
target)
            forall a. Semigroup a => a -> a -> a
<> String -> Text
pack String
"::"
            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 Word32 Method
fullAbiMap of
                 Just Method
m  ->
                   Text
"\x1b[1m"
                   forall a. Semigroup a => a -> a -> a
<> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Method Text
methodName Method
m
                   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 (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Method Text
methodSignature Method
m))) 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
<> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' SolcContract Text
contractName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> Text
contractNamePart) SolcContract
solc
            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>" (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' SolcContract Text
contractName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> Text
contractNamePart))

maybeContractName' :: Maybe SolcContract -> Text
maybeContractName' :: Maybe SolcContract -> Text
maybeContractName' =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' SolcContract Text
contractName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> Text
contractNamePart))

maybeAbiName :: SolcContract -> W256 -> Maybe Text
maybeAbiName :: SolcContract -> W256 -> Maybe Text
maybeAbiName SolcContract
solc W256
abi = forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Lens' SolcContract (Map Word32 Method)
abiMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (forall a b. (Integral a, Num b) => a -> b
fromIntegral W256
abi) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Method Text
methodSignature) SolcContract
solc

contractNamePart :: Text -> Text
contractNamePart :: Text -> Text
contractNamePart Text
x = (Char -> Bool) -> Text -> [Text]
Text.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]
Text.split (forall a. Eq a => a -> a -> Bool
== Char
':') Text
x forall a. [a] -> Int -> a
!! Int
0

prettyError :: EVM.Types.Error -> String
prettyError :: Error -> String
prettyError= \case
  Error
Invalid -> String
"Invalid Opcode"
  Error
EVM.Types.IllegalOverflow -> String
"Illegal Overflow"
  Error
SelfDestruct -> String
"Self Destruct"
  Error
EVM.Types.StackLimitExceeded -> String
"Stack limit exceeded"
  Error
EVM.Types.InvalidMemoryAccess -> String
"Invalid memory access"
  Error
EVM.Types.BadJumpDestination -> String
"Bad jump destination"
  TmpErr String
err -> String
"Temp error: " forall a. Semigroup a => a -> a -> a
<> String
err


prettyvmresult :: (?context :: DappContext) => Expr End -> String
prettyvmresult :: (?context::DappContext) => Expr 'End -> String
prettyvmresult (EVM.Types.Revert [Prop]
_ (ConcreteBuf ByteString
"")) = String
"Revert"
prettyvmresult (EVM.Types.Revert [Prop]
_ Expr 'Buf
msg) = String
"Revert: " forall a. [a] -> [a] -> [a]
++ (Text -> String
unpack forall a b. (a -> b) -> a -> b
$ (?context::DappContext) => Expr 'Buf -> Text
showError Expr 'Buf
msg)
prettyvmresult (EVM.Types.Return [Prop]
_ (ConcreteBuf ByteString
msg) Expr 'Storage
_) =
  if ByteString -> Bool
BS.null ByteString
msg
  then String
"Stop"
  else String
"Return: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (ByteString -> ByteStringS
ByteStringS ByteString
msg)
prettyvmresult (EVM.Types.Return [Prop]
_ Expr 'Buf
_ Expr 'Storage
_) =
  String
"Return: <symbolic>"
prettyvmresult (Failure [Prop]
_ Error
err) = Error -> String
prettyError Error
err
prettyvmresult Expr 'End
e = forall a. HasCallStack => String -> a
error String
"Internal Error: Invalid Result: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Expr 'End
e

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 (String -> 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

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 -> String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show W256
w
      LitByte Word8
w -> String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
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
")"]
      EVM.Types.Revert [Prop]
asserts Expr 'Buf
buf -> case Expr 'Buf
buf of
        ConcreteBuf ByteString
"" -> Text
"(Revert " forall a. Semigroup a => a -> a -> a
<> forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
buf forall a. Semigroup a => a -> a -> a
<> Text
")"
        Expr 'Buf
_ -> [Text] -> Text
T.unlines
          [ Text
"(Revert"
          , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines
            [ Text
"Code:"
            , Int -> Text -> Text
indent Int
2 (forall (a :: EType). Expr a -> Text
formatExpr Expr 'Buf
buf)
            , Text
"Assertions:"
            , Int -> Text -> Text
indent Int
2 forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show [Prop]
asserts
            ]
          , Text
")"
          ]
      Return [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
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
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 (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
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 (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
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
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> String
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 -> String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Expr a
a